(* ----------------------------------------------------------------------------
* $Id: SACEXT4.mi,v 1.3 1992/10/15 16:28:57 kredel Exp $
* ----------------------------------------------------------------------------
* This file is part of MAS.
* ----------------------------------------------------------------------------
* Copyright (c) 1989 - 1992 Universitaet Passau
* ----------------------------------------------------------------------------
* $Log: SACEXT4.mi,v $
* Revision 1.3 1992/10/15 16:28:57 kredel
* Changed rcsid variable
*
* Revision 1.2 1992/02/12 17:34:50 pesch
* Moved CONST definition to the right place
*
* Revision 1.1 1992/01/22 15:15:58 kredel
* Initial revision
*
* ----------------------------------------------------------------------------
*)
IMPLEMENTATION MODULE SACEXT4;
(* SAC Extensions 4 Implementation Module. *)
(* Import lists and declarations. *)
FROM MASSTOR IMPORT LIST, SIL, BETA,
LIST1, INV, COMP, SRED, ADV, FIRST, RED;
FROM SACLIST IMPORT CINV, CONC, LIST2, ADV2, COMP2,
COMP4, FIRST2, LAST;
FROM SACI IMPORT IQ;
FROM SACRN IMPORT RNINT, RNPROD, RNINV;
FROM SACCOMB IMPORT LPERM;
FROM SACPOL IMPORT PLBCF, PDPV, PDEG, PMON, PLDCF;
FROM SACIPOL IMPORT IPQ, IPIQ, IPGSUB;
FROM SACRPOL IMPORT RPRNP, RPFIP;
FROM SACPGCD IMPORT IPSCPP;
CONST rcsidi = "$Id: SACEXT4.mi,v 1.3 1992/10/15 16:28:57 kredel Exp $";
CONST copyrighti = "Copyright (c) 1989 - 1992 Universitaet Passau";
PROCEDURE IPINT(RL,A,BL: LIST): LIST;
(*Integral polynomial integration. A is a non-zero integral
polynomial in r variables, r ge 1, such that the integral of a with
respect to its main variable is an integral polynomial. b is an
integral polynomial in r-1 variables. B eq B(x sub 1 , ..., x sub r )
is the integral of a with respect to its main variable, such that
B(x sub 1 , ..., x sub r-1 ,0) eq b.*)
VAR AL, AP, B, CL, EL, RLP: LIST;
BEGIN
(*1*) AP:=A; B:=BETA; RLP:=RL-1;
REPEAT ADV2(AP, EL,AL,AP); EL:=EL+1;
IF RL = 1 THEN CL:=IQ(AL,EL); ELSE
CL:=IPIQ(RLP,AL,EL); END;
B:=COMP2(CL,EL,B);
UNTIL (AP = SIL);
IF BL <> 0 THEN B:=COMP2(BL,0,B); END;
B:=INV(B); RETURN(B);
(*4*) END IPINT;
PROCEDURE IUPIHT(A,NL: LIST): LIST;
(*Integral univariate polynomial integer homothetic transformation.
A is a non-zero univariate integral polynomial. n is a non-zero
integer. B(x) is the primitive part of A(nx).*)
VAR B, CL, J1Y, M, SL: LIST;
BEGIN
(*1*) M:=PMON(NL,1); J1Y:=LIST1(M); B:=IPGSUB(1,A,1,J1Y);
IPSCPP(1,B,SL,CL,B); RETURN(B);
(*4*) END IUPIHT;
PROCEDURE PCONST(RL,A: LIST): LIST;
(*Polynomial constant. A(x sub 1 , ..., x sub r ) is a polynomial
in r variables, r ge 1. b eq 1 if a is a constant polynomial,
otherwise b eq 0.*)
VAR AP, BL, IL: LIST;
BEGIN
(*1*) (*a eq 0.*) BL:=1;
IF A = 0 THEN RETURN(BL); END;
(*2*) (*a ne 0.*) AP:=A;
FOR IL:=1 TO RL DO
IF PDEG(AP) <> 0 THEN BL:=0; RETURN(BL); ELSE
AP:=PLDCF(AP); END;
END;
RETURN(BL);
(*5*) END PCONST;
PROCEDURE PSDSV(RL,A,IL,NL: LIST): LIST;
(*Polynomial special decomposition, specified variable. A is a
polynomial in r variables. 1 le i le r and n is a beta-integer such
that each exponent of x sub i occurring in a is divisible by n.
B is A with each exponent e of x sub i replaced by e/n.*)
VAR AL, AP, B, BL, EL, FL, RLP: LIST;
BEGIN
(*1*) (*a eq 0 or n eq 0.*)
IF (A = 0) OR (NL = 0) THEN B:=A; RETURN(B); END;
(*2*) (*general case.*) AP:=A; B:=BETA; RLP:=RL-1;
REPEAT ADV2(AP, EL,AL,AP);
IF IL = RL THEN BL:=AL; FL:=EL DIV NL; ELSE
BL:=PDPV(RLP,AL,IL,NL); FL:=EL; END;
B:=COMP2(BL,FL,B);
UNTIL (AP = SIL);
B:=INV(B); RETURN(B);
(*5*) END PSDSV;
PROCEDURE PUNT(RL,A: LIST): LIST;
(*Polynomial univariate test. A eq A(x sub 1 , ..., x sub r ) is a
polynomial in r variables, r ge 1. b eq 2 if A has degree zero in all
variables. b eq 1 if A has degree zero in x sub 2 , ..., x sub r, but
positive degree in x sub 1. otherwise b eq 0.*)
VAR AP, BL, IL: LIST;
BEGIN
(*1*) (*a eq 0.*) BL:=2;
IF A = 0 THEN RETURN(BL); END;
(*2*) (*a ne 0.*) AP:=A;
FOR IL:=1 TO RL-1 DO
IF PDEG(AP) <> 0 THEN BL:=0; RETURN(BL); ELSE
AP:=PLDCF(AP); END;
END;
IF PDEG(AP) > 0 THEN BL:=1; END;
RETURN(BL);
(*5*) END PUNT;
PROCEDURE RPDMV(RL,A: LIST): LIST;
(*Rational polynomial derivative, main variable. A is a rational
polynomial in r variables. B is the derivative of A with respect to
its main variable.*)
VAR AL, AP, B, BL, EL, ELP, J1Y, RLP: LIST;
BEGIN
(*1*) (*a=0.*)
IF A = 0 THEN B:=0; RETURN(B); END;
(*2*) (*general case.*) AP:=A; RLP:=RL-1; B:=BETA;
REPEAT ADV2(AP, EL,AL,AP);
IF RLP = 0 THEN J1Y:=RNINT(EL); BL:=RNPROD(J1Y,AL);
ELSE J1Y:=RNINT(EL); BL:=RPRNP(RLP,J1Y,AL); END;
ELP:=EL-1;
IF EL <> 0 THEN B:=COMP2(BL,ELP,B); END;
UNTIL (AP = SIL);
B:=INV(B);
IF B = SIL THEN B:=0; END;
RETURN(B);
(*5*) END RPDMV;
PROCEDURE RPMAIP(RL,A: LIST): LIST;
(*Rational polynomial monic associate of integral polynomial.
A is an integral polynomial in r variables, r ge 1. If A eq 0
then B eq 0. if A ne 0, let the integer a be the leading base
coefficient of A. Then B eq (1/a) A, a monic rational polynomial.*)
VAR AL, B: LIST;
BEGIN
(*1*) (*a eq 0.*)
IF A = 0 THEN B:=0; RETURN(B); END;
(*2*) (*a ne 0.*) B:=RPFIP(RL,A); AL:=PLBCF(RL,B); AL:=RNINV(AL);
B:=RPRNP(RL,AL,B); RETURN(B);
(*5*) END RPMAIP;
(* unused code, since the representation of distributive
polynomials in DIP is different.
FROM SACPOL IMPORT DIPFP, PFDIP;
PROCEDURE DIPINS(AL,DL,A: LIST; VAR TL,B: LIST);
(*Distributed polynomial, insert term. A is either a distributed
polynomial in r variables, r ge 0, or the null list. a is the
coefficient and d the degree vector of a term in r variables
to be inserted. If d does not already occur in A, then t eq 1 and
B is the distributive polynomial resulting from inserting the term.
If d does already occur in A, then t eq 0 and B eq A.*)
VAR ALP, AP, BL, DLP: LIST;
BEGIN
(*1*) (*a empty.*) TL:=1;
IF A = SIL THEN B:=LIST2(AL,DL); RETURN; END;
B:=A;
(*2*) (*a nonempty.*) AP:=A; ADV2(AP, ALP,DLP,AP); BL:=DVCMP(DL,DLP);
IF BL = 0 THEN TL:=0; RETURN; END;
IF BL > 0 THEN B:=COMP2(AL,DL,A); RETURN; END;
B:=LIST2(DLP,ALP);
WHILE AP <> SIL DO ADV2(AP, ALP,DLP,AP); BL:=DVCMP(DL,DLP);
IF BL = 0 THEN B:=A; TL:=0; RETURN; END;
IF BL > 0 THEN B:=COMP4(DLP,ALP,DL,AL,B); B:=INV(B);
B:=CONC(B,AP); RETURN; END;
B:=COMP2(DLP,ALP,B); END;
B:=COMP2(DL,AL,B); B:=INV(B); RETURN;
(*5*) END DIPINS;
PROCEDURE DVCMP(DL1,DL2: LIST): LIST;
(*Degree vector comparison. d1 and d2 are degree vectors of
distributive polynomials in r variables, r ge 0. With respect to
the inverse lexicographical ordering of degree vectors, b eq -1
if d1 lt d2, b eq 0 if d1 eq d2, and b eq 1 if d1 gt d2.*)
VAR BL, DLP1, DLP2, EL1, EL2: LIST;
BEGIN
(*1*) DLP1:=DL1; DLP2:=DL2; BL:=0;
WHILE DLP1 <> SIL DO ADV(DLP1, EL1,DLP1); ADV(DLP2, EL2,DLP2);
IF EL1 < EL2 THEN BL:=-1; RETURN(BL); END;
IF EL1 > EL2 THEN BL:=1; RETURN(BL); END;
END;
RETURN(BL);
(*4*) END DVCMP;
PROCEDURE PPERMV(RL,A,P: LIST): LIST;
(*Polynomial permutation of variables. A is a polynomial in r
variables, r ge 0. P is a list (P sub 1 , ..., P sub r ) whose
elements are the beta-digits 1 through r. B(x sub (P sub 1)
, ..., x sub (P sub r) ) eq A(x sub 1 , ..., x sub r ).*)
VAR AL, AP, B, BP, DL, DLP, TL: LIST;
BEGIN
(*1*) (*a eq 0.*)
IF A = 0 THEN B:=0; RETURN(B); END;
(*2*) (*convert a to distributive representation and reorder.*)
AP:=DIPFP(RL,A); BP:=BETA;
REPEAT ADV2(AP, AL,DL,AP); DLP:=CINV(DL); DLP:=LPERM(DLP,P);
DLP:=INV(DLP); DIPINS(AL,DLP,BP, TL,BP);
UNTIL (AP = SIL);
(*3*) (*convert back to recursive representation.*) B:=PFDIP(RL,BP);
RETURN(B);
(*6*) END PPERMV;
end of unused code. *)
END SACEXT4.
(* -EOF- *)