%% derivatives.pl -- Chapter 12, Section 12.2.3 %% Last Modified: 2/4/14 %% This is a Prolog program which computes derivatives %% of polynomials. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % COMPUTING DERIVATIVES of POLYNOMIALS % For the purpose of this program polynomials are functions % constructed from a variable x, integers, function symbols % +, -, * and ^, and parentheses. Exponentiation X^N is % defined for nonnegative integer N. % The derivative is only computed once. Multiple calls can lead % to an infinite loop. :-use_module(library(lists)). % not needed for SWI Prolog %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % derivative(F,DF) computes a derivative DF of a polynomial F. % The result is given in canonical form. % type F, DF - polynomials. % mode derivative(+,-) derivative(F,DF) :- der(F,G), simplify(G,DF). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % der(F,DF) computes a derivative DF of a polynomial F. % type F, DF - polynomials. % mode der(+,-). der(N,0) :- number(N). der(x,1). der(-x,-1). der(F^0,0). der(F^N, N*F^M*DF) :- N>=1, M is N-1, der(F,DF). der(E1*E2, E1*DE2 + E2*DE1) :- der(E1,DE1), der(E2,DE2). der(E1+E2, DE1+DE2) :- der(E1,DE1), der(E2,DE2). der(E1-E2,DE1-DE2) :- der(E1,DE1), der(E2,DE2). der(-(E),DE) :- der((-1)*E,DE). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %To simplify the resulting derivative we represent polynomials %as lists of the form [...[Ci,Ni]...] where [Ci,Ni] corresponds %to the term Ci*x^Ni. Polynomials, written in this form will be %called l-polynomials. The derivative DF of F computed %by der(F,DF) will be translated into equivalent l-polynomial, %written in canonical form and transformed back into the term form. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % simplify(P,SP) iff SP is a canonical form of a polynomial P % type: P, SP - polynomials % mode simplify(+,?) simplify(P,SP) :- transform(P,TP), add_similar(TP,S), remove_zero(S,S1), poly_sort(S1,S2), back_to_terms(S2,SP). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % transform(T,[[C1,N1],...,[Ck,Nk]]) implies that % T = C1*x^N1 +...+ Ck*x^Nk. % type: T - polynomial, C - integer, N - nonnegative integer. % mode: transform(+,?). transform(C,[[C,0]]) :- integer(C). transform(x,[[1,1]]). transform(-x,[[-1,1]]). transform(A*B,L) :- transform(A,L1), transform(B,L2), multiply(L1,L2,L). transform(A^N,L) :- transform(A,L1), get_degree(L1,N,L). transform(A+B,RT) :- transform(A,RA), transform(B,RB), append(RA,RB,RT). transform(A-B,RT) :- transform(A,RA), transform(-B,RB), append(RA,RB,RT). transform(-(A),R) :- transform((-1)*A,R). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % multiply(L1,L2,L) L is the product of L1 and L2 % type: L1,L2,L - l-polynomials % mode: multiply(+,+,-) multiply_one(_,[],[]). multiply_one([C1,N1],[[C2,N2]|R],[[C,N]|T]) :- C is C1*C2, N is N1+N2, multiply_one([C1,N1],R,T). multiply([],_,[]). multiply([H1|T1],T2,T) :- multiply_one(H1,T2,R1), multiply(T1,T2,R2), append(R1,R2,T). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % get_degree(L1,N,L) L is L1^N % type: L1,L - l-polynomials, N - nonnegative integer % mode: get_degree(+,+,-) get_degree(L1,0,[[1,0]]). get_degree(L1,1,L1). get_degree(L1,N,L) :- N > 1, M is N-1, get_degree(L1,M,L2), multiply(L1,L2,L). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % add_similar(L1,L2) implies that L2 is the result of % adding up similar terms of L2. % type: L1 and L2 are l-polynomials. % mode: add_similar(+,?) add_similar([],[]). add_similar([[C1,N]|T],S) :- append(A,[[C2,N]|B],T), C is C1+C2, append(A,[[C,N]|B],R), add_similar(R,S). add_similar([[C,N]|T],[[C,N]|ST]) :- not_in(N,T), add_similar(T,ST). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % not_in(N,L) holds if an l-polynomial L does not contain % a term with degree N % type: N - nonnegative integer, L l-polynomial % mode: not_in(+,+) not_in(_,[]). not_in(_,[[]]). not_in(N,[[_,M]|T]) :- diff(N,M), not_in(N,T). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % remove_zero(L1,L2) iff list L2 is obtained from list L1 % by removing terms of the form [0,N]. % type: L1,L2 l-polynomilas % mode: remove_zero(+,?) remove_zero([],[]). remove_zero([[0,_]|T],T1) :- remove_zero(T,T1). remove_zero([[C,N]|T],[[C,N]|T1]) :- diff(C,0), remove_zero(T,T1). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % poly_sort(L1,L2) sorts l-polynomial L1 in decreasing order % of exponents and stores the result in L2. % type: L1,L2 l-polynomilas % mode: poly_sort(+,-) poly_sort([X|Xs],Ys) :- poly_sort(Xs,Zs), insert(X,Zs,Ys). poly_sort([],[]). insert(X,[],[X]). insert(X,[Y|Ys],[Y|Zs]) :- greater(Y,X), insert(X,Ys,Zs). insert(X,[Y|Ys],[X,Y|Ys]) :- greatereq(X,Y). greater([_,N1],[_,N2]) :- N1 > N2. greatereq([_,N1],[_,N2]) :- N1 >= N2. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % back_to_terms(L,T) computes a term-representation T of L. % L must be an l-polynomial sorted in decreasing order of % exponents and not containing terms of the form [0,N]. % type: L l-polynomial, T polynomial. % mode: back_to_terms(+,?) back_to_terms([[1,1]],x). back_to_terms([[-1,1],-x]). back_to_terms([[C,0]],C) :- integer(C). back_to_terms([[1,N]],x^N):- diff(N,0), diff(N,1). back_to_terms([[-1,N]],-x^N):- diff(N,0), diff(N,1). back_to_terms([[C,1]],C*x):- diff(C,1), diff(C,-1). back_to_terms([[C,N]],C*x^N):- diff(N,1), diff(C,1), diff(C,-1). back_to_terms(L,F+T) :- append(L1,[[C,N]],L), diff(L1,[]), C > 0, back_to_terms(L1,F), back_to_terms([[C,N]],T). back_to_terms(L,F-T) :- append(L1,[[C,N]],L), diff(L1,[]), C < 0, abs(C,AC), back_to_terms(L1,F), back_to_terms([[AC,N]],T). eq(X,X). diff(X,Y) :- \+ eq(X,Y). abs(X,X) :- integer(X), X >= 0. abs(X,Y) :- integer(X), X < 0, Y is (-1)*X.