1% generated: 8 March 1990
2% option(s): NO_TERM_COMPARE
3%
4%   (poly) poly_10
5%
6%   Ralph Haygood (based on Prolog version by Rick McGeer
7%                  based on Lisp version by R. P. Gabriel)
8%
9%   raise a polynomial (1+x+y+z) to the 10th power (symbolically)
10
11:-op(700,xfx,less_than).
12
13top:-poly_10.
14
15poly_10 :- test_poly(P), poly_exp(10, P, _).
16
17% test polynomial definition
18
19test_poly(P) :-
20    poly_add(poly(x,[term(0,1),term(1,1)]),poly(y,[term(1,1)]),Q),
21    poly_add(poly(z,[term(1,1)]),Q,P).
22
23% 'less_than'/2 for x, y, z
24
25x less_than y.
26y less_than z.
27x less_than z.
28
29% polynomial addition
30
31poly_add(poly(Var,Terms1), poly(Var,Terms2), poly(Var,Terms)) :- !,
32    term_add(Terms1, Terms2, Terms).
33poly_add(poly(Var1,Terms1), poly(Var2,Terms2), poly(Var1,Terms)) :-
34    Var1 less_than Var2, !,
35    add_to_order_zero_term(Terms1, poly(Var2,Terms2), Terms).
36poly_add(Poly, poly(Var,Terms2), poly(Var,Terms)) :- !,
37    add_to_order_zero_term(Terms2, Poly, Terms).
38poly_add(poly(Var,Terms1), C, poly(Var,Terms)) :- !,
39    add_to_order_zero_term(Terms1, C, Terms).
40poly_add(C1, C2, C) :-
41    C is C1+C2.
42
43% term addition
44
45term_add([], X, X) :- !.
46term_add(X, [], X) :- !.
47term_add([term(E,C1)|Terms1], [term(E,C2)|Terms2], [term(E,C)|Terms]) :- !,
48    poly_add(C1, C2, C),
49    term_add(Terms1, Terms2, Terms).
50term_add([term(E1,C1)|Terms1], [term(E2,C2)|Terms2], [term(E1,C1)|Terms]) :-
51    E1 < E2, !,
52    term_add(Terms1, [term(E2,C2)|Terms2], Terms).
53term_add(Terms1, [term(E2,C2)|Terms2], [term(E2,C2)|Terms]) :-
54    term_add(Terms1, Terms2, Terms).
55
56add_to_order_zero_term([term(0,C1)|Terms], C2, [term(0,C)|Terms]) :- !,
57    poly_add(C1, C2, C).
58add_to_order_zero_term(Terms, C, [term(0,C)|Terms]).
59
60% polynomial exponentiation
61
62poly_exp(0, _, 1) :- !.
63poly_exp(N, Poly, Result) :-
64    M is N>>1,
65    N is M<<1, !,
66    poly_exp(M, Poly, Part),
67    poly_mul(Part, Part, Result).
68poly_exp(N, Poly, Result) :-
69    M is N-1,
70    poly_exp(M, Poly, Part),
71    poly_mul(Poly, Part, Result).
72
73% polynomial multiplication
74
75poly_mul(poly(Var,Terms1), poly(Var,Terms2), poly(Var,Terms)) :- !,
76    term_mul(Terms1, Terms2, Terms).
77poly_mul(poly(Var1,Terms1), poly(Var2,Terms2), poly(Var1,Terms)) :-
78    Var1 less_than Var2, !,
79    mul_through(Terms1, poly(Var2,Terms2), Terms).
80poly_mul(P, poly(Var,Terms2), poly(Var,Terms)) :- !,
81    mul_through(Terms2, P, Terms).
82poly_mul(poly(Var,Terms1), C, poly(Var,Terms)) :- !,
83    mul_through(Terms1, C, Terms).
84poly_mul(C1, C2, C) :-
85    C is C1*C2.
86
87term_mul([], _, []) :- !.
88term_mul(_, [], []) :- !.
89term_mul([Term|Terms1], Terms2, Terms) :-
90    single_term_mul(Terms2, Term, PartA),
91    term_mul(Terms1, Terms2, PartB),
92    term_add(PartA, PartB, Terms).
93
94single_term_mul([], _, []) :- !.
95single_term_mul([term(E1,C1)|Terms1], term(E2,C2), [term(E,C)|Terms]) :-
96    E is E1+E2,
97    poly_mul(C1, C2, C),
98    single_term_mul(Terms1, term(E2,C2), Terms).
99
100mul_through([], _, []) :- !.
101mul_through([term(E,Term)|Terms], Poly, [term(E,NewTerm)|NewTerms]) :-
102    poly_mul(Term, Poly, NewTerm),
103    mul_through(Terms, Poly, NewTerms).
104