API tools faq
paste
Advertisement
logicmoo

Untitled

logicmoo
Jul 22nd, 2018
604
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Prolog 18.83 KB | None | 0 0
raw download clone embed print report
  1.   /*---------------------------------------------------------*/
  2.   /*                                                         */
  3.   /*                       'SYMDIFF'                         */
  4.   /*                                                         */
  5.   /*  Symbolic Differentiation and Algebraic Simplification  */
  6.   /*                                                         */
  7.   /*    The declarative semantics of Prolog are a powerful   */
  8.   /*  tool for problems involving symbolic manipulation.     */
  9.   /*    In this example the rules for differentiation are    */
  10.   /*  expressed as a set of clauses, where, provided that    */
  11.   /*  the head matches the expression in question, the body  */
  12.   /*  furnishes the appropriate result. This result in turn  */
  13.   /*  is passed to the simplifying clauses which operate on  */
  14.   /*  the same principle, but obviously correspond to a      */
  15.   /*  different set of (simplifying) rules.                  */
  16.   /*                                                         */
  17.   /*---------------------------------------------------------*/
  18.  
  19.  
  20. /*  This is the main predicate. */        
  21.  
  22. symdiff :-
  23.    nl,
  24.    write('SYMDIFF : Symbolic Differentiation and '),
  25.    write('Algebraic Simplification. Version 1.0'), nl,
  26.    symdiff1.
  27.  
  28.  
  29.   /*  symdiff1 controls the main processing; It prompts  */
  30.   /*  the user for data, differentiates the input,       */
  31.   /*  simplifies the result and then displays it on      */
  32.   /*  the terminal.                                      */
  33.  
  34. symdiff1  :-
  35.    write('Enter a symbolic expression, or "stop" '),
  36.    read(Exp),
  37.    process( Exp ).
  38.  
  39.  
  40. process( stop ) :- !.
  41.  
  42. process( Exp ) :-
  43.    write('Differentiate w.r.t. :'),
  44.    read(Wrt),
  45.    process(Exp,Wrt),
  46.    symdiff1.
  47.    
  48. process( Exp ,Wrt ):-
  49.    process( Exp ,Wrt, Sdiff),
  50.    nl,
  51.    write('Differential w.r.t '), write(Wrt),
  52.    write(' is '),
  53.    write(Sdiff), nl, nl.
  54.    
  55.  
  56. process( Exp ,Wrt, Sdiff):-
  57.    d(Exp, Wrt, Diff ),
  58.    simplify1(Wrt, Diff, Sdiff ),!.
  59.  
  60.  
  61.   /*  The following clauses constitute the differentiation   */
  62.   /*  rules, some of which are recursive. Note too the use   */
  63.   /*  of the cut which ensures that once a special case has  */
  64.   /*  been identified, backtracking will not attempt to find */
  65.   /*  an alternative solution.                               */
  66.  
  67.  
  68. %%%%%%%%%%%%%%%%%%%%%%%%%%
  69. %%%%%%%%%%%%%%%%%%%%%%%%%%
  70. % process(x^(x*log(cos(x))), x)
  71. % process(diff(x^(x*log(cos(x))), x), N).
  72. % N = x^(exp(log(1/x))-1)*(exp(log(1/x))+ - (1)/(x*x)/(1/x)*exp(log(1/x))*x*log(x))*cos(x^exp(log(1/x)))
  73. % d(expr, var, deriv)
  74. %%%%%%%%%%%%%%%%%%%%%%%%%%
  75.  
  76. d(E, _, E) :- var(E),!.
  77.  
  78. d(d(Expr,Wrt), X, E):- !,d(diff(Expr,Wrt), X, E).
  79. d(d(Expr,Wrt,D), X, E):- !,d(diff(Expr,Wrt,D), X, E).
  80. d(diff(Expr,Wrt), _X, E):- !, d(Expr, Wrt, E).
  81. d(diff(Expr,Wrt,1), X, E):- !, d(diff(Expr,Wrt), X, E).
  82. % d(diff(Expr,Wrt,2), X, E):- !, d(diff(Expr,Wrt), X, E).
  83. % d(f(Wrt), Wrt, 1):- !.
  84. d( U**C, X, O  ) :- !, d( U^C, X, O  ).
  85.  
  86. % constant
  87. d(E, _, 0) :- numeric_1(E),!.
  88.  
  89. %d( C, _X, 0 ):- atomic(C).        /* If C is a constant then */
  90.                                    /* d(C)/dX is 0            */
  91. %d( X, X, 1 ):- !.                 /* d(X) w.r.t. X is 1      */
  92.  
  93. % the same variable
  94. d(E, V, 0) :- atom(E), E \== V, !.
  95.    
  96. % other variables
  97. d(E, V, 1) :-  atom(E), E == V,!.
  98.    
  99.  
  100. d( U+V, X, A+B ):-                 /* d(U+V)/dX = A+B where   */
  101.    d( U, X, A ),                   /* A = d(U)/dX and         */
  102.    d( V, X, B ).                   /* B = d(V)/dX             */
  103.  
  104. d( U-V, X, A-B ):-                 /* d(U-V)/dX = A-B where   */
  105.    d( U, X, A ),                   /* A = d(U)/dX and         */
  106.    d( V, X, B ).                   /* B = d(V)/dX             */
  107.  
  108. d( C*U, X, C*A ):-               /* d(C*U)/dX = C*A where     */
  109.    atomic(C),                    /* C is a numeric_1 or variable */
  110.    C \= X,                       /* not equal to X and        */
  111.    d( U, X, A ), !.              /* A = d(U)/dX               */
  112.  
  113. d( U*V, X, B*U+A*V ):-           /* d(U*V)/dX = B*U+A*V where */
  114.    d( U, X, A ),                 /* A = d(U)/dX and           */
  115.    d( V, X, B ).                 /* B = d(V)/dX               */
  116.  
  117. d( U/V, X, (A*V-B*U)/(V*V) ):- /* d(U/V)/dX = (A*V-B*U)/(V*V) */
  118.    d( U, X, A),                /* where A = d(U)/dX and       */
  119.    d( V, X, B).                /*       B = d(V)/dX           */
  120.  
  121. d( U^C, X, C*A*U^(C-1) ):-       /* d(U^C)/dX = C*A*U^(C-1)   */
  122.    atomic(C),                    /* where C is a numeric_1 or    */
  123.    C\=X,                         /* variable not equal to X   */
  124.    d( U, X, A ).                 /* and d(U)/dX = A           */
  125.  
  126. d( U^C, X, C*A*U^(C-1) ):-       /* d(U^C)/dX = C*A*U^(C-1)   */
  127.    C = -(C1), atomic(C1),        /* where C is a negated numeric_1 or  */
  128.    C1\=X,                        /* variable not equal to X   */
  129.    d( U, X, A ).                 /* and d(U)/dX = A           */
  130.  
  131. % (f^g)' = f^(g-1)*(gf' + g'f logf)
  132. d(F^G, V, FF) :- !,
  133.     d(F, V, Fd),
  134.     d(G, V, Gd),
  135.     opt_sub(AA, G, 1),
  136.     opt_mul(BB, G,Fd),
  137.     opt_mul(CC, Gd, F),
  138.     opt_mul(DD, CC, log(F)),
  139.     opt_sum(EE, BB, DD),
  140.     opt_mul(FF, F^(AA), EE).
  141.  
  142. d( sin(W), X, Z*cos(W) ):-       /* d(sin(W))/dX = Z*cos(W)   */
  143.    d( W, X, Z).                  /* where Z = d(W)/dX         */
  144.  
  145. d( exp(W), X, Z*exp(W) ):-       /* d(exp(W))/dX = Z*exp(W)   */
  146.    d( W, X, Z).                  /* where Z = d(W)/dX         */
  147.  
  148. d( log(W), X, Z/W ):-            /* d(log(W))/dX = Z/W        */
  149.    d( W, X, Z).                  /* where Z = d(W)/dX         */
  150.  
  151. d( cos(W), X, -(Z*sin(W)) ):-    /* d(cos(W))/dX = Z*sin(W)   */
  152.    d( W, X, Z).                  /* where Z = d(W)/dX         */
  153.  
  154.  
  155. d(_, _, _):-!,fail.
  156.  
  157. % functions
  158. % (h(g))' = h'(g) * g'
  159. d(sin(E), V, M) :-  d(E,V, Ed), opt_mul(M, Ed, cos(E)).
  160. d(cos(E), V, K) :-  d(E,V, Ed), opt_mul(M, Ed,sin(E)), opt_sub(K, 0, M).
  161.    
  162. d(tan(E), V, F) :-
  163.     d(E,V, Ed),
  164.     opt_mul(A, Ed, 2),
  165.     opt_mul(B, 2, E),
  166.     opt_mul(C, 2, cos(B)),
  167.     opt_sum(D, C, 1),
  168.     opt_div(F, A, D).
  169.  
  170. /*
  171. % sum
  172. d(E1 + E2, V, W) :-
  173.     d(E1, V, Ed1),
  174.     d(E2, V, Ed2),
  175.     opt_sum(W, Ed1, Ed2).
  176.  
  177. % subtraction
  178. d(E1 - E2, V, W) :- !,
  179.     d(E1, V, Ed1),
  180.     d(E2, V, Ed2),
  181.     opt_sub(W, Ed1, Ed2).
  182.    
  183. % (fg)' = f'g + fg'
  184. d(E1 * E2, V, W) :-
  185.     d(E1, V, Ed1),
  186.     d(E2, V, Ed2),
  187.     opt_mul(L, Ed1, E2),
  188.     opt_mul(P, E1, Ed2),
  189.     opt_sum(W, L, P).
  190.  
  191.  
  192. % (f/g)' = (f'g - fg') / (g*g)
  193. d(E1 / E2, V, E) :-
  194.     d(E1, V, Ed1),
  195.     d(E2, V, Ed2),
  196.     opt_mul(A, Ed1,E2),
  197.     opt_mul(B, E1,Ed2),
  198.     opt_mul(C, E2,E2),
  199.     opt_sub(D, A, B),
  200.     opt_div(E, D,C).
  201. */
  202.    
  203.  
  204. d(exp(E), V, F) :-
  205.     d(E,V, Ed),
  206.     opt_mul(F, Ed, exp(E)).
  207.  
  208. d(log(E), V, F) :-
  209.     d(E,V, Ed),
  210.     opt_div(F, Ed, E).
  211.  
  212.  
  213.   /*  The following clauses are rules for the simplification  */
  214.   /*  of the result of the differentiation process. For       */
  215.   /*  example, multiples of zero are dropped, terms gathered  */
  216.   /*  together where possible and factorisation is attempted. */
  217.   /*  (It should be noted that in this program only adjacent  */
  218.   /*  terms are candidates for simplification.)               */
  219.  
  220. simp(_, X, X ):-          /* an atom or numeric_1 is simplified */
  221.     atomic(X), !.
  222.  
  223. simp(_, X+0, Y ):-        /* terms of value zero are dropped  */
  224.    simp(_, X, Y ).
  225.  
  226. simp(_, 0+X, Y ):-        /* terms of value zero are dropped  */
  227.    simp(_, X, Y ).
  228.  
  229. simp(_, X-0, Y ):-        /* terms of value zero are dropped  */
  230.    simp(_, X, Y ).
  231.  
  232. simp(_, 0-X, -(Y) ):-     /* terms of value zero are dropped  */
  233.    simp(_, X, Y ).
  234.  
  235. simp(_, A+B, C ):-        /* sum numbers */
  236.    numeric_1(A),
  237.    numeric_1(B),
  238.    C is A+B.
  239.  
  240. simp(_, A-A, 0 ).         /* evaluate differences */
  241.  
  242. simp(_, A-B, C ):-        /* evaluate differences */
  243.    numeric_1(A),
  244.    numeric_1(B),
  245.    C is A-B.
  246.  
  247. simp(_, _X * 0, 0 ).         /* multiples of zero are zero */
  248.  
  249. simp(_, 0* _X, 0 ).         /* multiples of zero are zero */
  250.  
  251. simp(_, 0/_X, 0 ).         /* numerators evaluating to zero are zero */
  252.  
  253. simp(_, X*1, X ).         /* one is the identity for multiplication */
  254.  
  255. simp(_, 1*X, X ).         /* one is the identity for multiplication */
  256.  
  257. simp(_, X/1, X ).         /* divisors of one evaluate to the numerator */
  258.  
  259. simp(_, X/X, 1 ) :- !.
  260.  
  261. simp(_, X^1, X ) :- !.
  262.  
  263. simp(_, _X^0, 1 ) :- !.
  264.  
  265. simp(_, X*X, X^2 ) :- !.
  266.  
  267. simp(_, X*X^A, Y ) :-
  268.    simp(_, X^(A+1), Y ), !.
  269.  
  270. simp(_, X^A*X, Y ) :-
  271.    simp(_, X^(A+1), Y ), !.
  272.  
  273. simp(_, A*B, X ) :-       /* do evaluation if both are numbers  */
  274.    numeric_1( A ),
  275.    numeric_1( B ),
  276.    X is A*B.
  277.  
  278. simp(_, A*X+B*X, Z ):-    /* factorisation and recursive */
  279.    A\=X, B\=X,          /* simplification              */
  280.    simp(_, (A+B)*X, Z ).
  281.  
  282. simp(_, (A+B)*(A-B), X^2-Y^2 ):-   /* difference of two squares */
  283.    simp(_, A, X ),
  284.    simp(_, B, Y ).
  285.  
  286. simp(_, X^A/X^B, X^C ):-     /* quotient of numeric_1 powers of X */
  287.    numeric_1(A), numeric_1(B),
  288.    C is A-B.
  289.  
  290. simp(_, A/B, X ) :-       /* do evaluation if both are numbers  */
  291.    numeric_1( A ),
  292.    numeric_1( B ),
  293.    X is A/B.
  294.  
  295. simp(_, A^B, X ) :-       /* do evaluation if both are numbers  */
  296.    numeric_1( A ),
  297.    numeric_1( B ),
  298.    X is A^B.
  299.  
  300. simp(_, W+X, Q ):-        /* catchall */
  301.    simp(_, W, Y ),
  302.    simp(_, X, Z ),
  303.    ( W \== Y ; X \== Z ), /* ensure some simplification has taken place */
  304.    simp(_, Y+Z, Q ).
  305.  
  306. simp(_, W-X, Q ):-        /* catchall */
  307.    simp(_, W, Y ),
  308.    simp(_, X, Z ),
  309.    ( W \== Y ; X \== Z ), /* ensure some simplification has taken place */
  310.    simp(_, Y-Z, Q ).
  311.  
  312. simp(_, W*X, Q ):-        /* catchall */
  313.    simp(_, W, Y ),
  314.    simp(_, X, Z ),
  315.    ( W \== Y  ; X \== Z ), /* ensure some simplificaion has taken place */
  316.    simp(_, Y*Z, Q ).
  317.  
  318. simp(_, A/B, C ) :-
  319.    simp(_, A, X ),
  320.    simp(_, B, Y ),
  321.    ( A \== X ; B \== Y ),
  322.    simp(_, X/Y, C ).
  323.  
  324. simp(_, X^A, C ) :-
  325.    simp(_, A, B ),
  326.    A \== B,
  327.    simp(_, X^B, C).
  328.  
  329. simp(_, X, X ).           /* if all else fails... */              
  330.  
  331.  
  332. %numeric_1(A) :- integer(A).
  333.  
  334. numeric_1(A) :- number(A),!.
  335. numeric_1(A) :- notrace(catch((_ is A),_,fail)).
  336.  
  337. %% derivatives.pl -- Chapter 12, Section 12.2.3
  338. %% Last Modified: 2/4/14
  339. %% This is a Prolog program which computes derivatives
  340. %% of polynomials.
  341. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  342. % COMPUTING DERIVATIVES of POLYNOMIALS
  343. % For the purpose of this program polynomials are functions
  344. % constructed from a variable x, integers, function symbols
  345. % +, -, * and ^, and parentheses. Exponentiation X^N is
  346. % defined for nonnegative integer N.
  347. % The derivative is only computed once. Multiple calls can lead
  348. % to an infinite loop.
  349.  
  350. %:-use_module(library(lists)). % not needed for SWI Prolog
  351.  
  352. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  353. % derivative(F,DF) computes a derivative DF of a polynomial F.
  354. % The result is given in canonical form.
  355. % type F, DF - polynomials.
  356. % mode derivative(+,-)
  357.  
  358.  
  359. derivative(F,DF) :-
  360.     XX = x,
  361.     must(d(F,XX,G)),
  362.     must(simplify1(XX,G,DF)),!.
  363.  
  364. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  365. % der(XX,F,DF) computes a derivative DF of a polynomial F.
  366. % type F, DF - polynomials.
  367. % mode der(XX,+,-).
  368.  
  369. /*
  370. der(_XX,N,0) :-
  371.     numeric_1(N).
  372. der(XX,XX,1).
  373. der(XX,-XX,-1).
  374. der(_XX,_F^0,0).
  375. der(XX,F^N, N*F^M*DF) :- numeric_1(N),
  376.     N>=1,
  377.     M is N-1,
  378.     der(XX,F,DF).
  379. der(XX,E1*E2, E1*DE2 + E2*DE1) :-
  380.     der(XX,E1,DE1),
  381.     der(XX,E2,DE2).
  382. der(XX,E1+E2, DE1+DE2) :-
  383.     der(XX,E1,DE1),
  384.     der(XX,E2,DE2).
  385. der(XX,E1-E2,DE1-DE2) :-
  386.     der(XX,E1,DE1),
  387.     der(XX,E2,DE2).
  388. der(XX,-(E),DE) :-
  389.     der(XX,(-1)*E,DE).
  390. */
  391. der(XX,I,O):- d(I,XX,O).
  392.  
  393. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  394. %To simplify3a the resulting derivative we represent polynomials
  395. %as lists of the form [...[Ci,Ni]...] where [Ci,Ni] corresponds
  396. %to the term Ci*x^Ni. Polynomials, written in this form will be
  397. %called l-polynomials. The derivative DF of F computed
  398. %by der(XX,F,DF) will be translated into equivalent l-polynomial,
  399. %written in canonical form and transformed back into the term form.
  400. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  401. % simplify3a(x,P,SP) iff SP is a canonical form of a polynomial P
  402. % type: P, SP - polynomials
  403. % mode simplify3a(+,+,?)
  404.  
  405. simplify3a(XX,P,SPO) :-
  406.   simplify1(XX,P,SP),!,
  407.   (P \=@=SP -> simplify3a(XX,SP,SPO) ; SPO=SP).
  408.  
  409. simplify1(XX,P0,SP) :-
  410.     must(simp(_,P0,P)),
  411.     freeze(XX,atom(XX)), % dmiles
  412.     must(transform(XX,P,TP)),
  413.     must_or_fake(add_similar(TP,S)),
  414.     must_or_fake(remove_zero(S,S1)),
  415.     must_or_fake(poly_sort(S1,S2)),
  416.     (back_to_terms(XX,S2,SP)->true;S2=SP).
  417. %simplify1(_,SP,SP).
  418.  
  419. must_or_fake(P):- must( P=..[_,A,B]),!,(call(P)->true;A=B).
  420.  
  421. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  422. % transform(x,T,[[C1,N1],...,[Ck,Nk]]) implies that
  423. % T = C1*x^N1 +...+ Ck*x^Nk.
  424. % type: T - polynomial, C - integer, N - nonnegative integer.
  425. % mode: transform(XX,+,?).
  426.  
  427. transform(_XX,C,[[C,0]]) :-
  428.     integer(C),!.
  429. transform(XX,YY,[[1,1]]):- XX=@=YY,!.
  430. transform(XX,-YY,[[-1,1]]):- XX=@=YY,!.
  431. transform(XX,A*B,L) :-
  432.     transform(XX,A,L1),
  433.     transform(XX,B,L2),
  434.     multiply_l(L1,L2,L).
  435. transform(XX,A0^N0,L) :-
  436.      simplify3a(XX,N0,N),
  437.      simplify3a(XX,A0,A),
  438.      transform(XX,A,L1),
  439.      get_degree(L1,N,L),!.
  440. transform(XX,A+B,RT) :-
  441.      transform(XX,A,RA),
  442.      transform(XX,B,RB),
  443.      append(RA,RB,RT).
  444. transform(XX,A-B,RT) :-
  445.      transform(XX,A,RA),
  446.      transform(XX,-B,RB),
  447.      append(RA,RB,RT).
  448. transform(XX,Neg,R) :- unnegative(Neg,A),!,
  449.      transform(XX,(-1)*A,R).
  450. transform(_XX,X,X).
  451.  
  452. unnegative(Neg,A):- Neg = -(A),!.
  453. % unnegative(Neg,A):- A<0, A is -Neg.
  454.  
  455. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  456. % multiply_l(L1,L2,L) L is the product of L1 and L2
  457. % type: L1,L2,L - l-polynomials
  458. % mode: multiply_l(+,+,-)
  459.  
  460. multiply_one(_,[],[]).
  461. multiply_one([C1,N1],[[C2,N2]|R],[[C,N]|T]) :-
  462.     notrace(catch((C is C1*C2, N is N1+N2),E,(wdmsg(E),fail))),
  463.     multiply_one([C1,N1],R,T).
  464.  
  465. multiply_l([],_,[]).
  466. multiply_l([H1|T1],T2,T) :-
  467.     multiply_one(H1,T2,R1),
  468.     multiply_l(T1,T2,R2),
  469.     append(R1,R2,T).
  470.  
  471. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  472. % get_degree(L1,N,L) L is L1^N
  473. % type: L1,L - l-polynomials, N - nonnegative integer
  474. % mode: get_degree(+,+,-)
  475.  
  476. get_degree(_L1,0,[[1,0]]).
  477. get_degree(L1,1,L1).
  478. get_degree(L1,N,L) :-
  479.     number(N),
  480.     N > 1,
  481.     M is N-1,
  482.     get_degree(L1,M,L2),
  483.     multiply_l(L1,L2,L).
  484.  
  485. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  486. % add_similar(L1,L2) implies that L2 is the result of
  487. % adding up similar terms of L2.
  488. % type: L1 and L2 are l-polynomials.
  489. % mode: add_similar(+,?)
  490.  
  491. add_similar([],[]).
  492. add_similar([[C1,N]|T],S) :-
  493.     append(A,[[C2,N]|B],T),
  494.     C is C1+C2,
  495.     append(A,[[C,N]|B],R),
  496.     add_similar(R,S).
  497.  
  498. add_similar([[C,N]|T],[[C,N]|ST]) :-
  499.     not_in(N,T),
  500.     add_similar(T,ST).
  501.  
  502. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  503. % not_in(N,L) holds if an l-polynomial L does not contain
  504. % a term with degree N
  505. % type: N - nonnegative integer, L l-polynomial
  506. % mode: not_in(+,+)
  507.  
  508. not_in(_,[]).
  509. not_in(_,[[]]).
  510. not_in(N,[[_,M]|T]) :-
  511.      is_neq(N,M),
  512.      not_in(N,T).
  513.  
  514. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  515. % remove_zero(L1,L2) iff list L2 is obtained from list L1
  516. % by removing terms of the form [0,N].
  517. % type: L1,L2  l-polynomilas
  518. % mode: remove_zero(+,?)
  519.  
  520. remove_zero([],[]).
  521. remove_zero([[0,_]|T],T1) :-
  522.     remove_zero(T,T1).
  523. remove_zero([[C,N]|T],[[C,N]|T1]) :-
  524.     is_neq(C,0),
  525.     remove_zero(T,T1).
  526.  
  527. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  528. % poly_sort(L1,L2) sorts l-polynomial L1 in decreasing order  
  529. % of exponents and stores the result in L2.
  530. % type: L1,L2  l-polynomilas
  531. % mode: poly_sort(+,-)
  532.  
  533. poly_sort([X|Xs],Ys) :-
  534.      poly_sort(Xs,Zs),
  535.      insert(X,Zs,Ys).
  536. poly_sort([],[]).
  537.  
  538. insert(X,[],[X]).
  539. insert(X,[Y|Ys],[Y|Zs]) :-
  540.      greater(Y,X),
  541.      insert(X,Ys,Zs).
  542. insert(X,[Y|Ys],[X,Y|Ys]) :-
  543.      greatereq(X,Y).
  544.  
  545. greater([_,N1],[_,N2]) :-
  546.      N1 > N2.
  547.  
  548. greatereq([_,N1],[_,N2]) :-
  549.      N1 >= N2.
  550.  
  551. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  552. % back_to_terms(X,L,T) computes a term-representation T of L.
  553. % L must be an l-polynomial sorted in decreasing order of
  554. % exponents and not containing terms of the form [0,N].
  555. % type: L l-polynomial, T polynomial.
  556. % mode: back_to_terms(+,+,?)
  557.  
  558. back_to_terms(XX,[[1,1]],XX).
  559. back_to_terms(XX,[[-1,1]],-XX).
  560. back_to_terms(_XX,[[C,0]],C) :-
  561.      integer(C).
  562. back_to_terms(XX,[[1,N]],XX^N):-
  563.       is_neq(N,0),
  564.       is_neq(N,1).
  565. back_to_terms(XX,[[-1,N]],-XX^N):-
  566.       is_neq(N,0),
  567.       is_neq(N,1).
  568. back_to_terms(XX,[[C,1]],C*XX):-
  569.       is_neq(C,1),
  570.       is_neq(C,-1).
  571. back_to_terms(XX,[[C,N]],C*XX^N):-
  572.      is_neq(N,1),
  573.      is_neq(C,1),
  574.      is_neq(C,-1).
  575. back_to_terms(XX,L,F+T) :-
  576.      append(L1,[[C,N]],L),
  577.      is_neq(L1,[]),
  578.      C > 0,
  579.      back_to_terms(XX,L1,F),
  580.      back_to_terms(XX,[[C,N]],T).
  581. back_to_terms(XX,L,F-T) :-
  582.      append(L1,[[C,N]],L),
  583.      is_neq(L1,[]),
  584.      C < 0,
  585.      abs(C,AC),
  586.      back_to_terms(XX,L1,F),
  587.      back_to_terms(XX,[[AC,N]],T).
  588.  
  589. eq(X,X).
  590. is_neq(X,Y) :-
  591.     \+ eq(X,Y).
  592. abs(X,X) :-
  593.     integer(X),
  594.     X >= 0.
  595. abs(X,Y) :-
  596.     integer(X),
  597.     X < 0,
  598.     Y is (-1)*X.
  599.  
  600.  
  601. % dee(+variable, +expression, -derivative)
  602. dee(X, X, 1).
  603. dee(X, Y, 0) :- atomic(Y), X \= Y.
  604.  
  605. dee(X, U + W, DU + DW) :- aux(X, U, W, DU, DW).
  606. dee(X, U - W, DU - DW) :- aux(X, U, W, DU, DW).
  607.  
  608. dee(X, U * W, U * DW + W * DU) :- aux(X, U, W, DU, DW).
  609.  
  610. dee(X, -U, -DU) :- dee(X, U, DU).
  611.  
  612. aux(X, U, W, DU, DW) :-
  613.     dee(X, U, DU),
  614.     dee(X, W, DW).
  615.  
  616. % Rather than a larger class of symbolic expressions,
  617. % one might be tempted to implement a simplifier :-)
  618. %
  619. % | ?-
  620. /*
  621.  dee(x, (x + c) * (x - 1), D),            
  622.       dee(x, x * (x - 1) + c * (x - 1), E),
  623.       dee(x, x * x - x + c * x - c, F).    
  624. */
  625. %
  626. % D = (x+c)*(1-0)+(x-1)*(1+0)
  627. % E = x*(1-0)+(x-1)*1+(c*(1-0)+(x-1)*0)
  628. % F = x*1+x*1-1+(c*1+x*0)-0 ? ;
  629. %
  630. % no
  631.  
  632.  
  633. opt_sum(X, X, 0).
  634. opt_sum(Y, 0, Y).
  635.  
  636. opt_sum(W, X, Y) :-
  637.     numeric_1(X),
  638.     numeric_1(Y),
  639.     W is X + Y.
  640.  
  641. opt_sum(2*X, X, Y) :-
  642.     X == Y.
  643.    
  644. opt_sum(X+Y, X, Y).
  645.  
  646. %%%%%%%%%%%%%%%%%%%%%%%%%%
  647. opt_sub(X, X, 0).
  648. opt_sub(-Y, 0, Y).
  649.  
  650. opt_sub(W, X, Y) :-
  651.     numeric_1(X),
  652.     numeric_1(Y),
  653.     W is X - Y.
  654.  
  655. opt_sub(0, X, Y) :-
  656.     X == Y.
  657.    
  658. opt_sub(X-Y, X, Y).
  659.  
  660. %%%%%%%%%%%%%%%%%%%%%%%%%%
  661. opt_mul(0, 0, _).
  662. opt_mul(0, _, 0).
  663.  
  664. opt_mul(Y, 1, Y).
  665. opt_mul(X, X, 1).
  666.  
  667. opt_mul(Y, X, Y) :-
  668.     X == 1.
  669.  
  670. opt_mul(W, X, Y) :-
  671.     numeric_1(X),
  672.     numeric_1(Y),
  673.     W is X * Y.
  674.  
  675. opt_mul(X*Y, X, Y).
  676.  
  677. %%%%%%%%%%%%%%%%%%%%%%%%%%
  678. opt_div(_,_,0) :-
  679.     throw(error(evaluation_error(zero_divisor),(is)/2)).
  680.    
  681. opt_div(0, 0, _N).
  682.  
  683. opt_div(X, X, 1).
  684.  
  685. opt_div(1, X, Y) :-
  686.     X == Y.
  687.    
  688. opt_div(W, X, Y) :-
  689.     numeric_1(X),
  690.     numeric_1(Y),
  691.     W is X / Y.
  692.  
  693. opt_div(X/Y, X, Y).
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!