module groebcri;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Criteria for the Buchberger algorithm .
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
smacro procedure atleast2elementsin u;
% Test if u has at least a cadr element .
u and cdr u;
symbolic procedure groebbuchcrit4(p1,p2,e);
% Buchberger criterion 4 . p1 and p2 are distributive
% polynomials . e is the least common multiple of
% the leading exponent vectors of the distributive
% polynomials p1 and p2 . groebBuchcrit4(p1,p2,e)returns a
% boolean expression . True,if the reduction of the
% distributive polynomials p1 and p2 is necessary else false .
% Orig:
% e neq vevsum(vdpevlmon p1,vdpevlmon p2);
<< e;groebbuchcrit4t(vdpevlmon p1,vdpevlmon p2)>>;
symbolic procedure groebbuchcrit4t(e1,e2);
% Nonconstructive test of lcm(e1,e2)=e1 + e2;
% equivalent: no matches of nonzero elements .
if null e1 or null e2 then nil else
if(car e1 neq 0)and(car e2 neq 0)then t
else groebbuchcrit4t(cdr e1,cdr e2);
symbolic procedure groebinvokecritbuch4(p,d2);
% Buchberger's criterion 4 is tested on the pair p and the list
% D2 of critical pairs is updated with respect to that crit .
% Result is the updated D2 .
begin scalar p1,p2,vev1,vev2,f1,f2,fd,b4;
p1:=cadr p;p2:=caddr p;vev1:=vdpevlmon p1;vev2:=vdpevlmon p2;
f1:=vdpgetprop(p1,'monfac);f2:=vdpgetprop(p2,'monfac);
% Discard known common factors first .
if f1 and f2 then
<< fd:=vevmin(f1,f2);
b4:=groebbuchcrit4t(vevdif(vev1,fd), vevdif(vev2,fd));
if b4 and % Is the body itself a common factor ?
vevdif(vev1,f1)=vevdif(vev2,f2)
% Test if the polys reduced by their monom .
% factor are equal .
and groebbuchcrit4compatible(p1,f1,p2,f2)
then b4:=nil >>
else b4:=groebbuchcrit4t(vev1,vev2);
if b4 then d2:=append(d2,{p})else b4count!*:=b4count!* + 1;
return d2 end;
symbolic procedure groebbuchcrit4compatible(p1,f1,p2,f2);
% p1,p2 polys,f1,f2 exponent vectors(monomials), which are known to
% be factors of their f;
% tests, if p1 / f1=p2 / f2 .
if vdpzero!? p1 then vdpzero!? p2
else if vdplbc p1=vdplbc p2 and
groebbuchcrit4compatiblevev(vdpevlmon p1,f1,vdpevlmon p2,f2)
then groebbuchcrit4compatible(vdpred p1,f1,vdpred p2,f2)
else nil;
symbolic procedure groebbuchcrit4compatiblevev(vev1,f1,vev2,f2);
if null vev1 then null vev2 else
if(if f1 then car vev1 - car f1 else car vev1)=
(if f2 then car vev2 - car f2 else car vev2)then
groebbuchcrit4compatiblevev(cdr vev1,
if f1 then cdr f1 else nil,cdr vev2,
if f2 then cdr f2 else nil)else nil;
symbolic procedure groebinvokecritf d1;
% GroebInvokeCritF tests a list D1 of critical pairs . It cancels all
% critical pairs but one in D1 having the same lcm(i . e . car
% component)as car(D1). This only one is chosen,if possible,
% such that it doesn't satisfy groebBuchcrit4 .
% Version: moeller upgraded 5.7.87 .
begin scalar tp1,p2,active;
tp1:=caar d1;active:=atleast2elementsin d1;
while active do
<< p2:=cadr d1;
if car p2=tp1 then
<< fcount!*:=fcount!* + 1;
if not groebbuchcrit4t(cadr p2,caddr p2)then d1:=cdr d1
else d1:=groedeletip(p2,d1);
active:=atleast2elementsin d1 >>
else active:=nil >>;
return d1 end;
symbolic procedure groebinvokecritm(p1,d1);
% D1 is a list of critical pairs,p1 is a critical pair .
% Crit M tests,if the lcm of p1 divides one of the lcm's in D1 .
% If so,this object is eliminated .
% Result is the updated D1 .
<< for each p3 in d1 do if buchvevdivides!?(car p1,car p3)then
<< mcount!*:=mcount!* + 1;
d1:=groedeletip(p3,d1)>>; % Criterion M .
d1 >>;
symbolic procedure groebinvokecritb(fj,d);
% D is a list of critical pairs,fj is a polynomial .
% Crit B allows to eliminate a pair from D,if the leading monomial
% of fj divides the lcm of the pair,but the lcm of fj with each of
% the members of the pair is not the lcm of the pair itself .
% Result is the updated D .
<< for each p in d do
if buchvevdivides!?(vdpevlmon fj,car p)and
tt(fj,cadr p)neq car p and % Criterion B .
tt(fj,caddr p)neq car p then
<< bcount!*:=bcount!* +1;d:=delete(p,d)>>;d >>;
endmodule;;end;