module expvec;
% /*Specific support for distributive polynomial exponent vectors*/
% /* Authors: R. Gebauer, A. C. Hearn, H. Kredel */
% We assume here that an exponent vector is a list of integers. This
% version uses small integer arithmetic on the individual exponents
% and assumes that a compiled function can be dynamically redefined*/
% Modification H. Melenk (August 1988)
% 1. Most ev-routines handle exponent vectors with variable length:
% the convention is, that trailing zeros may be omitted.
% 2. evcompless!? is mapped to evcomp such that each term order mode
% is supported by exactly one procedure entry.
% 3. complete exponent vector compare collected in separate module
% TORDER (TORD33)
fluid '(dipsortmode!* dipvars!*);
symbolic procedure evperm (e1,n);
% /* Exponent vector permutation. e1 is an exponent vector, n is a
% index list , a list of digits. evperm(e1,n) returns a list e1
% permuted in respect to n. */
if null n then nil
else evnth(e1, car n) . evperm(e1, cdr n);
symbolic procedure evcons (e1,e2);
% /* Exponent vector construct. e1 and e2 are exponents. evcons(e1,e2)
% constructs an exponent vector. */
e1 . e2;
symbolic procedure evnth (e1,n);
% /* Exponent vector n-th element. e1 is an exponent vector, n is a
% digit. evnth(e1,n) returns the n-th element of e1, an exponent. */
if null e1 then 0 else
if n = 1 then evfirst e1 else evnth(evred e1, n - 1);
symbolic procedure evred e1;
% /* Exponent vector reductum. e1 is an exponent vector. evred(e1)
% returns the reductum of the exponent vector e1. */
if e1 then cdr e1 else NIL;
symbolic procedure evfirst e1;
% /* Exponent vector first. e1 is an exponent vector. evfirst(e1)
% returns the first element of the exponent vector e1, an exponent. */
if e1 then car e1 else 0;
symbolic procedure evsum0(n,p);
% exponent vector sum version 0. n is the length of dipvars!*.
% p is a distributive polynomial.
if dipzero!? p then evzero1 n else
evsum(dipevlmon p, evsum0(n,dipmred p));
symbolic procedure evzero1 n;
% Returns the exponent vector power representation
% of length n for a zero power.
begin scalar x;
for i:=1: n do << x := 0 . x >>;
return x
end;
symbolic procedure indexcpl(ev,n);
% returns a list of indexes of non zero exponents.
if null ev then ev else ( if car ev = 0 then
indexcpl(cdr ev,n + 1) else
( n . indexcpl(cdr ev,n + 1)) );
symbolic procedure evzer1!? e;
% returns a boolean expression. true if e is null else false.
null e;
symbolic procedure evzero!? e;
% /* Returns a boolean expression. True if all exponents are zero*/
null e or car e = 0 and evzero!? cdr e;
symbolic procedure evzero;
% /* Returns the exponent vector representation for a zero power*/
% for i := 1:length dipvars!* collect 0;
begin scalar x;
for i := 1:length dipvars!* do <<x := 0 . x>>;
return x
end;
symbolic procedure mkexpvec u;
% /* Returns an exponent vector with a 1 in the u place*/
if not(u member dipvars!*) then typerr(u,"dipoly variable")
else for each x in dipvars!* collect if x eq u then 1 else 0;
symbolic procedure evlcm (e1,e2);
% /* Exponent vector least common multiple. e1 and e2 are
% exponent vectors. evlcm(e1,e2) computes the least common
% multiple of the exponent vectors e1 and e2, and returns
% an exponent vector. */
% for each lpart in e1 each rpart in e2 collect
% if lpart #> rpart then lpart else rpart;
begin scalar x;
while e1 and e2 do
<<x := (if car e1 #> car e2 then car e1 else car e2) . x;
e1 := cdr e1; e2 := cdr e2>>;
return reversip x
end;
symbolic procedure evmtest!? (e1,e2);
% /* Exponent vector multiple test. e1 and e2 are compatible exponent
% vectors. evmtest!?(e1,e2) returns a boolean expression.
% True if exponent vector e1 is a multiple of exponent
% vector e2, else false. */
if e1 and e2 then not(car e1 #< car e2) and evmtest!?(cdr e1,cdr e2)
else evzero!? e2 ;
symbolic procedure evsum (e1,e2);
% /* Exponent vector sum. e1 and e2 are exponent vectors.
% evsum(e1,e2) calculates the sum of the exponent vectors.
% e1 and e2 componentwise and returns an exponent vector. */
% for each lpart in e1 each rpart in e2 collect lpart #+ rpart;
begin scalar x;
while e1 and e2 do
<<x := (car e1 #+ car e2) . x; e1 := cdr e1; e2 := cdr e2>>;
x := reversip x;
return if e1 then nconc(x,e1) else
if e2 then nconc(x,e2) else x;
end;
symbolic procedure evdif (e1,e2);
% /* Exponent vector difference. e1 and e2 are exponent
% vectors. evdif(e1,e2) calculates the difference of the
% exponent vectors e1 and e2 componentwise and returns an
% exponent vector. */
% for each lpart in e1 each rpart in e2 collect lpart #- rpart;
begin scalar x;
while e2 do
<<if null e1 then e1 := '(0);
x := (car e1 #- car e2) . x; e1 := cdr e1; e2 := cdr e2>>;
return nconc (reversip x,e1);
end;
symbolic procedure intevprod(n,e);
% /* Multiplies each element of the exponent vector u by the integer n*/
for each x in e collect n #* x;
symbolic procedure expvec2a e;
% /* Returns list of prefix equivalents of exponent vector e*/
expvec2a1(e,dipvars!*);
symbolic procedure expvec2a1(u,v);
% /* Sub function of expvec2a */
if null u then nil
else if car u = 0 then expvec2a1(cdr u,cdr v)
else if car u = 1 then car v . expvec2a1(cdr u,cdr v)
else list('expt,car v,car u) . expvec2a1(cdr u,cdr v);
symbolic procedure dipevlpri(e,v);
% /* Print exponent vector e in infix form. V is a boolean variable
% which is true if an element in a product has preceded this one*/
dipevlpri1(e,dipvars!*,v);
symbolic procedure dipevlpri1(e,u,v);
% /* Sub function of dipevlpri */
if null e then nil
else if car e = 0 then dipevlpri1(cdr e,cdr u,v)
else <<if v then dipprin2 "*";
if atom car u or null get(caar u,'dipprifn)
then dipprin2 car u
else apply1(get(caar u,'dipprifn),car u);
if car e #> 1 then <<dipprin2 "**"; dipprin2 car e>>;
dipevlpri1(cdr e,cdr u,t)>>;
endmodule;
end;