Artifact c97e714079071c6325a49a188f245ef14762cbccb6e8b61c156ede1b5d563531:
- Executable file
r38/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: 9879) [annotate] [blame] [check-ins using] [more...]
module groebmes; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Trace messages for the algorithms . % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 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 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 >>;rin2 ")" >>; endmodule;;end;