##################################### ###########DQS-Algorithm ##################################### #restart: with(PolynomialIdeals): with(Groebner): ##################################### Monom:=proc(Vars,d) local i,j,L; if d=0 then RETURN([1]); else L:=Monom(Vars,d-1); RETURN([op({seq(seq(i*j,i=Vars),j=L)})]); fi: end: ##################################### MulList:=proc(F,Vars,d) #option trace; local i,j,k,L,l,f; l:=min(seq(degree(f),f=F)); if dCOEFF(F[i],V[j]));interface(rtablesize=infinity); M:=GaussianElimination(M,'method'='FractionFree'): RETURN(convert(M.convert(V[1..k],Vector),list)); end: ################# LM:=proc(f) global tord; if f<>0 then RETURN(LeadingMonomial(f,tord)); fi: RETURN(0); end: ################# Stable := proc (AA, Vars) #option trace; local i,a,e,u,Ind; for a in AA do Ind := indets(a); i := 1; for e in Ind do member(e, Vars, 'q'); i := max(i, q) od; for u in Vars[1 .. i] do if not IdealMembership(a*u/Vars[i], ) then RETURN(false, Vars[i],u) fi: od: od: RETURN(true,1) end: ################# StronglyStable := proc (AA, Vars) #option trace; local i,a,e,u,Ind,l; for a in AA do Ind := indets(a); for e in Ind do member(e, Vars, 'q'); for i from 1 to q-1 do if not IdealMembership(a*Vars[i]/e, ) then RETURN(false, e, Vars[i]) fi: od: od; od: RETURN(true,1) end: #################### Nested:= proc (AA, Vars) local B,Var,i,Deg,polys,ee,dd,ListVar,mm,LL,bb,ii; #option trace; B := Basis(AA,tdeg(op(Vars))); Var:= Vars; Deg:=max(seq(degree(polys), polys in B)); ee:=0; for i from 1 to nops(Vars) do if subset then ee:=i; fi; od: dd:=nops(Vars)-ee; for bb in B do ListVar:=indets(bb); mm:=NULL: for ii from 1 to nops(Vars) do if Vars[ii] in ListVar then mm:=ii: fi: od: for ii from 1 to mm-1 while mm>nops(Vars)-dd do if not IdealMembership(bb*Vars[ii]^Deg/(Vars[mm]^degree(bb,Vars[mm])), ) then RETURN(false,Vars[mm],Vars[ii]); fi; od; od: RETURN(true,1) end: Noether2:= proc (AA, Vars) local B,Var,i,Deg,polys,ee,dd,ListVar,mm,LL,bb,ii; global tord; #option trace; B := Basis(AA,tdeg(op(Vars))); B:=sort(B, proc (a, b) options operator, arrow; TestOrder(b,a, plex(op(Vars))) end proc);print(salam,B); Var:= Vars; Deg:=max(seq(degree(polys), polys in B)); ee:=0; for i from 1 to nops(Vars) do if subset then ee:=i; fi; od: dd:=nops(Vars)-ee; for bb in B do ListVar:=indets(bb); mm:=NULL: for ii from 1 to nops(Vars) do if Vars[ii] in ListVar then mm:=ii: fi: od: for ii from 1 to dd while mm>nops(Vars)-dd do if not IdealMembership(bb*Vars[ii]^Deg/(Vars[mm]^degree(bb,Vars[mm])), ) then RETURN(false,Vars[mm],Vars[ii]); fi; od; od: RETURN(true,1); end: Noether:= proc (AA, Vars) local B,Var,i,Deg,polys,ee,ListVar,mm,LL,bb,ii; global tord,dd; #option trace; B := Basis(AA,tdeg(op(Vars))); B:=sort(B, proc (a, b) options operator, arrow; TestOrder(b,a, tord) end proc); Var:= Vars; Deg:=max(seq(degree(polys), polys in B)); ee:=0; for i from 1 to nops(Vars) do if subset then ee:=i; fi; od: #dd:=HilbertDimension(,{op(Vars)}); for bb in B do ListVar:=indets(bb); mm:=NULL: for ii from 1 to nops(Vars) do if Vars[ii] in ListVar then mm:=ii: fi: od: for ii from 1 to n-dd while mm>n-dd do if not IdealMembership(bb*Vars[ii]^Deg/(Vars[mm]^degree(bb,Vars[mm])), ) then RETURN(false,Vars[mm],Vars[ii]); fi; od; od: RETURN(true,1); end: dstable2:= proc (AA, Vars) local B,i,Deg,polys,ee,dd,mm,LL,bb,ii; #option trace; B := Basis(AA,tdeg(op(Vars))); Deg:=max(seq(degree(polys), polys in B)); ee:=0; for i from 1 to nops(Vars) do if subset then ee:=i; fi; od: dd:=nops(Vars)-ee; for bb in B do mm:=NULL: for ii from 1 to nops(Vars) do if Vars[ii] in indets(bb) then mm:=ii: fi: od: for ii from 1 to mm-1 while mm>=nops(Vars)-dd do if not IdealMembership(bb*Vars[ii]/Vars[mm], ) then RETURN(false,bb,Vars[ii],Vars[mm]); fi; od; od: RETURN(true,1); end: Weakdstable:= proc (AA, Vars) local B,i,Deg,polys,ee,dd,mm,LL,bb,ii; #option trace; B := Basis(AA,tdeg(op(Vars))); Deg:=max(seq(degree(polys), polys in B)); ee:=0; for i from 1 to nops(Vars) do if subset then ee:=i; fi; od: dd:=nops(Vars)-ee; for bb in B do mm:=NULL: for ii from 1 to nops(Vars) do if Vars[ii] in indets(bb) then mm:=ii: fi: od: for ii from 1 to nops(Vars)-dd while mm>=nops(Vars)-dd do if not IdealMembership(bb*Vars[ii]/Vars[mm], ) then RETURN(false,Vars[ii],Vars[mm]); fi; od; od: RETURN(true,1); end: VarTest:=proc(AA, Vars,S) #option trace; local B,bb,ii; global tord,dd,n: B:=Basis(AA,tdeg(op(Vars))); B:=subs({seq(Vars[i]=0,i=S+1..nops(Vars))},B); B:=sort(B, proc (a, b) options operator, arrow; TestOrder(a, b, tord) end proc); for bb in B do for ii from n-dd to 1 by -1 while degree(bb,Vars[S])>0 do if not IdealMembership(bb*Vars[ii]/Vars[S], ) then RETURN(false,Vars[S],Vars[ii]); fi; od; od: RETURN(true,1); end: LinearChange:=proc(Id,VARS) #option trace; local B,mm,LL,bb,ii,NewId,TemId,SS,A0,hh,vars,chen,J,A,Ideal,WW,Wt,A1,A2,A3,firsttime,firstbytes,secondtime,secondbytes,ListVar,b,A4,a,aa,tt,N,flag,i,U,AA,T,reg,d,FLAG,u; global tord,Vars,v,dd,n; firsttime,firstbytes:=kernelopts(cputime,bytesused); Vars:=VARS: n:=nops(VARS): ListVar:=NULL: tord:=tdeg(op(Vars)): NewId:=Basis(Id,tord): Ideal:=NewId: B:=LM(NewId); dd:=HilbertDimension(,{op(VARS)}); SS:=Stable(B,Vars): J:=NewId: chen:=NULL: while SS[1]=false do aa:=rand(-2..2)(): while aa=0 do aa:=rand(-2..2)(): od: hh:=SS[2]+aa*SS[3]; J:=NewId: NewId:=Basis(subs(SS[2]=hh,NewId),tord); B:=LM(NewId); WW:=SS[3]: Wt:=SS[2]: SS:=Stable(B,Vars,nops(Vars)): if SS[1]=true then chen:=chen,Wt=hh; Ideal:=subs(Wt=hh,Ideal); NewId:=Ideal: elif SS[1]=false and [SS[3],SS[2]]<>[WW,Wt] then chen:=chen,Wt=hh; Ideal:=subs(Wt=hh,Ideal); NewId:=Ideal: else NewId:=J: fi: od: secondtime,secondbytes:=kernelopts(cputime,bytesused); Vars:=VARS: AA:=Basis(subs(chen,Id),tdeg(op(VARS))); tord:=tdeg(op(Vars)): A:=LM(AA): A0:=Noether(A,Vars); A1:=Nested(A,Vars); A2:=StronglyStable(A,Vars): A4:=Weakdstable(A,Vars): A3:=Stable(A,Vars): printf("\n",""): printf("\n",""): printf("%1s %1s %1s %1s %1s:\n",Some,information,about,the,computation): printf("\n",""): printf("%-1s %1s %1s %1s: %3a %3a\n",The, cpu, time, is,secondtime-firsttime,(sec)): printf("%-1s %1s %1s: %3a %3a\n",The,used,memory,secondbytes-firstbytes,(bytes)): printf("%1s %1s %1s:%16a\n",List,of,variables,Vars): printf("%1s :%15a\n",Dimension,dd): #printf("%1s %1s:%9a\n",Reduction,number,max(seq(degree(A[i],Vars[nops(Vars)-dd]),i=1..nops(A)))-1): printf("%1s %1s:%12s\n",Noether,position,A0): printf("%1s %1s:%12s\n",Quasi,stability,A1): #printf("%1s :%18s\n",dstable,dstable(A,Vars)): printf("%1s :%14s\n",WeakDstablity,A4): printf("%1s :%18s\n",Sstablity,A2): printf("%1s %1s:%17s\n",Stable,ideal,A3): printf("%1s %1s %1s %1s:%1a\n",Used,change,of,variables,[chen]): printf("\n",""): printf("\n",""): RETURN(); end: #print("####################Cyclic 5"); #F:=[a*b*c*d*e-1, a*b*c*d + a*b*c*e + a*b*d*e + a*c*d*e + b*c*d*e, a*b*c + a*b*e + a*d*e + b*c*d + c*d*e, a*b + a*e + b*c + c*d + d*e, a + b + c + d + e]: #LinearChange(Homogenize(F,h),[a,b,c,d,e,h]): #print("####################Cyclic6"); #F:=[a*b*c*d*e*f -1, a*b*c*d*e + a*b*c*d*f + a*b*c*e*f + a*b*d*e*f + a*c*d*e*f + b*c*d*e*f,a*b*c*d + a*b*c*f + a*b*e*f + a*d*e*f + b*c*d*e + c*d*e*f,a*b*c + a*b*f + a*e*f + b*c*d + c*d*e + d*e*f, a*b + a*f + b*c + c*d + d*e + e*f,a + b + c + d + e + f]: #LinearChange(Homogenize(F,h),[a,b,c,d,e,f,h]): print("####################Noon"); F := [10*x1^2*x4+10*x2^2*x4+10*x3^2*x4-11*x4*h^2+10*h^3, 10*x1^2*x3+10*x2^2*x3+10*x3*x4^2-11*x3*h^2+10*h^3, 10*x1*x2^2+10*x1*x3^2+10*x1*x4^2-11*x1*h^2+10*h^3, 10*x1^2*x2+10*x2*x3^2+10*x2*x4^2-11*x2*h^2+10*h^3]: LinearChange(F, [x1, x2, x3, x4, h]): #print("####################Weispfenning94"); #F := [y^4+x*y^2*z+x^2*h^2-2*x*y*h^2+y^2*h^2+z^2*h^2, x*y^4+y*z^4-2*x^2*y*h^2-3*h^5, -y^2*x^3+x*y*z^3+y^4*h+x*y^2*z*h-2*x*y*h^3]: #LinearChange(F, [x,y,z,h]): #print("####################Katsura5"); #F := [2*ax^2+2*ay^2+2*az^2+2*at^2+2*au^2+av^2-av, ax*ay+ay*az+2*az*at+2*at*au+2*au*av-au, 2*ax*az+2*ay*at+2*az*au+au^2+2*at*av-at, 2*ax*at+2*ay*au+2*at*au+2*az*av-az, at^2+2*ax*av+2*ay*av+2*az*av-ay, 2*ax+2*ay+2*az+2*at+2*au+av-1]: #LinearChange(Homogenize(F,h), [ax, ay, az, at, au, av,h]): #print("####################Lichtblau"); #F := [x-110*t^2+495*t^3-1320*t^4+2772*t^5-5082*t^6+7590*t^7-8085*t^8+5555*t^9-2189*t^10+374*t^11, y-22*t+110*t^2-330*t^3+1848*t^5-3696*t^6+3300*t^7-1650*t^8+550*t^9-88*t^10-22*t^11]: #LinearChange(Homogenize(F,h),[x,y,t,h]); #print("####################Katsura6"); #F:=[1*x1+2*x2+2*x3+2*x4+2*x5+2*x6+2*x7-1,2*x4*x3+2*x5*x2+2*x6*x1+2*x7*x2-1*x6,1*x3^2+2*x4*x2+2*x5*x1+2*x6*x2+2*x7*x3-1*x5,2*x3*x2+2*x4*x1+2*x5*x2+2*x6*x3+2*x7*x4-1*x4,1*x2^2+2*x3*x1+2*x4*x2+2*x5*x3+2*x6*x4+2*x7*x5-1*x3, 2*x2*x1+2*x3*x2+2*x4*x3+2*x5*x4+2*x6*x5+2*x7*x6-1*x2,1*x1^2+2*x2^2+2*x3^2+2*x4^2+2*x5^2+2*x6^2+2*x7^2-1*x1]: #LinearChange(F, [x1, x2, x3, x4,x5,x6,x7]): #print("####################Eco7"); #F := [(x1+x1*x2+x2*x3+x3*x4+x4*x5+x5*x6)*x7-1, (x2+x1*x3+x2*x4+x3*x5+x4*x6)*x7-2, (x3+x1*x4+x2*x5+x3*x6)*x7-3, (x4+x1*x5+x2*x6)*x7-4, (x5+x1*x6)*x7-5, x6*x7-6, x1+x2+x3+x4+x5+x6+1]: #LinearChange(Homogenize(F,h), [x1, x2, x3, x4,x5,x6,x7,h]); #print("####################Eco8"); #F:=[(x1 + x1*x2 + x2*x3 + x3*x4 + x4*x5 + x5*x6 + x6*x7)*x8 - 1, (x2 + x1*x3 + x2*x4 + x3*x5 + x4*x6 + x5*x7)*x8 - 2,(x3 + x1*x4 + x2*x5 + x3*x6 + x4*x7)*x8 - 3,(x4 + x1*x5 + x2*x6 + x3*x7)*x8 - 4,(x5 + x1*x6 + x2*x7)*x8 - 5,(x6 + x1*x7)*x8 - 6,x7*x8 - 7,x1 + x2 + x3 + x4 + x5 + x6 + x7 + 1]: #LinearChange(Homogenize(F,h), [x1, x2, x3, x4,x5,x6,x7,x8,h]): #print("####################Sturmfels and Eisenbud"); #F := [ss*uu+bb*vv, tt*uu+bb*ww, tt*vv+ss*ww, ss*xx+bb*yy, tt*xx+bb*zz, tt*yy+ss*zz, vv*xx+uu*yy, ww*xx+uu*zz, ww*yy+vv*zz]: #LinearChange(F, [xx, yy, zz, ss, tt, uu, vv, ww,bb]): #print("####################Bermejo/Gimenez"); #F:=[x0^2,x1*x2,x1^3,x0*x1*x3,x0*x2^3,x0*x2^2*x3,x1^2*x3^3,x1^2*x3^2*x4]: #LinearChange(F, [x0,x1,x2,x3,x4]): #print("####################Liu"); #F:=[y*z-y*t0-x*h+a*h, z*t0-z*x-y*h+a*h, t0*x-y*t0-z*h+a*h, x*y-z*x-t0*h+a*h]: #LinearChange(F,[x,z, y, t0, a, h]): #F:=[x_1^2,x_1*x_3-x_2^2]; #LinearChange(F, [x_1,x_2,x_3]): #print("*******Gerdt2******"); #F := [35*y^4-30*x*y^2-210*y^2*z+3*x^2+30*x*z-105*z^2+140*y*w-21*u, 5*x*y^3-140*y^3*z-3*x^2*y+45*x*y*z-420*y*z^2+210*y^2*w-25*x*w+70*z*w+126*y*u]: #F := Homogenize(F, h): #LinearChange(F, [x, y, z, w, u, h]): #print("****************Vermeer***************"); #F:= [x^2-2*x*u+u^2+y^2-2*y*v+v^2-1,v^2-u^3,2*v*x-2*v*u+3*u^2*y-3*u^2*v,6*w^2*u^2*v-3*w*u^2-2*w*v+1]: #LinearChange(Homogenize(F,h), [x,y,u,v,w,h]): #print("****************Seiler***************"); #F:=[z*y^2,y^3,x^3,x*z*y^2,x*y^3,x^2*z*y^2,x^2*y^3]: #F:=[x^3,z*y^2,y^3]: #LinearChange(F, [x,y,z]): #print("####################Green"); #F := [x[3]*x[1],x[2]^2+ x[2]*x[1], x[1]^2]: #F:=[x[1]*x[3], x[2]*x[3], x[3]^2, x[2]^2*x[1], x[2]^3]: #LinearChange(F, [x[1],x[2],x[3]]): #print("####################Butcher"); #F := [a+b+c+d, u+v+w+x, 3*a*b+3*a*c+3*b*c+3*a*d+3*b*d+3*c*d, b*u+c*u+d*u+a*v+c*v+d*v+a*w+b*w+d*w+a*x+b*x+c*x, b*c*u+b*d*u+c*d*u+a*c*v+a*d*v+c*d*v+a*b*w+a*d*w+b*d*w+a*b*x+a*c*x+b*c*x, a*b*c+a*b*d+a*c*d+b*c*d, b*c*d*u+a*c*d*v+a*b*d*w+a*b*c*x]: #LinearChange(F, [a, b, c, d, x, w, u, v]): #F:=[x1*x4-x2*x3,x2^3-x1*x3^2,x2^2*x4-x1^3]: #LinearChange(F, [x1,x2,x3,x4]): #F:=[y^2*z - w*x*y^2, x*y*z - w*z^2, y^2*z - w*x^2*y*z]: #LinearChange(F, [x,y,z,w]): #F:=[x^2*y*z -y^4, x*y^2*z -z^4]: #LinearChange(F, [x,y,z]):