(* ----------------------------------------------------------------------------
* $Id: CGBMISC.mip,v 1.10 1996/06/08 16:47:13 pesch Exp $
* ----------------------------------------------------------------------------
* This file is part of MAS.
* ----------------------------------------------------------------------------
* Copyright (c) 1992-1996 Universitaet Passau
* ----------------------------------------------------------------------------
* $Log: CGBMISC.mip,v $
* Revision 1.10 1996/06/08 16:47:13 pesch
* Reformatted, removed obsolete procedures.
*
* Revision 1.9 1996/04/24 12:09:55 pesch
* Used EVOWRITE instead of WRORD for writing term orders.
* Removed WRORD.
* Reformatted import lists.
*
* Revision 1.8 1996/04/23 13:52:31 pesch
* Corrected printing of options.
*
* Revision 1.7 1995/03/23 16:05:46 pesch
* Added new data structure Colp for coloured polynomials.
*
* Revision 1.6 1995/03/06 15:49:36 pesch
* Added new procedure GSYSF, Groebner system with factorization. This uses
* the new procedures GBSYSF and CONSGBF (also added).
*
* Added new procedures DIP2AD, AD2DIP and DIPPFACTAV.
*
* Fixed error in CHECK.
*
* New option for factorization of conditions: factorize with optimization
* of variable ordering.
*
* Revision 1.5 1994/04/14 16:46:11 dolzmann
* Syntactical errors (founded by Mocka) corrected.
*
* Revision 1.4 1994/04/10 17:58:39 pesch
* Added option to compute generic case (coeficients are considered
* rational functions, the necessary non-zero conditions are collected) only.
*
* Revision 1.3 1994/04/09 18:06:00 pesch
* Reformatted parts of the CGB sources. Updated comments in CGB*.md.
*
* Revision 1.2 1994/03/14 16:42:59 pesch
* Minor changes requested by A. Dolzmann
*
* Revision 1.1 1994/03/11 15:58:16 pesch
* Major changes to CGB.
* C-Preprocessor now used for .mip files. The corresponding .mi files have
* been removed.
* Many new CGB-Functions and fixes of old ones.
*
* ----------------------------------------------------------------------------
*)
#include "debug.h"
IMPLEMENTATION MODULE CGBMISC;
(* Comprehensive-Groebner-Bases Miscellaneous Programs Implementation Module.*)
(* Import lists and declarations. *)
FROM ADTOOLS IMPORT ADDDFSTR;
FROM CGBAPPL IMPORT CGBQUA, CPART, DIMEXE, GBHELP, GTEST, INTDIM, MCOEF,
NFEXEC, NSET, WRCONJ, WRDIMS, WRQFN0, WRTEST;
FROM CGBDSTR IMPORT CondCons, CondEmpty, CondIsEmpty, CondNzero,
CondParts, CondZero;
FROM CGBFUNC IMPORT ADDCON, AINB, CGBCOL, CGBFRM, CGBLM, CGBLPM, DCLWR,
DET, DETPOL, DWRIT, EQPLCL, FINDBC, FINDCP, FINDRM,
GREPOL, MKPOL, REDSRT, SETCOL, VERIFY, WMEMB, WRTERM;
FROM CGBSYS IMPORT ADDCGB, CHDEGL, CMULT, COLDIF, COLPRD, FINCOL,
FINDPI, GBDIFF, GBSYS, GBUPD, GLEXTP, GLOBRE, GRED,
GSRED, GSYSN0, KEYCOL, MINPP, MKACOL, MKCGB, MKCOL,
MKN0, MKN1, MKNEWP, MKPAIR, NFORM, NFTOP, PRSCOP,
RDNORM, REDUCT, REFIND, REXTP, RMGRT, SPOL, UPDPP,
VRNORM, WHSRT, WUPD;
FROM DIPADOM IMPORT DIFIP, DILRD, DILWR, DIPBCP, DIPDIF, DIPEXP, DIPNEG,
DIPROD, DIPSUM, DIREAD, DIWRIT;
FROM DIPC IMPORT DILBSO, DIPBSO, DIPERM, DIPEVL, DIPFMO, DIPFP,
DIPLBC, DIPLPM, DIPMAD, DIPMCP, DIPTDG, EVCOMP,
EVDIF, EVLCM, EVMT, EVORD, EVOWRITE, EVSIGN, EVSUM,
GRLEX, IGRLEX, INVLEX, LEX, PFDIP, REVILEX, REVITDG,
REVLEX, REVTDEG, VALIS;
FROM DIPI IMPORT DIIPAB, DIIPCP, DIIPIQ, DIIPNG, DIIPON, DIIPSG,
DIIPWR;
FROM DIPIDGB IMPORT DIIPDNF;
FROM DIPIGB IMPORT DIIGBA, DIIPGB, DIIPNF;
FROM DIPTOO IMPORT DIPVOPP, INVPERM;
FROM DIPTOOLS IMPORT ADDDFDIP, DIPFDIPP, DIPPFDIP;
FROM IO IMPORT WriteI;
FROM MASADOM IMPORT ADCNST, ADDDREAD, ADDDWRIT, ADDIF, ADEXP, ADFACT,
ADFACTO, ADFI, ADFIP, ADGCD, ADGCDC, ADINV, ADINVT,
ADLCM, ADNEG, ADONE, ADPROD, ADQUOT, ADREAD, ADSIGN,
ADSUM, ADTOIP, ADVLDD, ADWRIT, DomSummary;
FROM MASBIOS IMPORT BKSP, BLINES, CREAD, CREADB, DIGIT, LETTER, LISTS,
MASORD, SWRITE;
FROM MASERR IMPORT ERROR, fatal, harmless, severe, spotless;
FROM MASSTOR IMPORT ADV, BETA, COMP, FIRST, INV, LENGTH, LIST, LIST1,
LISTVAR, RED, SFIRST, SIL, SRED, TIME;
FROM MASSYM2 IMPORT SREAD1, UWRITE, UWRIT1;
FROM SACLIST IMPORT ADV2, ADV3, AREAD, AWRITE, CINV, CLOUT, COMP2, COMP3,
CONC, EQUAL, FIRST2, FIRST3, FIRST4, FOURTH, LAST,
LIST2, LIST3, LIST4, LIST5, LWRITE, MEMBER, OWRITE,
RED2, SECOND, THIRD;
FROM SACPFAC IMPORT IPFAC;
FROM SACPOL IMPORT VLREAD, VLWRIT;
CONST rcsidi = "$Id: CGBMISC.mip,v 1.10 1996/06/08 16:47:13 pesch Exp $";
CONST copyrighti = "Copyright (c) 1992-1996 Universitaet Passau";
(*****************************************************************************)
(* EVORD and VALIS handling *)
(*****************************************************************************)
VAR EVORDSTACK: LIST; (* Stack for EVORD-values, see EvordSet. *)
VALISSTACK: LIST; (* Stack for VALIS-values, see ValisSet. *)
PROCEDURE EvordSet(T: LIST);
(* EVORD set.
T is a termorder.
The global variable EVORD is set to T.
The old value of EVORD is put on top of a stack and can be restored
using EvordReset(). *)
BEGIN
DEB_BEGIN(EvordSet);
EVORDSTACK:=COMP(EVORD,EVORDSTACK);
EVORD:=T;
END EvordSet;
PROCEDURE EvordReset();
(* Reset evord.
The global variable EVORD is set to the top element of EVORDSTACK.
(EVORDSTACK is set by EvordSet().) *)
BEGIN
DEB_BEGIN(EvordReset);
IF EVORDSTACK=SIL THEN ERROR(severe, "Error in EvordReset. Stack empty.");
ELSE ADV(EVORDSTACK, EVORD,EVORDSTACK); END;
END EvordReset;
PROCEDURE ValisSet(V: LIST);
(* Set valis.
V is a variables list. The global variable VALIS is set to T.
The old value of VALIS is put on top of a stack and can be restored
using ValisReset(). *)
BEGIN
DEB_BEGIN(ValisSet);
VALISSTACK:=COMP(VALIS,VALISSTACK);
VALIS:=V;
END ValisSet;
PROCEDURE ValisReset();
(* Reset valis.
The global variable VALIS is set to the top element of VALISSTACK.
(VALISSTACK is set by ValisSet().) *)
BEGIN
DEB_BEGIN(ValisReset);
IF VALISSTACK=SIL THEN ERROR(severe, "Error in ValisReset. Stack empty.");
ELSE ADV(VALISSTACK, VALIS,VALISSTACK); END;
END ValisReset;
(*****************************************************************************)
(* Sets *)
(*****************************************************************************)
PROCEDURE SetInsert(e, A: LIST): LIST;
(* Set insert.
A is a set.
e is an element.
Returns the set A U {e}.*)
BEGIN
DEB_BEGIN(SetInsert);
IF MEMBER(e,A)=1 THEN RETURN(A); END;
RETURN(COMP(e,A));
END SetInsert;
PROCEDURE SetUnion(A,B: LIST): LIST;
(* Set union.
A is a set.
B is a set.
Returns the set A U B. *)
VAR e: LIST;
BEGIN
DEB_BEGIN(SetInsert);
WHILE B<>SIL DO
ADV(B, e,B);
A:=SetInsert(e,A);
END;
RETURN(A);
END SetUnion;
(*****************************************************************************)
(* Miscellaneous CGB Functions *)
(*****************************************************************************)
PROCEDURE CGBOPT(O: LIST);
(*Comprehensive Groebner Basis Options.
O is a list with an arbitrary number of elements.
The global variable PAR is set according to O.
The elements of O (if existent) are interpreted as follows:
1st element: if =0 no output during computation, if >0 chatty.
2nd element: if =0 do not factorize coefficients, if =1 do factorize
coefficients, if =2 do factorize coefficients with variable order
optimization.
3rd element: if =0 use top reduction only, if =1 use "normal" reduction.
4th element: evaluate conditions using:
if =0: simple methode, if =1: reduced sets, if =2: Groebner bases.
5th element: if =0: characteristic 0, if <>0 arbritrary characteristic.
6th element: term order for polynomials.
7th element: term order for coefficients.
8th element: if =1: generic case only, if <>1 all cases.
*)
VAR dummy: LIST;
BEGIN
DEB_BEGIN(CGBOPT);
IF O<>SIL THEN ADV(O, PAR.outputlevel,O); END;
IF O<>SIL THEN ADV(O, PAR.factorize,O); END;
IF O<>SIL THEN ADV(O, PAR.normalform,O); END;
IF O<>SIL THEN ADV(O, PAR.compcond,O); END;
IF O<>SIL THEN ADV(O, PAR.char, O); END;
IF O<>SIL THEN ADV(O, PAR.TermOrderPol, O); END;
IF O<>SIL THEN ADV(O, PAR.TermOrderCoef, O); END;
IF O<>SIL THEN ADV(O, dummy,O); PAR.genericOnly:=(dummy=1); END;
CASE PAR.factorize OF
0: PAR.Factorize:=dummyfactorize|
1: PAR.Factorize:=ADFACT|
2: PAR.Factorize:=ADFACTO;
END;
IF PAR.normalform=0 THEN PAR.NormalForm:=NFTOP;
ELSE PAR.NormalForm:=NFORM; END;
IF PAR.genericOnly THEN
PAR.CondEval:=CondEvalGen;
PAR.CondRamif:=CondRamifGen;
ELSE
CASE PAR.compcond OF
0: PAR.CondEval:=CondEvalSim;
PAR.CondRamif:=CondRamifSim|
1: IF PAR.char=0 THEN
PAR.CondEval:=CondEvalRed;
PAR.CondRamif:=CondRamifRed;
ELSE
PAR.CondEval:=CondEvalDred;
PAR.CondRamif:=CondRamifDred;
END|
2: PAR.CondEval:=CondEvalGb;
PAR.CondRamif:=CondRamifGb;
END;
END;
IF PAR.char=0 THEN PAR.IsCnst:=ADCNST;
ELSE PAR.IsCnst:=dummycnst; END;
PAR.Factors:=DIPPFACTAV;
END CGBOPT;
PROCEDURE CGBOPTWRITE();
(*Comprehensive Groebner Basis Options Write
Writes the options from the global Variable PAR on the output stream*)
BEGIN
DEB_BEGIN(CGBOPTWRITE);
BLINES(1);
SWRITE("Options for computation of Groebner systems are: ");
SWRITE("(");
UWRIT1(PAR.outputlevel);SWRITE(",");
IF PAR.factorize THEN SWRITE("1,"); ELSE SWRITE("0,"); END;
UWRIT1(PAR.normalform);SWRITE(",");
UWRIT1(PAR.compcond);SWRITE(",");
UWRIT1(PAR.char);SWRITE(",");
UWRIT1(PAR.TermOrderPol);SWRITE(",");
UWRIT1(PAR.TermOrderCoef);SWRITE(",");
IF PAR.genericOnly THEN SWRITE("1"); ELSE SWRITE("0"); END;
SWRITE(")");
BLINES(0);
CASE PAR.outputlevel OF
0: SWRITE("No output.")|
1: SWRITE("Some output during computation.");
END;
BLINES(0);
CASE PAR.factorize OF
0: SWRITE ("Without factorization of coefficients.")|
1: SWRITE ("With factorization of coefficients.")|
2: SWRITE ("With factorization using variable order optimization of coefficients.");
END;
BLINES(0);
IF PAR.normalform=0 THEN SWRITE("Top-reduction only.");
ELSE SWRITE("Normal reduction."); END;
BLINES(0);
SWRITE("Conditions are evaluated ");
CASE PAR.compcond OF
0: SWRITE("by comparing.")|
1: SWRITE("using reduced sets. "); BLINES(0)|
2: SWRITE("using Groebner bases."); BLINES(0)|
END;
BLINES(0);
SWRITE("Characteristic is ");
IF PAR.char=0 THEN SWRITE("0."); ELSE SWRITE("arbitrary."); END;
BLINES(0);
SWRITE("Term order: "); EVOWRITE(PAR.TermOrderPol); BLINES(0);
SWRITE("Coefficient term order: "); EVOWRITE(PAR.TermOrderCoef);
BLINES(0);
IF PAR.genericOnly THEN SWRITE("Generic case only.");
ELSE SWRITE("All cases are considered."); END;
BLINES(0);
BLINES(1);
END CGBOPTWRITE;
PROCEDURE dummycnst(A: LIST): BOOLEAN;
(* Dummy constant.
Value for PAR.IsCnst. Returns false always (nothing is constant). *)
BEGIN
DEB_BEGIN(dummycnst);
RETURN(FALSE);
END dummycnst;
PROCEDURE dummyfactorize(A: LIST): LIST;
(* Dummy factorize.
Value for PAR.factorize. Does not factorize. Returns a list containing A.*)
BEGIN
DEB_BEGIN(dummyfactorize);
RETURN(LIST1(A));
END dummyfactorize;
PROCEDURE CondEvalSim(Cond, COEF: LIST): COLOUR;
(* Condition evaluate using simple method.
Cond is a Condition.
COEF is a (coefficient) polynomial.
Tests whether COEF =0, <>0 or unknown wrt. to Cond.
Returns zero iff COEF is an element of CondZero(Cond).
Returns nzero iff COEF is an element of CondNzero(Cond).
Otherwise returns unknown. *)
BEGIN
DEB_BEGIN(CondEvalSim);
IF MEMBER(COEF, CondZero(Cond))=1 THEN RETURN(zero); END;
IF MEMBER(COEF, CondNzero(Cond))=1 THEN RETURN(nzero); END;
RETURN(unknown);
END CondEvalSim;
PROCEDURE CondEvalRed(Cond, COEF: LIST): COLOUR;
(* Condition evaluate using reduced set method.
Cond is a Condition where CondZero(Cond) is a reduced set and
CondNzero(Cond) is reduced wrt CondZero(Cond).
COEF is a (coefficient) polynomial.
Tests whether COEF =0, <>0 or unknown wrt. to Cond.
Returns zero iff a reduction of COEF to zero wrt. CondZero(Cond) is found.
Returns nzero iff a normal form of COEF wrt. CondZero(Cond) is an
element of CondNzero(Cond). (Note: only one of the possible normal
forms is checked.)
Otherwise returns unknown. *)
BEGIN
DEB_BEGIN(CondEvalRed);
IF MEMBER(COEF, CondZero(Cond))=1 THEN RETURN(zero); END;
IF MEMBER(COEF, CondNzero(Cond))=1 THEN RETURN(nzero); END;
EvordSet(PAR.TermOrderCoef);
COEF:=PFINOR(CondZero(Cond),COEF);
EvordReset();
IF COEF=SIL THEN RETURN(zero); END;
IF (MEMBER(COEF, CondNzero(Cond))=1) OR (PAR.IsCnst(COEF))
THEN RETURN(nzero); END;
RETURN(unknown);
END CondEvalRed;
PROCEDURE CondEvalDred(Cond, COEF: LIST): COLOUR;
(* Condition evaluate using d-reduced set method.
Cond is a Condition where CondZero(Cond) is a d-reduced set and
CondNzero(Cond) is d-reduced wrt CondZero(Cond).
COEF is a (coefficient) polynomial.
Tests whether COEF =0, <>0 or unknown wrt. to Cond.
Returns zero iff a d-reduction of COEF to zero wrt. CondZero(Cond) is found.
Returns nzero iff a d-normal form of COEF wrt. CondZero(Cond) is an
element of CondNzero(Cond). (Note: only one of the possible normal
forms is checked.)
Otherwise returns unknown. *)
BEGIN
DEB_BEGIN(CondEvalDred);
IF MEMBER(COEF, CondZero(Cond))=1 THEN RETURN(zero); END;
IF MEMBER(COEF, CondNzero(Cond))=1 THEN RETURN(nzero); END;
EvordSet(PAR.TermOrderCoef);
COEF:=PFIDNOR(CondZero(Cond),COEF);
EvordReset();
IF COEF=SIL THEN RETURN(zero); END;
IF MEMBER(COEF, CondNzero(Cond))=1 THEN RETURN(nzero); END;
RETURN(unknown);
END CondEvalDred;
PROCEDURE CondEvalGb(Cond, COEF: LIST): COLOUR;
(* Evaluate Condition using GB method.
Cond is a Condition, where CondZero(Cond) is a Groebner basis and
CondNzero(Cond) is reduced wrt. CondZero(Cond).
COEF is a (coefficient) polynomial.
Tests whether COEF =0, <>0 or unknown wrt. to Cond.
Returns zero iff COEF reduces to zero wrt. CondZero(Cond).
Returns nzero iff the normal form of COEF wrt. CondZero(Cond) is an
element of CondNzero(Cond). (Note: only one of the possible normal
forms is checked.)
Otherwise returns unknown. *)
BEGIN
DEB_BEGIN(CondEvalGb);
EvordSet(PAR.TermOrderCoef);
COEF:=PFINOR(CondZero(Cond),COEF);
EvordReset();
IF COEF=SIL THEN RETURN(zero); END;
IF (MEMBER(COEF, CondNzero(Cond))=1) OR (PAR.IsCnst(COEF))
THEN RETURN(nzero); END;
RETURN(unknown);
END CondEvalGb;
PROCEDURE CondRamifSim(COEF, Cond: LIST; VAR CD0, CD1: LIST);
(* Condition ramificate.
COEF is a (coefficient) polynomial.
Cond is a Condition.
Returns Conditions CD0 and CD1 such that CondEvalsim(COEF,CD0)=zero,
CondEvalsim(COEF,CD1)=nzero and for all coefficients c:
CondEvalsim(C,Cond)=zero/nzero ==> CondEvalsim(C,CDi)=zero/nzero
*)
BEGIN
DEB_BEGIN(CondRamifSim);
CD0:=CondCons(COMP(COEF,CondZero(Cond)), CondNzero(Cond));
CD1:=CondCons(CondZero(Cond), COMP(COEF,CondNzero(Cond)));
END CondRamifSim;
PROCEDURE CondRamifRed(COEF, Cond: LIST; VAR CD0, CD1: LIST);
(* Condition ramificate using reduced sets.
COEF is a (coefficient) polynomial.
Cond is a Condition such that CondZero(Cond) contains a reduced set.
Returns Conditions CD0 and CD1 such that CondEvalred(COEF,CD0)=zero,
CondEvalred(COEF,CD1)=nzero and for all coefficients c:
CondEvalred(C,Cond)=zero/nzero ==> CondEvalred(C,CDi)=zero/nzero.
If CD0 or CD1 would be a contradiction (1=0 or 0<>0) CondEmpty is
returned.
*)
VAR RED, RS: LIST;
ONE, ZERO: BOOLEAN;
BEGIN
DEB_BEGIN(CondRamifRed);
CD0:=CondEmpty();
CD1:=CondEmpty();
EvordSet(PAR.TermOrderCoef);
(* Condition COEF=0 *)
RED:=PFILS(COMP(COEF,CondZero(Cond)),ONE);
RS:=PFILNOR(RED,CondNzero(Cond),ZERO);
IF NOT (ONE OR ZERO) THEN
CD0:=CondCons(SetInsert(COEF,SetUnion(RED,CondZero(Cond))),
SetUnion(RS,CondNzero(Cond))); END;
(* Condition COEF<>0 *)
RS:=PFILNOR(CondZero(Cond),COMP(COEF,CondNzero(Cond)),ZERO);
IF NOT ZERO THEN
CD1:=CondCons(CondZero(Cond),SetUnion(RS,CondNzero(Cond))); END;
EvordReset();
END CondRamifRed;
PROCEDURE CondRamifDred(COEF, Cond: LIST; VAR CD0, CD1: LIST);
(* Condition ramificate using d-reduced sets
COEF is a (coefficient) polynomial.
Cond is a Condition such that CondZero(Cond) is a d-reduced set.
Returns Conditions CD0 and CD1 such that CondEvaldred(COEF,CD0)=zero,
CondEvaldred(COEF,CD1)=nzero and for all coefficients c:
CondEvaldred(C,Cond)=zero/nzero ==> CondEvaldred(C,CDi)=zero/nzero.
If CD0 or CD1 would be a contradiction (0<>0) CondEmpty is
returned.
*)
VAR RED, RS: LIST;
ONE, ZERO: BOOLEAN;
BEGIN
DEB_BEGIN(CondRamifDred);
CD0:=CondEmpty();
CD1:=CondEmpty();
EvordSet(PAR.TermOrderCoef);
(* Condition COEF=0 *)
RED:=PFILDS(COMP(COEF,CondZero(Cond)),ONE);
RS:=PFILDNOR(RED,CondNzero(Cond),ZERO);
IF NOT (ONE OR ZERO) THEN
CD0:=CondCons(SetInsert(COEF,SetUnion(RED,CondZero(Cond))),
SetUnion(RS,CondNzero(Cond))); END;
(* Condition COEF<>0 *)
RS:=PFILDNOR(CondZero(Cond),COMP(COEF,CondNzero(Cond)),ZERO);
IF NOT ZERO THEN
CD1:=CondCons(CondZero(Cond),SetUnion(RS,CondNzero(Cond))); END;
EvordReset();
END CondRamifDred;
PROCEDURE CondRamifGb(COEF, Cond: LIST; VAR CD0, CD1: LIST);
(* Condition ramificate using Groebner bases.
COEF is a (coefficient) polynomial.
Cond is a Condition such that CondZero(Cond) is a Groebner basis.
Returns Conditions CD0 and CD1 such that CondEvalgb(COEF,CD0)=zero,
CondEvalgb(COEF,CD1)=nzero and for all coefficients c:
CondEvalgb(C,Cond)=zero/nzero ==> CondEvalgb(C,CDi)=zero/nzero.
If CD0 or CD1 would be a contradiction (1=0 or 0<>0) CondEmpty is
returned.
*)
VAR GB, RS: LIST;
ONE, ZERO: BOOLEAN;
BEGIN
DEB_BEGIN(CondRamifGb);
CD0:=CondEmpty();
CD1:=CondEmpty();
EvordSet(PAR.TermOrderCoef);
GB:=PFIGBA(CondZero(Cond),COEF,PAR.outputlevel,ONE);
RS:=PFILNOR(GB,CondNzero(Cond),ZERO);
IF NOT (ONE OR ZERO) THEN CD0:=CondCons(GB,RS); END;
RS:=PFILNOR(CondZero(Cond),COMP(COEF,CondNzero(Cond)),ZERO);
IF NOT ZERO THEN CD1:=CondCons(CondZero(Cond),RS); END;
EvordReset();
END CondRamifGb;
PROCEDURE CondEvalGen(Cond, COEF: LIST): COLOUR;
(* Condition evaluate in generic case.
Cond is a Condition.
COEF is a (coefficient) polynomial.
Tests whether COEF =0, <>0 or unknown wrt. to Cond.
Returns nzero iff COEF is an element of CondNzero(Cond).
Otherwise returns unknown. *)
BEGIN
DEB_BEGIN(CondEvalGen);
IF MEMBER(COEF, CondNzero(Cond))=1 THEN RETURN(nzero); END;
RETURN(unknown);
END CondEvalGen;
PROCEDURE CondRamifGen(COEF, Cond: LIST; VAR CD0, CD1: LIST);
(* Condition ramificate in generic case.
COEF is a (coefficient) polynomial.
Cond is a Condition.
Returns empty condition in CD0.
Returns Condition CD1 such that CondEvalGen(COEF,CD1)=nzero
and for all coefficients c:
CondEvalGen(C,Cond)=nzero ==> CondEvalGen(C,CD1)=nzero
*)
BEGIN
DEB_BEGIN(CondRamifGen);
CD0:=CondEmpty();
CD1:=CondCons(SIL, COMP(COEF,CondNzero(Cond)));
END CondRamifGen;
(* Do not use any of the following outside from CGB! -- mp*)
(*****************************************************************************)
(* LIST output *)
(*****************************************************************************)
PROCEDURE FLWRITE(L: LIST);
(* Formatted list write.
The input list L is written to the output stream.*)
VAR E: LIST;
I: INTEGER;
BEGIN
IF L < BETA THEN AWRITE(L); RETURN END;
SWRITE("(");
WHILE L <> SIL DO
ADV(L, E,L);
IF E < BETA THEN AWRITE(E); ELSE FILWRITE(E,1); END;
IF L <> SIL THEN SWRITE(","); END;
END;
SWRITE(")");
RETURN;
END FLWRITE;
PROCEDURE FILWRITE(L: LIST; N:INTEGER);
(* Formatted indented list write.
The input list L is written to the output stream.*)
VAR E: LIST;
I: INTEGER;
R: BOOLEAN;
BEGIN
BLINES(0);
FOR I:=1 TO N DO SWRITE(" "); END;
SWRITE("(");
R:=FALSE;
WHILE L <> SIL DO
ADV(L, E,L);
IF E < BETA THEN AWRITE(E); ELSE FILWRITE(E,N+1); R:=TRUE; END;
IF L <> SIL THEN SWRITE(","); END;
END;
IF R THEN
BLINES(0);
FOR I:=1 TO N DO SWRITE(" "); END;
END;
SWRITE(")");
END FILWRITE;
(*****************************************************************************)
(* Polynomial conversion *)
(*****************************************************************************)
PROCEDURE XPFDIP (DP, DOM, VARL: LIST): LIST;
(* Recursive polynomial (with domain-descriptor) from distributive polynomial.
DP is a polynomial in distributive representation.
DOM is a domain descriptor.
VARL is a list of variables.
Returns a Polynomial (DOM, P, R, VARL) where
P is the recursive representation of DP and R is the number of variables of DP.
*)
VAR R, B, TEVORD: LIST;
BEGIN
EvordSet(INVLEX);
DIPBSO(DP); (* PFDIP needs INVLEX sorted polynomial! *)
PFDIP(DP, R,B); (* R: #variables; B: rec.-pol.*)
EvordReset();
RETURN(LIST4(DOM, B, R, VARL));
END XPFDIP;
PROCEDURE PFLDIPL (DIPL, DOM, VARL: LIST): LIST;
(* Recursive polynomial list (with domain-descriptor) from distributive
polynomial list.
DIPL is a list of polynomials in distributive representation.
DOM is a domain descriptor.
VARL is a list of variables.
Returns a list containing an element
(DOM, P, R, VARL) for each distributive polynomial dp in DIPL where
P is the recursive representation of dp and R is the number of variables of dp
(all polynomials in DIPL are assumed to have the same number of variables).
*)
VAR RET, P, B: LIST;
BEGIN
DEB_BEGIN(PFLDIPL);
RET:=SIL;
WHILE DIPL <> SIL DO
ADV(DIPL, P,DIPL);
RET:=COMP(XPFDIP(P, DOM, VARL), RET);
END;
RETURN (INV(RET));
END PFLDIPL;
PROCEDURE XDIPFPF (P: LIST; VAR DOM, VARL: LIST): LIST;
(* Distributive polynomial from recursive polynomial (with domain-descriptor).
P is a polynomial in recursive representation.
Returns this polynomial in distributive representation, sorted according
to the value of EVORD, the domain-descriptor in DOM and the list of
variables in VARL.
*)
VAR B, R, DI: LIST;
BEGIN
DEB_BEGIN(XDIPFPF);
FIRST4(P, DOM, B, R, VARL);
DI:=DIPFP(R, B);
DIPBSO(DI); (* DIPFP returns INVLEX sorted polynomial! *)
RETURN(DI);
END XDIPFPF;
PROCEDURE DIPLFPFL (PFL: LIST; VAR DOM, VARL: LIST): LIST;
(* Distributive polynomial list from recursive polynomial
(with domain-descriptor) list.
PFL is a list of polynomials in recursive representation.
Returns a list of this polynomials in distributive representation
the domain-descriptor in DOM and the list of variables in VARL.
*)
VAR RET, P: LIST;
BEGIN
DEB_BEGIN(DIPLFPFL);
RET:=SIL;
WHILE PFL <> SIL DO
ADV(PFL, P, PFL);
RET:=COMP(XDIPFPF(P, DOM, VARL), RET);
END;
RETURN(INV(RET));
END DIPLFPFL;
PROCEDURE DIFPF(P, D: LIST; VAR DOM, VARL: LIST): LIST;
(* Distributive polynomial with arbitrary domain coefficients from
recursive polynomial (with domain-descriptor).
P is a polynomial with domain descriptor.
D is a domain descriptor.
Returns P in distributive representation over domain D,
sorted according to the value of EVORD, the domain-descriptor of P in DOM, and
the list of variables in VARL.
*)
VAR AL, EL, B, BL: LIST;
BEGIN
DEB_BEGIN(DIFPF);
P:=XDIPFPF(P,DOM,VARL);
IF P=0 THEN RETURN(0); END;
ValisSet(VARL);
B:=SIL;
WHILE P<>SIL DO
DIPMAD(P, AL,EL,P);
BL:=ADFI(D,AL);
IF ADSIGN(BL) <> 0 THEN B:=DIPMCP(EL,BL,B) END;
END;
IF B = SIL THEN B:=0; ELSE B:=INV(B); DIPBSO(B); END;
ValisReset();
RETURN(B);
END DIFPF;
PROCEDURE DILFPFL(PFL, D: LIST; VAR DOM, VARL: LIST): LIST;
(* Distributive polynomial list with arbitrary domain coefficients from
recursive polynomial list (with domain-descriptor).
P is a polynomial list with domain descriptor.
D is a domain descriptor.
Returns a list containing the polynomials from PFL
in distributive representation over domain D,
sorted according to the value of EVORD, the domain-descriptor of PFL
in DOM, and the list of variables in VARL.
*)
VAR RET, P: LIST;
BEGIN
DEB_BEGIN(DILFPFL);
RET:=SIL;
WHILE PFL <> SIL DO
ADV(PFL, P, PFL);
RET:=COMP(DIFPF(P,D, DOM, VARL), RET);
END;
RETURN(INV(RET));
END DILFPFL;
(*****************************************************************************)
(* Groebner bases and related procedures for recursive integral polynomials *)
(*****************************************************************************)
PROCEDURE PFIGB(PFL, TF: LIST; VAR ONE: BOOLEAN): LIST;
(* Integral Polynomial Groebner Basis.
PFL is a list of polynomials in recursive representation.
TF is the trace flag.
Returns the Groebner Basis of PFL wrt. to the total degree inverse
lexicographical term order.
ONE=TRUE iff 1 is an element of the Groebner Basis.*)
VAR GB, DOM, VARL: LIST;
BEGIN
DEB_BEGIN(PFIGB);
ONE:=FALSE;
PFL:=DIPLFPFL(PFL, DOM, VARL); DILBSO(PFL);
ValisSet(VARL);
GB:=DIIPGB(PFL, TF);
IF GB<>SIL THEN IF DIIPON(FIRST(GB))=1 THEN ONE:=TRUE; END; END;
ValisReset();
RETURN (PFLDIPL(GB, DOM, VARL));
END PFIGB;
PROCEDURE PFIGBA(PFL, P, TF: LIST; VAR ONE: BOOLEAN): LIST;
(* Integral Polynomial Groebner Basis augmentation.
PFL is a list of polynomials in recursive representation.
P is a polynomial.
TF is the trace flag.
Returns the Groebner Basis of PFL and P wrt. to the total degree inverse
lexicographical term order.
ONE=TRUE iff 1 is an element of the Groebner Basis.*)
VAR GB, DOM, VARL: LIST;
BEGIN
DEB_BEGIN(PFIGBA);
ONE := FALSE;
P:=XDIPFPF(P, DOM,VARL);
PFL:=DIPLFPFL(PFL, DOM,VARL);
ValisSet(VARL);
GB:=DIIGBA(P,PFL,TF);
ValisReset();
IF GB<>SIL THEN IF DIIPON(FIRST(GB))=1 THEN ONE:=TRUE; END; END;
RETURN (PFLDIPL(GB, DOM, VARL));
END PFIGBA;
PROCEDURE PFILS(B: LIST; VAR ONE: BOOLEAN): LIST;
(* Integral polynomial list irreducible set.
B is a list of polynomials in recursive representation.
Returns the result of reducing B.
ONE=TRUE iff 1 is an element of the result. *)
VAR DOM, VARL: LIST;
BEGIN
DEB_BEGIN(PFILS);
ONE:=FALSE;
B:=DIPLFPFL(B, DOM, VARL);
ValisSet(VARL);
B:=DIILIS(B);
IF B<>SIL THEN IF DIIPON(FIRST(B))=1 THEN ONE:=TRUE; END; END;
ValisReset();
RETURN (PFLDIPL(B, DOM, VARL));
END PFILS;
PROCEDURE DIILIS(P: LIST): LIST;
(*Distributive integral polynomial list irreducible set.
P is a list of distributive integral polynomials,
PP is the result of reducing each p element of P modulo P-(p)
until no further reductions are possible. *)
VAR CL, EL, FL, IRR, LL, PL, PP, PS, RP, SL: LIST;
BEGIN
(*initialise. *) PP:=P; PS:=BETA;
WHILE PP <> SIL DO ADV(PP, PL,PP); DIIPCP(PL, CL,PL);
IF PL <> 0 THEN PS:=COMP(PL,PS); END;
END;
RP:=PS; PP:=INV(PS); LL:=LENGTH(PP); IRR:=0;
IF LL <= 1 THEN RETURN(PP); END;
(*reduce until all polynomials are irreducible. *)
LOOP ADV(PP, PL,PP); EL:=DIPEVL(PL); PL:=DIIPNF(PP,0,PL);
IF PL = 0 THEN LL:=LL-1;
IF LL <= 1 THEN EXIT END;
ELSE PL:=DIIPNORM(PL); FL:=DIPEVL(PL); SL:=EVSIGN(FL);
IF SL = 0 THEN PP:=LIST1(PL); EXIT; END;
SL:=EQUAL(EL,FL);
IF SL = 1 THEN IRR:=IRR+1; ELSE IRR:=0; DIIPCP(PL,
CL,PL); END;
PS:=LIST1(PL); SRED(RP,PS); RP:=PS; END;
IF IRR = LL THEN EXIT END;
END; (*loop*)
RETURN(PP);
END DIILIS;
PROCEDURE PFINOR(B, P: LIST): LIST;
(* Integral Polynomial Normal Form.
B is a list of polynomials in recursive representation.
P is a polynomial in recursive representation.
Returns the normal form of P wrt. B, or SIL if this normal form is 0. *)
VAR NF, DOM, VARL: LIST;
BEGIN
DEB_BEGIN(PFINOR);
B:=DIPLFPFL(B, DOM,VARL);
ValisSet(VARL);
NF:=DIIPNF(B, 0, XDIPFPF(P, DOM,VARL));
IF NF=0 THEN ValisReset(); RETURN SIL; END;
NF:=DIIPNORM(NF);
ValisReset();
RETURN (XPFDIP(NF, DOM, VARL));
END PFINOR;
PROCEDURE PFILNOR(B, P: LIST; VAR ZERO: BOOLEAN): LIST;
(* Integral Polynomial List Normal Form.
B is a list of polynomials in recursive representation.
P is a list of polynomials in recursive representation.
Returns a list of (non-zero, not constant) normal forms of each p in P wrt. B.
ZERO=TRUE iff one of the normal forms is zero. *)
VAR RET, NF, p: LIST;
BEGIN
DEB_BEGIN(PFILNOR);
RET:=SIL;
ZERO:=FALSE;
WHILE P<>SIL DO
ADV(P, p, P);
NF:=PFINOR(B, p);
IF NF<>SIL THEN IF (MEMBER(NF,RET)=0) AND (NOT PAR.IsCnst(NF))
THEN RET:=COMP(NF,RET); END;
ELSE ZERO:=TRUE; END;
END;
RETURN (INV(RET));
END PFILNOR;
PROCEDURE PFILDS(B: LIST; VAR ONE: BOOLEAN): LIST;
(* Integral polynomial list d-irreducible set.
B is a list of polynomials in recursive representation.
Returns the result of d-reducing B.
ONE=FALSE.*)
VAR DOM, VARL, L, P, NP, HC, HT, NHC, NHT, dummy: LIST;
I: INTEGER;
BEGIN
DEB_BEGIN(PFILDS);
ONE:=FALSE;
IF B=SIL THEN RETURN(SIL); END;
B:=DIPLFPFL(B, DOM, VARL);
L:=LENGTH(B);
I:=0;
LOOP
ADV(B, P,B);
NP:=DIIPDNF(B,0,P);
IF NP=0 THEN L:=L-1;
ELSE
NP:=DIIPAB(NP);
DIPMAD(P, HC,HT,dummy);
DIPMAD(NP, NHC,NHT,dummy);
IF (EQUAL(HC,NHC)=1) AND (EQUAL(HT,NHT)=1)
THEN IF I>0 THEN I:=I+1; ELSE I:=1; END;
ELSE I:=0; END;
B:=CONC(B,LIST1(NP));
END;
IF I>=L THEN EXIT; END;
END;
RETURN (PFLDIPL(B, DOM, VARL));
END PFILDS;
PROCEDURE PFIDNOR(B, P: LIST): LIST;
(* Integral Polynomial D Normal Form.
B is a list of polynomials in recursive representation.
P is a polynomial in recursive representation.
Returns the d-normal form of P wrt. B, or SIL if this normal form is 0. *)
VAR NF, DOM, VARL: LIST;
BEGIN
DEB_BEGIN(PFIDNOR);
B:=DIPLFPFL(B, DOM,VARL);
ValisSet(VARL);
NF:=DIIPDNF(B, 0, XDIPFPF(P, DOM,VARL));
IF NF=0 THEN ValisReset(); RETURN SIL; END;
NF:=DIIPAB(NF);
ValisReset();
RETURN (XPFDIP(NF, DOM,VARL));
END PFIDNOR;
PROCEDURE PFILDNOR(B, P: LIST; VAR ZERO: BOOLEAN): LIST;
(* Integral Polynomial List D-Normal Form.
B is a list of polynomials in recursive representation.
P is a list of polynomials in recursive representation.
Returns a list of (non-zero) d-normal forms of each p in P wrt. B.
ZERO=TRUE iff one of the d-normal forms is zero. *)
VAR RET, NF, p: LIST;
BEGIN
DEB_BEGIN(PFILDNOR);
RET:=SIL;
ZERO:=FALSE;
WHILE P<>SIL DO
ADV(P, p, P);
NF:=PFIDNOR(B, p);
IF NF<>SIL THEN IF MEMBER(NF,RET)=0 THEN RET:=COMP(NF,RET); END;
ELSE ZERO:=TRUE; END;
END;
RETURN (INV(RET));
END PFILDNOR;
PROCEDURE PFWRITE(P: LIST);
(* Integral polynomial write.
P is a polynomial in recursive representation with domain-descriptor.
P is written to the outputstream (wrt. the term order in EVORD).
*)
VAR DOM, VARL: LIST;
BEGIN
DEB_BEGIN(PFWRITE);
P:=XDIPFPF(P, DOM,VARL);
ValisSet(VARL);
DIIPWR(P,VARL);
ValisReset();
END PFWRITE;
PROCEDURE DIIPNORM(P: LIST): LIST;
(* Distributive integral polynomial norm.
Returns a polynomial r, were n*r=p for an Integer n, the content of r is 1
and the highest coefficient of r is not negative.*)
VAR C, DUMMY: LIST;
BEGIN
DEB_BEGIN(DIIPNORM);
DIIPCP(P, C,DUMMY);
P:=DIIPIQ(P,C);
IF DIIPSG(P)=-1 THEN RETURN (DIIPNG(P));
ELSE RETURN (P); END;
END DIIPNORM;
(*****************************************************************************)
(* Routines for distributive polynomials over polynomial rings *)
(*****************************************************************************)
PROCEDURE DIP2AD(P,d,rest: LIST): LIST;
(* distributive polynomial to arbitrary domain.
P is a polynomial in distributive representation,
d is a domain number, rest is a domain descriptor,
P1 is P with added domain numbers and descriptors *)
VAR P1,exp,coe: LIST;
BEGIN
P1:=BETA;
WHILE P<>SIL DO
ADV(P,exp,P);
P1:=COMP(exp,P1);
ADV(P,coe,P);
coe:=COMP(d,COMP(coe,rest));
P1:=COMP(coe,P1);
END; (* while... *)
P1:=INV(P1);
RETURN P1;
END DIP2AD;
PROCEDURE AD2DIP(P: LIST; VAR d, rest: LIST): LIST;
(* arbitrary domain to distributive polynomial.
P is a polynomial in distributive representation
with domain numbers and descriptors,
P1 is P without domain numbers and descriptors *)
VAR P1,exp,coe,val: LIST;
BEGIN
P1:=BETA;
WHILE P<>SIL DO
ADV(P,exp,P);
P1:=COMP(exp,P1);
ADV(P,coe,P);
ADV2(coe, d,val,rest);
P1:=COMP(val,P1);
END; (* while... *)
P1:=INV(P1);
RETURN(P1);
END AD2DIP;
PROCEDURE DIPPFACTAV (P: LIST) :LIST;
(* Distributive polynomial over polynomial ring factorize in all variables.
P is a distributive polynomial over a polynomial ring.
Returns a list of all irreducible factors of P seen as a polynomial
in all variables (including the variables in the coefficients). *)
VAR c, d, dd, ExpPol, f, pol, PP, PV, q, r, VP, rest, RET, s, vlist: LIST;
BEGIN
DEB_BEGIN(DIPPFACTAV);
IF P=SIL THEN RETURN(SIL); END;
dd := ADDDFDIP(P);
IF dd=0 THEN RETURN(SIL); END;
DIPFDIPP(P,ADDDFSTR("INT "), q, vlist);
ValisSet(vlist);
q:=AD2DIP(q, d,rest);
DIPVOPP(LIST1(q),VALIS, PP,VP,PV);
ValisSet(VP);
q:=FIRST(PP);
EvordSet(INVLEX);
DIPBSO(q);
PFDIP(q, r,q);
EvordReset();
IPFAC(r,q, s,c,f);
RET:=SIL;
PV:=INVPERM(PV);
WHILE f<>SIL DO
ADV(f, ExpPol,f);
pol:=DIPFP(r,SECOND(ExpPol));
(* DIPBSO(pol);*)
pol:=DIPERM(pol,PV);
pol:=DIP2AD(pol,d,rest);
DIPPFDIP(pol,THIRD(dd),dd, pol,vlist);
RET:=COMP(pol, RET);
END;
ValisReset();
ValisReset();
RETURN(RET);
END DIPPFACTAV;
BEGIN
(* LISTVAR makes global variables known to the garbage collector. *)
EVORDSTACK:=SIL; LISTVAR(EVORDSTACK);
VALISSTACK:=SIL; LISTVAR(VALISSTACK);
LISTVAR(PAR.TermOrderPol);
LISTVAR(PAR.TermOrderCoef);
CGBOPT(CONC(LIST5(1,1,0,0,0),LIST3(IGRLEX,IGRLEX,0)));
END CGBMISC.
(* -EOF- *)