Artifact 930fac021bab4511957267324b03ab17d2e5efdf2732fe26765639fe2efa38ee:
- Executable file
r37/packages/groebner/groebmes.red
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 12437) [annotate] [blame] [check-ins using] [more...]
module groebmes; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % trace messages for the algorithms % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% fluid '(vdpvars!* !*trgroeb !*trgroebs !*trgroeb1 !*trgroebr hcount!* hzerocount!* factorlevel!* basecount!* groetime!* pcount!*); symbolic procedure groebpairprint (p); <<groebmessff(" pair(",cadr p,nil); groebmessff(",",caddr p,nil); prin2 "), "; prin2 " lcm = ";print car p>>; symbolic procedure groetimeprint; << prin2 ">> accum. cpu time:"; prin2 (time() - groetime!*); prin2t " ms">>; symbolic procedure groebmessff (m1,f,m2); << prin2 m1; prin2 vdpnumber f; if !*gsugar then <<prin2 "/";prin2 gsugar f>>; if m2 then prin2t m2 >>; symbolic procedure groebmess0 (p); if !*trgroeb then vdpprint p; symbolic procedure groebmess1 (g,d); if !*trgroeb then << g := g; d := d; prin2 " variables: "; print vdpvars!*; printbl(); prin2t " Start of ITERATION "; terpri (); >>; symbolic procedure groebmess2 f; if !*trgroeb then << terpri(); groebmessff ("polynomial ",f," eliminated"); groetimeprint()>>; symbolic procedure groebmess2a(f,cf,fn); if !*trgroeb then << terpri(); groebmessff ("polynomial ",f,nil); groebmessff (" elim. with cofactor ",cf," to"); vdpprint fn; terpri(); groetimeprint()>>; symbolic procedure groebmess3(p,s); if !*trgroebs then << prin2 "S-polynomial from "; groebpairprint p; vdpprint s; terpri(); groetimeprint(); terprit 3 >>; symbolic procedure groebmess4 (p,d); << hcount!* := hcount!*+1; hzerocount!* := hzerocount!*+1; if !*trgroeb then << terpri(); printbl(); groebmessff(" reduction (",cadr p,nil); groebmessff(",", caddr p,nil); prin2 ") leads to 0; "; << prin2 n; prin2 if n=1 then " pair" else " pairs">> where n=length d; prin2t " left"; printbl(); groetimeprint()>>; >>; symbolic procedure groebmess41 (p); << hcount!* := hcount!*+1; hzerocount!* := hzerocount!*+1; if !*trgroeb then << terpri(); printbl(); groebmessff(" polynomial(", p,nil); prin2 ") reduced to 0;"; terpri(); printbl(); groetimeprint()>> >>; symbolic procedure groebmess5(p,h); if car p then << hcount!* := hcount!* + 1; if !*trgroeb then << terpri(); prin2 "H-polynomial "; prin2 pcount!*; prin2 " ev:"; prin2 vdpevlmon h; groebmessff(" from pair (",cadr p,nil); groebmessff(",", caddr p,")"); vdpprint h; terpri(); groetimeprint() >> >> else if !*trgroeb then << prin2t "from actual problem input:"; vdpprint h; groetimeprint() >>; symbolic procedure groebmess50(g); if !*trgroeb1 then << prin2 "list of active polynomials:"; for each d1 in g do <<prin2 vdpgetprop(d1,'number); prin2 " ">>; terprit 2 >>; symbolic procedure groebmess51(d); if !*trgroeb1 then << prin2t "Candidates for pairs in this step:"; for each d1 in d do groebpairprint (d1); terprit 2 >>; symbolic procedure groebmess52(d); if !*trgroeb1 then << prin2t "Actual new pairs from this step:"; for each d1 in d do groebpairprint (d1); terprit 2 >>; symbolic procedure groebmess7 h; if !*trgroebs then <<prin2t "Testing factorization for "; vdpprint h>>; symbolic procedure groebmess8 (g,d); if !*trgroeb1 then << g := g; prin2t " actual pairs: "; if null d then prin2t "null" else for each d1 in d do groebpairprint d1; groetimeprint() >> else if !*trgroeb then << prin2 n; prin2t if n=1 then " pair" else " pairs" >> where n=length d; symbolic procedure groebmess13(g,problems); if !*trgroeb or !*trgroebr then << if g then << basecount!* := basecount!* +1; printbl(); printbl(); prin2 "end of iteration "; for each f in reverse factorlevel!* do <<prin2 f; prin2 ".">>; prin2 "; basis "; prin2 basecount!*; prin2t ":"; prin2 "{"; for each g1 in g do vdpprin3t g1; prin2t "}"; printbl(); printbl(); groetimeprint() >> else << printbl(); prin2 "end of iteration branch "; for each f in reverse factorlevel!* do <<prin2 f; prin2 ".">>; prin2t " "; printbl(); groetimeprint()>>; if problems and !*trgroeb then << groetimeprint(); terpri(); printbl(); prin2 " number of partial problems still to be solved:"; prin2t length problems; terpri(); prin2 " preparing next problem "; if car car problems = 'file then prin2 cdr car problems else if cadddr car problems then vdpprint car cadddr car problems; terpri(); >> >>; symbolic procedure groebmess14 (h,hf); if !*trgroeb then << prin2 "******************* factorization of polynomial "; (if x then prin2t x else terpri() ) where x = vdpnumber(h); prin2t " factors:"; for each g in hf do vdpprint car g; groetimeprint()>>; symbolic procedure groebmess15 f; if !*trgroeb then <<prin2t "***** monomial factor reduced:"; vdpprint vdpfmon(a2vbc 1,f)>>; symbolic procedure groebmess19(p,restr,u); if !*trgroeb then << u := u; restr := restr; printbl(); prin2 "calculation branch "; for each f in reverse factorlevel!* do <<prin2 f; prin2 ".">>; prin2t " cancelled because"; vdpprint p; prin2t "is member of an actual abort condition"; printbl(); printbl()>>; symbolic procedure groebmess19a(p,u); if !*trgroeb then << u := u; printbl(); prin2 "during branch preparation "; for each f in reverse u do <<prin2 f; prin2 ".">>; prin2t " cancelled because"; vdpprint p; prin2t "was found in the ideal branch"; printbl()>>; symbolic procedure groebmess20 (p); if !*trgroeb then << terpri(); prin2 "secondary reduction starting with"; vdpprint p>>; symbolic procedure groebmess21(p1,p2); if !*trgroeb then << prin2 "polynomial "; prin2 vdpnumber p1; prin2 " replaced during secondary reduction by "; vdpprint p2>>; symbolic procedure groebmess22(factl,abort1,abort2); if null factl then nil else if !*trgroeb then begin integer n; prin2t "BRANCHING after factorization point"; n := 0; for each x in reverse factl do << n := n+1; prin2 "branch "; for each f in reverse factorlevel!* do <<prin2 f;prin2 ".">>; prin2t n; for each y in car x do vdpprint y; prin2t "simple IGNORE restrictions for this branch:"; for each y in abort1 do vdpprint y; for each y in cadr x do vdpprint y; if abort2 or caddr x then <<prin2t "set type IGNORE restrictions for this branch:"; for each y in abort2 do vdpprintset y; for each y in caddr x do vdpprintset y >>; printbl()>>; end; symbolic procedure groebmess23 (g0,rest1,rest2); if !*trgroeb then if null factorlevel!* then prin2t "** starting calculation ******************************" else << prin2 "** resuming calculation for branch "; for each f in reverse factorlevel!* do <<prin2 f; prin2 ".">>; terpri(); if rest1 or rest2 then << prin2t "-------IGNORE restrictions for this branch:"; g0 := g0; for each x in rest1 do vdpprint x; for each x in rest2 do vdpprintset x>> >>; symbolic procedure groebmess24(h,problems1,restr); % if !*trgroeb then <<prin2t "**********polynomial affected by branch restriction:"; vdpprint h; if restr then prin2t "under current restrictions"; for each x in restr do vdpprint x; if null problems1 then prin2t " CANCELLED" else <<prin2t "partitioned into"; vdpprintset car problems1>> >>; symbolic procedure groebmess25 (h,abort2); <<prin2t "reduction of set type cancel conditions by"; vdpprint h; prin2t "remaining:"; for each x in abort2 do vdpprintset x>>; symbolic procedure groebmess26 (f1,f2); if !*trgroebs and not vdpequal(f1,f2) then <<terpri(); prin2t "during final reduction"; vdpprint f1; prin2t "reduced to"; vdpprint f2; terpri()>>; symbolic procedure groebmess27 r; if !*trgroeb then <<terpri(); prin2t "factor ignored (considered already):"; vdpprint r>>; symbolic procedure groebmess27a (h,r); if !*trgroeb then <<terpri(); vdpprint h; prin2t " reduced to zero by factor"; vdpprint r>>; symbolic procedure groebmess28 r; if !*trgroeb then <<writepri("interim content reduction:", 'first); writepri(mkquote prepsq r, 'last)>>; symbolic procedure groebmess29 omega; if !*trgroeb then <<terpri(); prin2 "actual weight vector: ["; for each x in omega do <<prin2 " "; prin2 x>>; prin2 "]"; terpri(); terpri()>>; symbolic procedure groebmess30 gomegaplus; if !*trgroeb and gomegaplus then <<terpri(); prin2 "new head term (or full) basis "; terpri(); for each x in gomegaplus do <<vdpprint x; terpri()>> >>; symbolic procedure groebmess31 gg; if !*trgroeb then <<prin2 "full basis"; terpri(); for each x in gg do <<vdpprint x; terpri(); terpri() >> >>; symbolic procedure groebmess32 g; if !*trgroeb then <<terpri(); prin2 "***** start of iteation with"; terpri(); for each x in g do vdpprint x; prin2 "****************************"; terpri()>>; symbolic procedure groebmess33 g; if !*trgroeb then <<terpri(); prin2 "***** resulting system *****"; terpri(); for each x in g do vdpprint x; prin2 "****************************"; terpri()>>; symbolic procedure groebmess34 mx; if !*trgroeb then <<terpri(); prin2 "sum of weight vector "; print mx; terpri()>>; symbolic procedure groebmess35 omega; if !*trgroeb then <<terpri(); prin2 "next weight vector "; print omega; terpri()>>; symbolic procedure groebmess36 tt; if !*trgroeb then <<terpri(); prin2 "new weight: "; print tt>>; symbolic procedure groebmess37 s; if !*trgroeb then <<if not s then prin2 "NOT "; prin2 "taking initials"; terpri(); terpri()>>; symbolic procedure printbl(); printb (linelength nil #- 2); symbolic procedure printb n; <<for i:=1:n do prin2 "-"; terpri()>>; symbolic procedure vdpprintset l; if l then << prin2 "{"; vdpprin2 car l; for each x in cdr l do <<prin2 "; "; vdpprin2 x>>; prin2t "}";>>; symbolic procedure vdpprin2l u; <<prin2 "("; vdpprin2 car u; for each x in cdr u do <<prin2 ","; vdpprin2 x;>>; prin2 ")";>>; endmodule; end;