gbasem.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
--
-- This code is distributed freely in the sence of
-- GPL(GNU General Public License).
--
-- reduced Groebner base for ideal in K[x,y,z,...]
-- K=Rational, Z/pZ, Complex, Float
-- Use as: glist:=GBase.getGBase([f1,f2,f3,...])
-- Use as: glist:=GBase.getGBaseZp(prime,[f1,f2,f3,...])
-- reduced minimal strong Groebner base for ideal in Z[x,y,z,...]
-- Use as: glist:=getGBaseI([f1,f2,f3,...])
--
-- getGBase(plist)
-- plist be Array of Polynomial
-- return Array of Polynomial of Reduced Grobner base
-- over field Rational, Complex, Float
-- getGBaseZp(plist,prime)
-- get Groebner basis on Zp.
--
-- K.Kodama 2001-01-26 Sather version
-- K.Kodama 2000-02-01 Ruby first version
--
class GBASE_RAT
class GBASE_RAT is
include GBASE{POLYM_RAT};
end;
class GBASE_FLTD
class GBASE_FLTD is
include GBASE{POLYM_FLTD};
end;
class GBASE_ZP
class GBASE_ZP is
include GBASE{POLYM_INTI};
include GBASE_ZP_ALG{POLYM_INTI};
-- Use as blist:=GBASE_ZP::getGBaseZp(prime, [f1,f2,f3,...]);
end;
class GBASE_INTI_L
class GBASE_INTI_L is
-- Laurent polynomial with INTL coefficients.
-- reduced minimal strong Groebner base for ideal in Z<x,y,z,...>
-- Grobner basis in Laulent polynomial ring Z<x,y,..>.
-- Use as: glist:=GBASE_INTI_L::getGBaseIL([f1,f2,f3,...])
-- K.Kodama 2001-12-17
getGBaseIL(fList:ARRAY{POLYM_INTI}):ARRAY{POLYM_INTI} is
gbase:ARRAY{POLYM_INTI}:=#;
loop fi::=fList.elt!.normalize;
if fi.is_zero.not then gbase:=gbase.append(|fi|); end;
end;
if gbase.size=0 then return (#); end;
fa::=POLYM_INTI::one;
loop fa:=fa+gbase.elt!.coeff_to_one; end;
vTbl::=fa.vars; vlTbl:ARRAY{STR}:=#;
loop
v::=vTbl.elt!; vl::="(1/"+v+")"; vlTbl:=vlTbl.append(|vl|);
gbase:=gbase.append(|#POLYM_INTI(v)*#POLYM_INTI(vl)-1|);
end;
-- set var order
VARNAME::setVarOrder(vlTbl.append(vTbl));
--#OUT+"var_order: "+VARNAME::getVarOrder.str+"\n";
to0:STR:=MONOMIAL{INTI}::getTermOrder;
MONOMIAL{INTI}::setTermOrder("lex");
gbase:=GBASE_INTI::getGBaseI(gbase);
MONOMIAL{INTI}::setTermOrder(to0);
return gbase;
end;
end;
class GBASE_INTI
class GBASE_INTI is
-- reduced minimal strong Groebner base for ideal in Z[x,y,z,...]
-- Grobner basis in Z[x,y,..].
-- Use as: glist:=GBASE_INTI::getGBaseI([f1,f2,f3,...])
-- K.Kodama 2000-02-04 Ruby first version
--
-- This module is distributed freely in the sence of
-- GPL(GNU General Public License).
include GBASE{POLYM_INTI};
include GBASE_INTI_ALG{POLYM_INTI,INTI};
end;
partial class GBASE_ZP_ALG{POLY}
partial class GBASE_ZP_ALG{POLY} is
makeGBaseZp(prime:INTI) is
-- make Grobner basis
GBase.sort; GBase:=GBase.reverse;
q:ARRAY{POLY};
s,h:POLY;
loop while!(S_list.size>0);
s:=S_list.pop.element;
s.divmod_Zp_lt(prime, GBase,out q, out h);
if ~h.is_zero then
loop S_list.insert(wrap.create(h.S_poly_Zp(prime,GBase.elt!)));
end;
-- GBase:=GBase.append(|h|); GBase.sort; GBase:=GBase.reverse;
GBase:=ARRAY_SORT{POLY}::sorted_rev_insert(GBase, h);
end;
end;
end;
makeMinimalLcGBaseZp(prime:INTI) is
-- make lc = 1
loop i::=GBase.ind!;
cr::=INTI_EXT::inv(prime, GBase[i].lc);
GBase[i]:=(GBase[i]*cr)%prime;
end;
end;
makeReducedGBaseZp(prime:INTI) is
GBase.sort; GBase:=GBase.reverse;
g,q:ARRAY{POLY}; p,r:POLY;
loop i::=GBase.ind!;
p:=GBase[i]; g:=ARRAY_EXT{POLY}::delete_at(i,GBase);
p.divmod_Zp(prime, g, out q, out r);
GBase[i]:=r;
end;
end;
getGBaseZp(prime:INTI, fList:ARRAY{POLY}):ARRAY{POLY} is
GBase:=#;
loop fi::=fList.elt!.normalize;
if fi.is_zero.not then GBase:=GBase.append(|fi|); end;
end;
if GBase.size=0 then return (#); end;
S_list:=#;
loop i::=0.upto!(GBase.size-2);
loop j::=(i+1).upto!(GBase.size-1);
S_list.insert(wrap.create(GBase[i].S_poly_Zp(prime,GBase[j])));
end;
end;
--#OUT+"gb="+GBase.str+"\n";
--#OUT+"makeGBaseZp\n";
makeGBaseZp(prime);
--#OUT+"gb="+GBase.str+"\n";
--#OUT+"makeMinimalLcGBaseZp\n";
makeMinimalLcGBaseZp(prime);
--#OUT+"gb="+GBase.str+"\n";
--#OUT+"makeMinimalGBase\n";
makeMinimalGBase;
--#OUT+"gb="+GBase.str+"\n";
--#OUT+"makeReducedGBaseZp\n";
makeReducedGBaseZp(prime);
--#OUT+"gb="+GBase.str+"\n";
GBase.sort; GBase:=GBase.reverse;
return GBase;
end;
end;
partial class GBASE_INTI_ALG{POLY,R}
partial class GBASE_INTI_ALG{POLY,R} is
absGB is
loop i::=0.upto!(GBase.size-1);
if GBase[i].lc.is_neg then GBase[i]:=-GBase[i]; end;
end;
end;
makeGBaseI is
-- make Grobner basis
GBase.sort; GBase:=GBase.reverse;
q:ARRAY{POLY};
s,h:POLY;
loop while!(S_list.is_empty.not);
s:=S_list.pop.element;
s.divmod_lt(GBase,out q, out h);
if ~h.is_zero then
loop S_list.insert( wrap.create(h.S_poly_PID(GBase.elt!))); end;
-- GBase:=GBase.append(|h|); GBase.sort; GBase:=GBase.reverse;
GBase:=ARRAY_SORT{POLY}::sorted_rev_insert(GBase, h);
end;
end;
end;
shared StrongGb:ARRAY{POLY};
searchSaturatedSubsetI(i:CARD, lcmP:POLY) is
lcmM::=lcmP.lp;
if i>=GBase.size then
sat:ARRAY{POLY}; -- set saturated subset
sat:=#;
-- lcmP: lcm of j[*].lp. for poly in GBase
loop poly::=GBase.elt!;
if lcmM.is_divisible(poly.lp) then sat:=sat.append(|poly|); end;
end;
if sat.size=0 then return; end;
cj:ARRAY{R}:=#(sat.size);
loop k::=sat.ind!; cj[k]:=sat[k].lc; end;
aj:ARRAY{R};
cJ:R;
cJ:=INTI_EXT::extended_gcd(cj,out aj);
fJ::=POLY::zero;
loop k::=sat.ind!; fJ:=fJ+#POLY(lcmM/sat[k].lp)*sat[k]*aj[k]; end;
StrongGb:=StrongGb.append(|fJ|);
else
lp::=GBase[i].lp;
searchSaturatedSubsetI(i+1,lcmP);
if ~lcmP.lp.is_divisible(lp) then
searchSaturatedSubsetI(i+1,#POLY(lcmP.lp.lcm(lp)));
end;
end;
end;
reductionSameLpI is
GBase.sort; GBase:=GBase.reverse;
-- Make GBase[] have different lp.
--#OUT+"reductionSameLpI\n";
f:POLY;
a0,a1:R;
i::=0;
loop while!(i<GBase.size-1);
j::=i+1;
loop while!(j<GBase.size);
if GBase[i].lp=GBase[j].lp then
gcd::=INTI_EXT::extended_gcd(GBase[i].lc,GBase[j].lc,out a0,out a1);
f:=GBase[i]*a0+GBase[j]*a1;
GBase[i]:=f;
GBase:=ARRAY_EXT{POLY}::delete_at(j,GBase);
else j:=j+1;
end;
end;
i:=i+1;
end;
end;
makeStrongGBI is
-- make strong Grobner basis
absGB;
reductionSameLpI;
-- for all saturated subset
GBase.sort; GBase:=GBase.reverse;
StrongGb:=#;
searchSaturatedSubsetI(0,POLY::one);
GBase:=StrongGb.copy;
reductionSameLpI;
GBase.sort; GBase:=GBase.reverse;
end;
makeMinimalStrongGBI is
g:ARRAY{POLY}:=#;
q:ARRAY{POLY};
p,r:POLY;
GBase.sort; GBase:=GBase.reverse;
i::=0;
loop while!(i<GBase.size);
p:=GBase[i]; g:=ARRAY_EXT{POLY}::delete_at(i,GBase);
p.divmod(g, out q, out r);
if r.is_zero then GBase:=ARRAY_EXT{POLY}::delete_at(i,GBase);
else GBase[i]:=r; i:=i+1;
end;
end;
GBase.sort; GBase:=GBase.reverse;
end;
getGBaseI(fList:ARRAY{POLY}):ARRAY{POLY} is
GBase:=#;
loop fi::=fList.elt!.normalize;
if fi.is_zero.not then GBase:=GBase.append(|fi|); end;
end;
if GBase.size=0 then return (#); end;
S_list:=#;
loop i::=0.upto!(GBase.size-2);
loop j::=(i+1).upto!(GBase.size-1);
S_list.insert( wrap.create(GBase[i].S_poly_PID(GBase[j])) );
end;
end;
-- #OUT+GBase.str+"\n";
-- #OUT+"makeGBaseI\n";
makeGBaseI;
-- #OUT+GBase.str+"\n";
-- #OUT+"makeStrongGBI\n";
makeStrongGBI;
--#OUT+GBase.str+"\n";
--#OUT+"makeMinimalStrongGBI\n";
makeMinimalStrongGBI;
--#OUT+GBase.str+"\n";
--#OUT+"sort\n";
GBase.sort; GBase:=GBase.reverse;
--#OUT+GBase.str+"\n";
return GBase;
end;
end; -- GBaseI
partial class GBASE{POLY}
partial class GBASE{POLY} is
shared S_list:A_PQ{PQMIN{POLY}}; -- queue of S-polynomial.
shared wrap:PQMIN{POLY};
shared GBase:ARRAY{POLY}; -- sorted decreasing order ">".
makeGBase is
-- make Grobner basis
GBase.sort; GBase:=GBase.reverse;
q:ARRAY{POLY};
s,h:POLY;
loop while!(S_list.size>0);
s:=S_list.pop.element;
s.divmod_lt(GBase,out q, out h);
if ~h.is_zero then
loop S_list.insert(wrap.create(h.S_poly(GBase.elt!))); end;
--GBase:=GBase.append(|h|); GBase.sort; GBase:=GBase.reverse;
GBase:=ARRAY_SORT{POLY}::sorted_rev_insert(GBase, h);
end;
end;
end;
makeMinimalGBase is
GBase.sort; GBase:=GBase.reverse;
i,j:CARD; change:BOOL;
i:=0;
loop while!(i<GBase.size);
j:=i+1; change:=false;
loop while!(j<GBase.size);
if GBase[i].lt.is_divisible(GBase[j].lt) then
change:=true; break!;
end;
j:=j+1;
end;
if change then
GBase:=ARRAY_EXT{POLY}::delete_at(i,GBase);
else i:=i+1; end;
end;
end;
makeMinimalLcGBase is
-- make lc = 1
loop i::=GBase.ind!;
GBase[i]:=GBase[i]/GBase[i].lc;
end;
end;
makeReducedGBase is
-- Reduced Grobner basis is canonical.
GBase.sort; GBase:=GBase.reverse;
g,q:ARRAY{POLY}; p,r:POLY;
loop i::=GBase.ind!;
p:=GBase[i]; g:=ARRAY_EXT{POLY}::delete_at(i,GBase);
p.divmod(g,out q, out r);
GBase[i]:=r;
end;
end;
getGBase(fList:ARRAY{POLY}):ARRAY{POLY} is
GBase:=#;
loop fi::=fList.elt!.normalize;
if fi.is_zero.not then GBase:=GBase.append(|fi|); end;
end;
if GBase.size=0 then return (#); end;
S_list:=#;
loop i::=0.upto!(GBase.size-2);
loop j::=(i+1).upto!(GBase.size-1);
S_list.insert( wrap.create(GBase[i].S_poly(GBase[j])) );
end;
end;
--#OUT+"gb="+GBase.str+"\n";
makeGBase;
--#OUT+"gb="+GBase.str+"\n";
--#OUT+"makeMinimalGBase\n";
makeMinimalGBase;
--#OUT+"gb="+GBase.str+"\n";
--#OUT+"makeMinimalLcGBase\n";
makeMinimalLcGBase;
--#OUT+"gb="+GBase.str+"\n";
--#OUT+"makeReducedGBase\n";
makeReducedGBase;
--#OUT+"gb="+GBase.str+"\n";
--#OUT+"sort\n";
GBase.sort; GBase:=GBase.reverse;
--#OUT+"gb="+GBase.str+"\n";
return GBase;
end;
end;
class TEST_GBASEM
class TEST_GBASEM is
include TEST;
main is
test_gb_i;
test_gb_rat;
test_gb_zp;
end;
test_gb_i is
class_name("GBASE_INTI");
POLYM_INTI::init;
#OUT+" Grobner basis for Z[x,y,... ]\n";
f1,f2,f3:POLYM_INTI;
gb:ARRAY{POLYM_INTI};
sa:ARRAY{STR};
s:STR;
x::=#POLYM_INTI(1.inti,"x",1.int);
y::=#POLYM_INTI(1.inti,"y",1.int);
z::=#POLYM_INTI(1.inti,"z",1.int);
f1:=x*2.inti+y*3.inti+3.inti;--"2x+3y+3"
f2:=x+y*5.inti+2.inti; --"x+5y+2"
gb:=GBASE_INTI::getGBaseI(|f1,f2|);
-- #OUT+gb.str+"\n";
sa:=|"x+5*y+2", "7*y+1" |; s:=sa.str;
test("sample1", gb.str, s);
f1:=x*2.inti+y*3.inti+3.inti;
f2:=x+y*5.inti+2.inti;
f3:=x*y-1.inti;
gb:=GBASE_INTI::getGBaseI(|f1,f2,f3|);
sa:=|"x+7", "y+23", "40"|; s:=sa.str;
test("sample2", gb.str, s);
-- sample from
-- William W.Adams, Philippe Loustaunau
-- "An Introduction to Groebner Bases",
-- AMS GSM(Graduale Study in Mathematics) vol.3
VARNAME::setVarOrder(|"y","x"|);
MONOMIAL{INTI}::setTermOrder("lex");
f1:=x*y*2.inti-x;--2x*y-x
f2:=y*3.inti-x^2;--3y-x^2
gb:=GBASE_INTI::getGBaseI(|f1,f2|);
sa:=|"y*x+x^{3}-2*x", "3*y-x^{2}", "2*x^{3}-3*x"|;
s:=sa.str;
test("sample 4.5.5a", gb.str, s);
VARNAME::setVarOrder;
MONOMIAL{INTI}::setTermOrder("deglex");
f1:=x^2*y*3.inti-y*z*3.inti+y;--3x^2y-3y*z+y
f2:=x^2*z*5.inti-z^2*8.inti;-- 5x^2z-8z^2
gb:=GBASE_INTI::getGBaseI(|f1,f2|);
sa:=|"x^{2}*y*z+2*y*z^{2}+2*y*z",
"3*x^{2}*y-3*y*z+y",
"5*x^{2}*z-8*z^{2}", "9*y*z^{2}+5*y*z"|;
s:=sa.str;
test("sample 4.5.5b", gb.str, s);
VARNAME::setVarOrder;
MONOMIAL{INTI}::setTermOrder("lex");
f1:=x^2*6.inti+y^2; -- 6x^2+y^2
f2:=x^2*y*10.inti+x*y*2.inti; -- 10x^2y+2x*y
gb:=GBASE_INTI::getGBaseI(|f1,f2|);
sa:=|"2*x^{2}*y+4*x*y-3*y^{3}",
"6*x^{2}+y^{2}", "x*y^{3}+20*y^{5}+5*y^{3}",
"6*x*y-5*y^{3}", "25*y^{5}+6*y^{3}" |;
s:=sa.str;
test("sample 4.5.5c", gb.str, s);
finish;
end;
test_gb_rat is
class_name("GBASE_RAT");
POLYM_RAT::init;
#OUT+" Grobner basis for rational coefficient Q[x,y,... ]\n";
f1,f2,f3:POLYM_RAT;
gb:ARRAY{POLYM_RAT};
sa:ARRAY{STR};
s:STR;
x::=#POLYM_RAT(#RAT(1),"x",1.int);
y::=#POLYM_RAT(#RAT(1),"y",1.int);
z::=#POLYM_RAT(#RAT(1),"z",1.int);
--VARNAME::setVarOrder(|"y","x"|);
VARNAME::setVarOrder;
MONOMIAL{RAT}::setTermOrder("lex");
gb:=GBASE_RAT::getGBase(|x,y,z|);
sa:=|"x","y","z"|; s:=sa.str;
test("sample1", gb.str, s);
MONOMIAL{RAT}::setTermOrder("degrevlex");
-- VARNAME::setVarOrder(|"y","x"|);
f1:=x*y-x;
f2:=-y+x^2;
gb:=GBASE_RAT::getGBase(|f1,f2|);
sa:=|"x^{2}-y", "x*y-x","y^{2}-y" |; s:=sa.str;
test("sample1", gb.str, s);
MONOMIAL{RAT}::setTermOrder("deglex");
-- VARNAME::setVarOrder(|"y","x"|);
f1:=x*y-x;
f2:=-y+x^2;
gb:=GBASE_RAT::getGBase(|f1,f2|);
sa:=|"x^{2}-y", "x*y-x","y^{2}-y" |; s:=sa.str;
test("sample1", gb.str, s);
MONOMIAL{RAT}::setTermOrder("degrevlex");
#OUT+"example 2\n";
f1:=y^2+x*y+x^2;
f2:=y+x;
f3:=y;
gb:=GBASE_RAT::getGBase(|f1,f2,f3|);
sa:=|"x","y" |; s:=sa.str;
test("sample2", gb.str, s);
#OUT+"example 3\n";
f1:=x+y+z-#RAT(3);
f2:=x*2+y*3+z*4-#RAT(9);-- 2x+3y+4z-9
f3:=x*3+y*4+z*5-#RAT(12); -- 3x+4y+5z-12
gb:=GBASE_RAT::getGBase(|f1,f2,f3|);
sa:=|"x-z", "y+2*z-3" |; s:=sa.str;
test("sample3", gb.str, s);
#OUT+"example 4\n";
f1:=x+y+z*2-#RAT(2);-- "x+y+2z-2"
f2:=x*2+y*3+z*6-#RAT(5); -- "2x+3y+6z-5"
f3:=x*3+y*2+z*4-#RAT(5); -- "3x+2y+4z-5"
gb:=GBASE_RAT::getGBase(|f1,f2,f3|);
sa:=|"x-1", "y+2*z-1" |; s:=sa.str;
test("sample4", gb.str, s);
#OUT+"example 5\n";
f1:=x^2+y^2-#RAT(5); -- "x^2+y^2-5"
f2:=x+y-#RAT(3);--"x+y-3"
gb:=GBASE_RAT::getGBase(|f1,f2|);
sa:=| "y^{2}-3*y+2", "x+y-3"|; s:=sa.str;
test("sample5", gb.str, s);
MONOMIAL{RAT}::setTermOrder("degrevlex");
f1:=x^5+y^4+z^3-#RAT(1); -- "x^5+y^4+z^3-1"
f2:=x^3+y^3+z^2-#RAT(1); --"x^3+y^3+z^2-1"
gb:=GBASE_RAT::getGBase(|f1,f2|);
sa:=| "y^{6}+x*y^{4}+2*y^{3}*z^{2}+x*z^{3}+z^{4}-2*y^{3}-2*z^{2}-x+1",
"x^{2}*y^{3}-y^{4}+x^{2}*z^{2}-z^{3}-x^{2}+1",
"x^{3}+y^{3}+z^{2}-1"|; s:=sa.str;
-- #OUT+"gb="+gb.str+"\n";
test("sample6", gb.str, s);
test("gb test",f1.mod(gb),"0");
test("gb test",f2.mod(gb),"0");
--- change term order ---
f1:=x^2*y*3-y*z;--"3x^2y-y*z"
f2:=x*y^2+z^4;--"x*y^2+z^4"
MONOMIAL{RAT}::setTermOrder("degrevlex");
gb:=GBASE_RAT::getGBase(|f1,f2|);
sa:=| "z^{4}+x*y^{2}",
"x^{2}*y-1/3*y*z" |; s:=sa.str;
test("degrevlex", gb.str, s);
MONOMIAL{RAT}::setTermOrder("deglex");
gb:=GBASE_RAT::getGBase(|f1,f2|);
sa:=| "z^{4}+x*y^{2}",
"x^{2}*y-1/3*y*z" |; s:=sa.str;
test("deglex", gb.str, s);
MONOMIAL{RAT}::setTermOrder("lex");
gb:=GBASE_RAT::getGBase(|f1,f2|);
sa:=| "x^{2}*y-1/3*y*z",
"x*y^{2}+z^{4}",
"x*z^{4}+1/3*y^{2}*z",
"y^{4}*z-3*z^{8}" |; s:=sa.str;
test("lex", gb.str, s);
finish;
end;
test_gb_zp is
class_name("GBASE_ZP");
POLYM_INTI::init;
#OUT+" Grobner basis for Zp[x,y,... ]\n";
f1,f2,f3:POLYM_INTI;
gb:ARRAY{POLYM_INTI};
sa:ARRAY{STR};
s:STR;
x::=#POLYM_INTI(#INTI(1),"x",1.int);
y::=#POLYM_INTI(#INTI(1),"y",1.int);
z::=#POLYM_INTI(#INTI(1),"z",1.int);
f1:=x+y+z-#INTI(3);
f2:=x*2+y*3+z*4-#INTI(9);-- 2x+3y+4z-9
f3:=x*3+y*4+z*5-#INTI(12); -- 3x+4y+5z-12
gb:=GBASE_ZP::getGBaseZp(7.inti , |f1,f2,f3|);
sa:=|"x+6*z", "y+2*z+4" |; s:=sa.str;
test("sample3", gb.str, s);
finish;
end;
end;