Artifact d0de416b67b5ee68c3912508ad793a77b6550936abe30eb609859f3a59372a69:
- Executable file
r37/packages/groebner/groebsea.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: 4034) [annotate] [blame] [check-ins using] [more...]
module groebsea; % support of search for reduction polynomials fluid '(thirdvalue!* fourthvalue!* hcount!* !*groebWeak); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % search for reduction candidates in a list symbolic procedure groebsearchinlist (vev,g); % search for a polynomial in the list G, such that the lcm divides % vev; G is expected to be sorted in descending sequence if null G then nil else if buch!-vevdivides!?(vdpevlmon car g, vev) then car g else groebsearchinlist (vev,cdr g); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % search tree for polynomials % simple variant: mapped to search list % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% symbolic procedure groebstreeadd (poly,stru); % add one polynomial to the tree % if this is a simple polynomial (mono or bino), reform % the tree if hcount!* #< 5000 then vdplsortin(poly,stru) else vdplsortinreplacing(poly,stru); symbolic procedure groebsearchinstree (vev,stru); % search a polynomial corresponding to the exponent vector vev groebsearchinlist (vev,stru); symbolic procedure groebstreeextract stru; % gives a linear list of all polynomials in the tree stru; symbolic procedure groebstreereconstruct u; % reconstructs a tree from a linear list of polynomials vdplsort u; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % reforming G, D and G99 when a very simple polynomial was % found (e.g. a monomial, a binomial) symbolic procedure groebsecondaryreduction(poly,g,g99,d,gc,mode); % if poly is a simple polynomial, the polynomials in G and G99 % are reduced in a second pass. Result is G, secondvalue is G99. % mode says, that G99 has to be modified in place. begin scalar vev,p,pl,x,rep,first,rpoly,break; mode := nil; secondvalue!* := g99; thirdvalue!* := d; fourthvalue!* := gc; vev := vdpevlmon poly; rpoly := vdpred poly; % cancel redundant elements in G99 for each p in g99 do if buch!-vevdivides!?(vev,vdpevlmon p) then g99:=delete(p,g99); if vdplength poly > 2 or vevzero!? vev then return g; if !*groebweak and not vdpzero!? rpoly and (groebweaktestbranch!=1(poly,g,d)) then return 'abort; !*trgroeb and groebmess50 g; pl := union(g,g99); first := t; while pl and not break do << p:= car pl; pl := cdr pl; if groebprofitsfromvev(p,vev) then % replace by simplified version <<x := groebnormalform1(p,poly); x := groebsimpcontnormalform x; x := vdpenumerate x; if first then !*trgroeb and groebmess20(poly); first := nil; !*trgroeb and groebmess21(p,x); rep := (p . x) . rep; if not vdpzero!? x and vevzero!? vdpevlmon x then break := t; % 1 found >> >>; if break then return 'abort; % reform G99 g99 := for each p in g99 collect groebsecondaryreplace(p,rep); secondvalue!* := groebsecondaryremovemultiples g99; % reform D thirdvalue!* := d; % reform Gc fourthvalue!* := groebsecondaryremovemultiples for each y in gc collect groebsecondaryreplace(y,rep); g:=for each y in g collect groebsecondaryreplace(y,rep); !*trgroeb and groebmess50 g; return groebsecondaryremovemultiples g; end; symbolic procedure groebsecondaryremovemultiples g; if null g then nil else if vdpzero!? car g or member(car g,cdr g) then groebsecondaryremovemultiples cdr g else car g . groebsecondaryremovemultiples cdr g; symbolic procedure groebsecondaryreplace(x,rep); (if y then cdr y else x) where y = atsoc(x,rep); endmodule; end;