Artifact ddfe2078c7a89cfa5ec14a949659662377431a260901a23712ed7f78a538577e:
- Executable file
r38/packages/groebner/groebrst.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: 4252) [annotate] [blame] [check-ins using] [more...]
module groebrst; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % restrictions for polynomials during Groebner base calculation % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% symbolic procedure groebtestrestriction (h,arg); if groebrestriction!* = 'nonnegative then groebnonneg(h,arg) else if groebrestriction!* = 'positive then groebpos(h,arg) else if groebrestriction!* = 'izeropoint then groebzero(h,arg) else rerror(groebnr2,9, "Groebner: general restrictions not yet implemented"); symbolic procedure groebnonneg(h,arg); % test if h is a polynomial which can have the value zero with % only nonnegative variable settings. begin scalar x,break,vev1,vevl,problems,problems1,r; if vdpzero!? h then return nil else if vevzero!? vdpevlmon h then goto finish; % first test the coefficients if vdpredZero!? h then return nil; % simple monomial break := nil; x := h; while not vdpzero!? x and not break do <<vev1 := vdpevlmon x; if not vbcplus!? vdpLbc x then break := t; if not break then x := vdpred x>>; if break then return nil; % at least one negative coeff if vevzero!? vev1 then goto finish; % nonneg. solution imposs. % homogenous polynomial: find combinations of % variables which are solutions x := h; vev1 := vdpevlmon x; vevl := vevsplit(vev1); problems := for each x in vevl collect list x; x := vdpred x; while not vdpzero!? x do << vev1 := vdpevlmon x; vevl := vevsplit(vev1); problems1 := nil; for each e in vevl do for each p in problems do <<r := if not member(e,p) then e . p else p; problems1 := union(list r, problems1)>>; problems := problems1; x := vdpred x >>; problems := % lift vevs to polynomials for each p in problems collect for each e in p collect vdpfmon(a2vbc 1,e); % rule out problems contained in others for each x in problems do for each y in problems do if not eq(x,y) and subset!?(x,y) then problems := delete (y,problems); % rule out some by cdr problems1 := nil; while problems do <<if vdpDisjoint!? (car problems,arg) then problems1 := car problems . problems1; problems := cdr problems >>; finish: groebmess24(h,problems1,arg); return if null problems1 then 'icancel else 'restriction . problems1 end; symbolic procedure groebpos(h,dummy); % test if h is a polynomial which can have the value zero with % only positive (nonnegative and nonzero) variable settings. begin scalar x,break,vev1; dummy := nil; if vdpzero!? h then return nil else if vevzero!? vdpevlmon h then return nil; % a simple monomial can never have pos. zeros if vdpredzero!? h then return groebposcancel(h); break := nil; x := h; % test coefficients while not vdpzero!? x and not break do <<vev1 := vdpevlmon x; if not vbcplus!? vdpLbc x then break := t; if not break then x := vdpred x>>; if not break then return groebPosCancel(h); if not groebposvevaluate h then groebPosCancel(h); return nil end; symbolic procedure groebposvevaluate h; <<h := nil; t>>; % test if a polynomial can become zero under user restrictions % here a dummy to be rplaced elsewhere symbolic procedure groebzero(h,dummy); begin scalar l; dummy := nil; l:=vdplastmon h; if l and vevzero!? cdr l then return groebPosCancel h; return nil end; symbolic procedure groebposcancel(h); <<groebmess24(h,nil,nil); 'cancel>>; endmodule;;end;