########################################################### ################# Improved GBGR over Z_P^n################# ########################################################### with(padic): with(Groebner): with(combinat): ######################## LM:=proc(f) global t,M; if f=0 then RETURN(0); else RETURN(LeadingMonomial(f,t)) ; end if; end proc: ######################## LC:=proc(f) global t,M; RETURN(LeadingCoefficient(f,t)); end proc: ########################The highest power of p in p-adic representation of 'ex' np:=proc(ex) global t,p,n,M; local C,A,B,exx,npp; exx:=ex mod p^n; C:=convert(evalp(exx,p),list); A:=op(C[1]); B:=A[3][1..-2]; npp:=ordp(exx,p)+nops(B)-1; RETURN(npp); end proc: #######################Division Algorithm in R red:=proc(ex,b) #option trace; global t,p,n,M; local r,q,exx,A,B,npp,landa,C,ordb,ordex; exx:=ex mod p^n; ordex:=ordp(exx,p); ordb:=ordp(b,p); #r:=evalp(exx mod p^(ordb),p); C:=convert(evalp(exx,p),list); A:=op(C[1]); B:=A[3][1..-2]; npp:=ordex+nops(B)-1; if npp>=ordb then B:=[seq(0,i=1..ordex),op(B)]; landa:=solve(op(msolve(simplify(b/p^ordb)*maple=1,p^n))); RETURN(add(B[i+1]*p^(i-ordb),i=ordb..nops(B)-1)*landa); else RETURN(0); end if; end proc: #######################Division in R[X] reduc:=proc(f,L) #option trace; global t,p,n,M; local r,i,flag,b,g,lm,lc; b:=f mod p^n; r := 0; while b<>0 do i := 1; flag := false; lm:=LM(b); lc:=LC(b); while i <= nops(L) and flag = false do if divide(lm, M[L[i]][2]) and np(lc)>= ordp(M[L[i]][3],p) then g:=expand(lm*red(lc,M[L[i]][3])/M[L[i]][2])mod p^n; b := simplify(b-expand(g*M[L[i]][1])) mod p^n; flag := true; else i := i+1; end if; end do; if not flag then r := expand(r+lm*lc) mod p^n; b :=expand(b-lm*lc)mod p^n; end if; end do; RETURN(r); end proc: #####################Groebner Basis over Galois ring Z_p^n gBasis:=proc(F,tord,P,N) #option trace; global t,p,n,M; local G,S1,S2,f,k,r,k1,k2,k12,spol,l,cc,bb,aa1,aa2,num,GG,u,d; cc[1],bb[1]:=kernelopts(cputime,bytesused); t:=tord; p:=P; n:=N; u:=0; d:=0; M:=[seq([f,LM(f),LC(f),ordp(LC(f),p)],f in F)]; S1:=[seq(i,i=1..nops(F))]; S2:=[]; #S2:=choose(S1,2); #G:=S1; GG:=S1; G:=[]; while nops(GG)<>0 do f:=GG[1]; GG:=GG[2..-1]; G,S2:=update(G,S2,f); S2:=sort(S2,tidy); end do; while nops(S1)<>0 do f:=S1[1]; S1:=S1[2..-1]; r:=reduc(p^(n-M[f][4])*M[f][1],G); if r<>0 then num:=nops(M)+1; S1:=[op(S1),num]; M:=[op(M),[r,LM(r),LC(r),ordp(LC(r),p)]]; G,S2:=update(G,S2,num); S2:=sort(S2,tidy); else u:=u+1; end if; while nops(S2)<>0 do f:=S2[1]; S2:=S2[2..-1]; l:=lcm(M[f[1]][2],M[f[2]][2]); d:=max(d,degree(l)); k12:=max(M[f[1]][4],M[f[2]][4]); aa1:=expand(M[f[1]][3]/p^(M[f[1]][4])); aa2:=expand(M[f[2]][3]/p^(M[f[2]][4])); spol:=expand((l*p^(k12-M[f[1]][4])*solve(op(msolve(aa1*maple=1,p^n)))*M[f[1]][1]/M[f[1]][2]mod p^n)-(l*p^(k12-M[f[2]][4])*solve(op(msolve(aa2*maple=1,p^n)))*M[f[2]][1]/M[f[2]][2]mod p^n)); r:=reduc(spol,G); if r<>0 then num:=nops(M)+1; M:=[op(M),[r,LM(r),LC(r),ordp(LC(r),p)]]; G,S2:=update(G,S2,num); S2:=sort(S2,tidy); S1:=[op(S1),num]; else u:=u+1; end if: end do; end do; cc[2],bb[2]:=kernelopts(cputime,bytesused); printf("The time of computation is = %a\n", cc[2]-cc[1]); printf("The memory used of computation is = %a\n", bb[2]-bb[1]); printf("The number of reductions to zero is = %a\n",u); printf("The degree of the Groebner basis is = %a\n", d); printf("The corretness of the algorithm is =%a\n", IsGroebner(F,G)); RETURN([seq(M[i][1],i in G)]); end proc: ############################################ update:=proc(G,B,f) #option trace; local C,dd,D,c,flag,d,E,b,G1,B1,B2,G2,F,lth,j; global M,t,p,n; G1 := G; B1 := B; C:=[seq([f,g],g in G1)]; D:=[]; while nops(C)<>0 do c:=test(C[1]); C:=C[2..-1]; if gcd(M[c[1]][2],M[c[2]][2])=1 and (M[c[1]][4]=0 or M[c[2]][4]=0) then D:=[op(D),c]; else flag:=false; for d in C while not flag do dd:={op(d)} minus{f}; if divide(lcm(M[c[1]][2],M[c[2]][2]),lcm(M[d[2]][2],M[f][2])) and M[dd[1]][4]<=M[c[1]][4] #((M[c[1]][4]=M[dd[1]][4] and M[dd[1]][4]>=M[c[2]][4]) #or(M[c[1]][4]>=M[c[2]][4] and M[c[2]][4]>=M[dd[1]][4] )) then flag:=true; end if; end do; for d in D while not flag do dd:={op(d)} minus{f}; if divide(lcm(M[c[1]][2],M[c[2]][2]),lcm(M[dd[1]][2],M[f][2])) and M[dd[1]][4]<=M[c[1]][4] #((M[c[1]][4]=M[dd[1]][4] and M[dd[1]][4]>=M[c[2]][4]) #or (M[c[1]][4]>=M[c[2]][4] and M[c[2]][4]>=M[dd[1]][4] )) then flag:=true; end if; end do; if flag=false then D:=[op(D),c]; end if; fi: end do; E:=[]; while nops(D)<>0 do d:=D[1]; D:=D[2..-1]; if gcd(M[d[1]][2],M[d[2]][2])<>1 or (M[d[1]][4]<>0 and M[d[2]][4]<>0) then E:=[op(E),d]; end if; end do; B2:=[]; while nops(B1)<>0 do b:=test(B1[1]); B1:=B1[2..-1]; if not divide(lcm(M[b[1]][2],M[b[2]][2]),M[f][2]) or lcm(M[f][2],M[b[1]][2])=lcm(M[b[1]][2],M[b[2]][2]) or lcm(M[f][2],M[b[2]][2])=lcm(M[b[1]][2],M[b[2]][2]) #or ((M[b[1]][4]<>M[f][4] or M[f][4]M[b[2]][4])) or M[b[1]][4]0 do j:=G1[1]; G1:=G1[2..-1]; if not (divide(M[j][2],M[f][2]) and M[j][4]>=M[f][4]) then G2:=[op(G2),j]; end if; end do; G2:=[op(G2),f]; RETURN(G2,B2); end proc: ################################ test:= proc(CC) #option trace; local c; global M,t,p,n; c:=CC; if M[c[1]][4]> M[c[2]][4] then RETURN(c); else RETURN([c[2],c[1]]); end if: end proc: ################################ IsGroebner:=proc(F,G) #option trace; global p,n,t,M; local A,B,k1,k2,k12,aa1,aa2,i,r,f,k,l,spol; for i from 1 to nops(F) do r:=reduc(F[i],G); if r<>0 then RETURN(false); end if; end do; A:=G; B:=choose(G,2); while nops(A)<>0 do f:=A[1]; A:=A[2..-1]; k:=ordp(M[f][3],p); if reduc(p^(n-k)*M[f][1],G)<>0 then RETURN(false); end if; end do; while nops(B)<>0 do f:=B[1]; B:=B[2..-1]; k1:=ordp(M[f[1]][3],p); k2:=ordp(M[f[2]][3],p); k12:=max(k1,k2); l:=lcm(M[f[1]][2],M[f[2]][2]); aa1:=expand(M[f[1]][3]/p^(k1)); aa2:=expand(M[f[2]][3]/p^(k2)); spol:=expand((l*p^(k12-k1)*solve(op(msolve(aa1*maple=1,p^n)))*M[f[1]][1]/M[f[1]][2])-(l*p^(k12-k2)*solve(op(msolve(aa2*maple=1,p^n)))*M[f[2]][1]/M[f[2]][2])); if reduc(spol,G)<>0 then RETURN(false); end if: end do; RETURN(true); end proc: ##################### tidy:=proc(P,Q) #option trace: global M,t,p,n: RETURN(TestOrder(lcm(M[P[1]][2],M[P[2]][2]),lcm(M[Q[1]][2],M[Q[2]][2]),t)); end proc: ##################### #####Examples######## print("******************************************eco 6**********************************************"); F:=[(x1 + x1*x2 + x2*x3 + x3*x4 + x4*x5)*x6 - 1, (x2 + x1*x3 + x2*x4 + x3*x5)*x6 - 2, (x3 + x1*x4 + x2*x5)*x6 - 3, (x4 + x1*x5)*x6 - 4, x5*x6 - 5, x1 + x2 + x3 + x4 + x5 + 1]: A:=gBasis(F,tdeg(x1,x2,x3,x4,x5,x6),2,3): print("*************************HAAS3*************************"); F := [x^6+w*y^3-y, y^6+z*x^3-x, 36*y^5*x^5-9*x^2*z*w*y^2+3*w*y^2+3*z*x^2-1]: A:=gBasis(F,tdeg(x,y,w,z),2,3): print("******************************************Katsura 5**********************************************"); F:=[2*x^2+2*y^2+2*z^2+2*t0^2+2*u^2+v^2-v, x*y+y*z+2*z*t0+2*t0*u+2*u*v-u, 2*x*z+2*y*t0+2*z*u+u^2+2*t0*v-t0, 2*x*t0+2*y*u+2*t0*u+2*z*v-z, t0^2+2*x*v+2*y*v+2*z*v-y, 2*x+2*y+2*z+2*t0+2*u+v-1]: A:=gBasis(F,tdeg(x,y,z,v,t0,u),2,3): print("******************************************eco 8**********************************************"); 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]: A:=gBasis(F,tdeg(x1,x2,x3,x4,x5,x6,x7,x8),2,3): ########################################################### ######################### GBGR over Z_P^n ################# ########################################################### with(padic): with(Groebner): with(combinat): ######################## LM:=proc(f) global t,M; if f=0 then RETURN(0); else RETURN(LeadingMonomial(f,t)) ; end if; end proc: ######################## LC:=proc(f) global t,M; RETURN(LeadingCoefficient(f,t)); end proc: ########################The highest power of p in p-adic representation of 'ex' np:=proc(ex) global t,p,n,M; local C,A,B,exx,npp; exx:=ex mod p^n; C:=convert(evalp(exx,p),list); A:=op(C[1]); B:=A[3][1..-2]; npp:=ordp(exx,p)+nops(B)-1; RETURN(npp); end proc: #######################Division Algorithm in R red:=proc(ex,b) #option trace; global t,p,n,M; local r,q,exx,A,B,npp,landa,C,ordb,ordex; exx:=ex mod p^n; ordex:=ordp(exx,p); ordb:=ordp(b,p); #r:=evalp(exx mod p^(ordb),p); C:=convert(evalp(exx,p),list); A:=op(C[1]); B:=A[3][1..-2]; npp:=ordex+nops(B)-1; if npp>=ordb then B:=[seq(0,i=1..ordex),op(B)]; landa:=solve(op(msolve(simplify(b/p^ordb)*maple=1,p^n))); RETURN(add(B[i+1]*p^(i-ordb),i=ordb..nops(B)-1)*landa); else RETURN(0); end if; end proc: #######################Division in R[X] reduc:=proc(f,L) #option trace; global t,p,n,M; local r,i,flag,b,g,lm,lc; b:=f mod p^n; r := 0; while b<>0 do i := 1; flag := false; lm:=LM(b); lc:=LC(b); while i <= nops(L) and flag = false do if divide(lm, M[L[i]][2]) and np(lc)>= ordp(M[L[i]][3],p) then g:=expand(lm*red(lc,M[L[i]][3])/M[L[i]][2])mod p^n; b := simplify(b-expand(g*M[L[i]][1])) mod p^n; flag := true; else i := i+1; end if; end do; if not flag then r := expand(r+lm*lc) mod p^n; b :=expand(b-lm*lc)mod p^n; end if; end do; RETURN(r); end proc: #####################Groebner Basis over Galois ring Z_p^n gBasis:=proc(F,tord,P,N) #option trace; global t,p,n,M; local G,S1,S2,f,k,r,k1,k2,k12,spol,l,cc,bb,aa1,aa2,num,u,d; cc[1],bb[1]:=kernelopts(cputime,bytesused); t:=tord; p:=P; n:=N; u:=0; d:=0; M:=[seq([f,LM(f),LC(f)],f in F)]; S1:=[seq(i,i=1..nops(F))]; S2:=choose(S1,2); S2:=sort(S2,tidy); G:=S1; while nops(S1)<>0 do f:=S1[1]; S1:=S1[2..-1]; k:=ordp(M[f][3],p); r:=reduc(p^(n-k)*M[f][1],G); if r<>0 then num:=nops(M)+1; S1:=[op(S1),num]; S2:=[op(S2),seq([num,g],g in G)]; G:=[op(G),num]; M:=[op(M),[r,LM(r),LC(r)]]; S2:=sort(S2,tidy); else u:=u+1; end if; while nops(S2)<>0 do f:=S2[1]; S2:=S2[2..-1]; l:=lcm(M[f[1]][2],M[f[2]][2]); d:=max(d,degree(l)); k1:=ordp(M[f[1]][3],p); k2:=ordp(M[f[2]][3],p); k12:=max(k1,k2); aa1:=expand(M[f[1]][3]/p^(k1)); aa2:=expand(M[f[2]][3]/p^(k2)); spol:=expand((l*p^(k12-k1)*solve(op(msolve(aa1*maple=1,p^n)))*M[f[1]][1]/M[f[1]][2])-(l*p^(k12-k2)*solve(op(msolve(aa2*maple=1,p^n)))*M[f[2]][1]/M[f[2]][2])); r:=reduc(spol,G); if r<>0 then num:=nops(M)+1; S1:=[op(S1),num]; S2:=[op(S2),seq([num,g],g in G)]; G:=[op(G),num]; M:=[op(M),[r,LM(r),LC(r)]]; S2:=sort(S2,tidy); else u:=u+1; end if; end do; end do; cc[2],bb[2]:=kernelopts(cputime,bytesused); printf("The time of computation is = %a\n", cc[2]-cc[1]); printf("The memory used of computation is = %a\n", bb[2]-bb[1]); printf("The number of reductions to zero is = %a\n",u); printf("The degree of the Groebner basis is = %a\n", d); printf("The corretness of the algorithm is =%a\n", IsGroebner(F,G)); RETURN([seq(M[i][1],i in G)]); end proc: ############################################ IsGroebner:=proc(F,G) global p,n,t,M; local A,B,k1,k2,k12,aa1,aa2,i,r,f,k,l,spol; for i from 1 to nops(F) do r:=reduc(F[i],G); if r<>0 then RETURN(false); end if; end do; A:=G; B:=choose(G,2); while nops(A)<>0 do f:=A[1]; A:=A[2..-1]; k:=ordp(M[f][3],p); if reduc(p^(n-k)*M[f][1],G)<>0 then RETURN(false); end if; end do; while nops(B)<>0 do f:=B[1]; B:=B[2..-1]; k1:=ordp(M[f[1]][3],p); k2:=ordp(M[f[2]][3],p); k12:=max(k1,k2); l:=lcm(M[f[1]][2],M[f[2]][2]); aa1:=expand(M[f[1]][3]/p^(k1)); aa2:=expand(M[f[2]][3]/p^(k2)); spol:=expand((l*p^(k12-k1)*solve(op(msolve(aa1*maple=1,p^n)))*M[f[1]][1]/M[f[1]][2])-(l*p^(k12-k2)*solve(op(msolve(aa2*maple=1,p^n)))*M[f[2]][1]/M[f[2]][2])); if reduc(spol,G)<>0 then RETURN(false); end if: end do; RETURN(true); end proc: ########################## tidy:=proc(P,Q) #option trace; global M,t,p,n; RETURN(TestOrder(lcm(M[P[1]][2],M[P[2]][2]),lcm(M[Q[1]][2],M[Q[2]][2]),t)); end proc: ##################### #####Examples######## ##################### print("******************************************eco 6**********************************************"); F:=[(x1 + x1*x2 + x2*x3 + x3*x4 + x4*x5)*x6 - 1, (x2 + x1*x3 + x2*x4 + x3*x5)*x6 - 2, (x3 + x1*x4 + x2*x5)*x6 - 3, (x4 + x1*x5)*x6 - 4, x5*x6 - 5, x1 + x2 + x3 + x4 + x5 + 1]: A:=gBasis(F,tdeg(x1,x2,x3,x4,x5,x6),2,3): print("*************************HAAS3*************************"); F := [x^6+w*y^3-y, y^6+z*x^3-x, 36*y^5*x^5-9*x^2*z*w*y^2+3*w*y^2+3*z*x^2-1]: A:=gBasis(F,tdeg(x,y,w,z),2,3): print("******************************************Katsura 5**********************************************"); F:=[2*x^2+2*y^2+2*z^2+2*t0^2+2*u^2+v^2-v, x*y+y*z+2*z*t0+2*t0*u+2*u*v-u, 2*x*z+2*y*t0+2*z*u+u^2+2*t0*v-t0, 2*x*t0+2*y*u+2*t0*u+2*z*v-z, t0^2+2*x*v+2*y*v+2*z*v-y, 2*x+2*y+2*z+2*t0+2*u+v-1]: A:=gBasis(F,tdeg(x,y,z,v,t0,u),2,3): print("******************************************eco 8**********************************************"); 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]: A:=gBasis(F,tdeg(x1,x2,x3,x4,x5,x6,x7,x8),2,3): ########################################################### ################# Improved GBGR over extensions of Z_P^n### ########################################################### with(padic): with(Groebner): with(combinat): ######################## LM:=proc(f) global t,MM; if f=0 then RETURN(0); else RETURN(LeadingMonomial(f,t)) ; end if; end proc: ######################## LC:=proc(f) global t,MM; RETURN(LeadingCoefficient(f,t)); end proc: ########################The highest power of p in p-adic representation of 'ex' np:=proc(ex) global t,p,n,m,MM; local C,A,B,exx,npp; exx:=ex mod p^n; C:=convert(evalp(exx,p),list); A:=op(C[1]); B:=A[3][1..-2]; npp:=ordp(exx,p)+nops(B)-1; RETURN(npp); end proc: #######################Division Algorithm in R red:=proc(ex,b) #option trace; global t,p,n,m,MM,PP,var,ss; local r,q,exx,A,B,npp,landa,C,ordb,ordex; exx:=ex mod p^n; ordex:=ordp(exx,p); ordb:=ordp(b,p); #r:=evalp(exx mod p^(ordb),p); C:=convert(evalp(exx,p),list); A:=op(C[1]); B:=A[3][1..-2]; npp:=ordex+nops(B)-1; if npp>=ordb then B:=[seq(0,i=1..ordex),op(B)]; landa:=solve(op(msolve(simplify(b/p^ordb)*maple=1,p^n))); RETURN(add(B[i+1]*p^(i-ordb),i=ordb..nops(B)-1)*landa); else RETURN(0); end if; end proc: #######################Division in R[X] reduc:=proc(f,L) #option trace; global t,p,n,m,MM,ss,PP,alpha,rr; local r,i,flag,b,g,lm,lc; b:=f mod p^n; r := 0; rr:=0; while b<>0 do i := 1; flag := false; lm:=LM(b); lc:=LC(b); while i <= nops(L) and flag = false do if divide(lm, MM[L[i]][2]) and np(lc)>= ordp(MM[L[i]][3],p) then g:=expand(lm*red(lc,MM[L[i]][3])/MM[L[i]][2])mod p^n; b := simplify(b-expand(g*MM[L[i]][1])) mod p^n; flag := true; else i := i+1; end if; end do; if not flag then rr := expand(rr+lm*lc) mod p^n; b :=expand(b-lm*lc)mod p^n; end if; end do; while rr<>0 do lm:=LM(rr); lc:=LC(rr); flag:=false; if divide(lm, alpha^ss) then rr:= simplify(rr-expand(lm*red(lc,1)/alpha^ss*PP)) mod p^n; flag:=true; end if; if not flag then r := expand(r+lm*lc) mod p^n; rr :=expand(rr-lm*lc)mod p^n; end if; end do; RETURN(r); end proc: #####################Groebner Basis over Galois ring Z_p^n gBasis:=proc(F,tord,P,N,M,var) #option trace; global t,p,n,m,MM,alpha,PP,ss; local G,S1,S2,f,k,r,k1,k2,k12,spol,l,cc,bb,aa1,aa2,num,GG,u,d; cc[1],bb[1]:=kernelopts(cputime,bytesused); alpha:=var; t:=prod(tord,plex(alpha)); p:=P; n:=N; m:=M; u:=0; d:=0; ss:=p^m-1; PP:=alpha^ss-1; MM:=[seq([f,LM(f),LC(f),ordp(LC(f),p)],f in F)]; S1:=[seq(i,i=1..nops(F))]; S2:=[]; #S2:=choose(S1,2); #G:=S1; GG:=S1; G:=[]; while nops(GG)<>0 do f:=GG[1]; GG:=GG[2..-1]; G,S2:=update(G,S2,f); S2:=sort(S2,tidy); end do; while nops(S1)<>0 do f:=S1[1]; S1:=S1[2..-1]; r:=reduc(p^(n-MM[f][4])*MM[f][1],G); if r<>0 then num:=nops(MM)+1; S1:=[op(S1),num]; MM:=[op(MM),[r,LM(r),LC(r),ordp(LC(r),p)]]; G,S2:=update(G,S2,num); S2:=sort(S2,tidy); else u:=u+1; end if; while nops(S2)<>0 do f:=S2[1]; S2:=S2[2..-1]; l:=lcm(MM[f[1]][2],MM[f[2]][2]); d:=max(d,degree(l)); k12:=max(MM[f[1]][4],MM[f[2]][4]); aa1:=expand(MM[f[1]][3]/p^(MM[f[1]][4])); aa2:=expand(MM[f[2]][3]/p^(MM[f[2]][4])); spol:=expand((l*p^(k12-MM[f[1]][4])*solve(op(msolve(aa1*maple=1,p^n)))*MM[f[1]][1]/MM[f[1]][2]mod p^n)-(l*p^(k12-MM[f[2]][4])*solve(op(msolve(aa2*maple=1,p^n)))*MM[f[2]][1]/MM[f[2]][2]mod p^n)); r:=reduc(spol,G); if r<>0 then num:=nops(MM)+1; MM:=[op(MM),[r,LM(r),LC(r),ordp(LC(r),p)]]; G,S2:=update(G,S2,num); S2:=sort(S2,tidy); S1:=[op(S1),num]; else u:=u+1; end if: end do; end do; cc[2],bb[2]:=kernelopts(cputime,bytesused); printf("The time of computation is = %a\n", cc[2]-cc[1]); printf("The memory used of computation is = %a\n", bb[2]-bb[1]); printf("The number of reductions to zero is = %a\n",u); printf("The degree of the Groebner basis is = %a\n", d); printf("The corretness of the algorithm is =%a\n", IsGroebner(F,G)); RETURN([seq(MM[i][1],i in G)]); end proc: ############################################ update:=proc(G,B,f) #option trace; local C,dd,D,c,flag,d,E,b,G1,B1,B2,G2,F,lth,j; global MM,t,p,n,m; G1 := G; B1 := B; C:=[seq([f,g],g in G1)]; D:=[]; while nops(C)<>0 do c:=test(C[1]); C:=C[2..-1]; if gcd(MM[c[1]][2],MM[c[2]][2])=1 and (MM[c[1]][4]=0 or MM[c[2]][4]=0) then D:=[op(D),c]; else flag:=false; for d in C while not flag do dd:={op(d)} minus{f}; if divide(lcm(MM[c[1]][2],MM[c[2]][2]),lcm(MM[d[2]][2],MM[f][2])) and MM[dd[1]][4]<=MM[c[1]][4] #((MM[c[1]][4]=MM[dd[1]][4] and MM[dd[1]][4]>=MM[c[2]][4]) #or(MM[c[1]][4]>=MM[c[2]][4] and MM[c[2]][4]>=MM[dd[1]][4] )) then flag:=true; end if; end do; for d in D while not flag do dd:={op(d)} minus{f}; if divide(lcm(MM[c[1]][2],MM[c[2]][2]),lcm(MM[dd[1]][2],MM[f][2])) and MM[dd[1]][4]<=MM[c[1]][4] #((MM[c[1]][4]=MM[dd[1]][4] and MM[dd[1]][4]>=MM[c[2]][4]) # or (MM[c[1]][4]>=MM[c[2]][4] and MM[c[2]][4]>=MM[dd[1]][4] )) then flag:=true; end if; end do; if flag=false then D:=[op(D),c]; end if; fi: end do; E:=[]; while nops(D)<>0 do d:=D[1]; D:=D[2..-1]; if gcd(MM[d[1]][2],MM[d[2]][2])<>1 or (MM[d[1]][4]<>0 and MM[d[2]][4]<>0) then E:=[op(E),d]; end if; end do; B2:=[]; while nops(B1)<>0 do b:=test(B1[1]); B1:=B1[2..-1]; if not divide(lcm(MM[b[1]][2],MM[b[2]][2]),MM[f][2]) or lcm(MM[f][2],MM[b[1]][2])=lcm(MM[b[1]][2],MM[b[2]][2]) or lcm(MM[f][2],MM[b[2]][2])=lcm(MM[b[1]][2],MM[b[2]][2]) #or ((MM[b[1]][4]<>MM[f][4] or MM[f][4]MM[b[2]][4])) or MM[f][4]>MM[b[1]][4] then B2:=[op(B2),b]; end if; end do; B2:=[op(B2),op(E)]; G2:=[]; while nops(G1)<>0 do j:=G1[1]; G1:=G1[2..-1]; if not (divide(MM[j][2],MM[f][2]) and MM[j][4]>=MM[f][4]) then G2:=[op(G2),j]; end if; end do; G2:=[op(G2),f]; RETURN(G2,B2); end proc: ################################ test:= proc(CC) #option trace; local c; global MM,t,p,n,m; c:=CC; if MM[c[1]][4]> MM[c[2]][4] then RETURN(c); else RETURN([c[2],c[1]]); end if: end proc: ################################ IsGroebner:=proc(F,G) #option trace; global p,n,m,t,MM; local A,B,k1,k2,k12,aa1,aa2,i,r,f,k,l,spol; for i from 1 to nops(F) do r:=reduc(F[i],G); if r<>0 then RETURN(false); end if; end do; A:=G; B:=choose(G,2); while nops(A)<>0 do f:=A[1]; A:=A[2..-1]; k:=ordp(MM[f][3],p); if reduc(p^(n-k)*MM[f][1],G)<>0 then RETURN(false); end if; end do; while nops(B)<>0 do f:=B[1]; B:=B[2..-1]; k1:=ordp(MM[f[1]][3],p); k2:=ordp(MM[f[2]][3],p); k12:=max(k1,k2); l:=lcm(MM[f[1]][2],MM[f[2]][2]); aa1:=expand(MM[f[1]][3]/p^(k1)); aa2:=expand(MM[f[2]][3]/p^(k2)); spol:=expand((l*p^(k12-k1)*solve(op(msolve(aa1*maple=1,p^n)))*MM[f[1]][1]/MM[f[1]][2])-(l*p^(k12-k2)*solve(op(msolve(aa2*maple=1,p^n)))*MM[f[2]][1]/MM[f[2]][2])); if reduc(spol,G)<>0 then RETURN(false); end if: end do; RETURN(true); end proc: ##################### tidy:=proc(P,Q) #option trace: global MM,t,p,m,n: RETURN(TestOrder(lcm(MM[P[1]][2],MM[P[2]][2]),lcm(MM[Q[1]][2],MM[Q[2]][2]),t)); end proc: ##################### #####Examples######## ##################### print("******************************************eco 8**********************************************"); F:=[(x1 + x1*x2 + x2*x3 + x3*x4 + x4*x5 + x5*x6 + x6*x7)*alpha - 1, (x2 + x1*x3 + x2*x4 + x3*x5 + x4*x6 + x5*x7)*alpha - 2, (x3 + x1*x4 + x2*x5 + x3*x6 + x4*x7)*alpha - 3, (x4 + x1*x5 + x2*x6 + x3*x7)*alpha - 4, (x5 + x1*x6 + x2*x7)*alpha - 5, (x6 + x1*x7)*alpha - 6, x7*alpha - 7, x1 + x2 + x3 + x4 + x5 + x6 + x7 + 1]: A:=gBasis(F,tdeg(x1,x2,x3,x4,x5,x6,x7),2,3,2,alpha): print("****************************************Roczen**********************************************"); F := [o+1, k^4+k, h*k, h^4+h, g*k, g*h, g^3+h^3+k^3+1, f*k, f^4+f, alpha*h, alpha*f, f^3*h^3+alpha^3*k^3+alpha^2+f^3+h^3+k^3+1, alpha^3*g+f^3*g+g, alpha, d*h^3+d*k^3+d, d*g, d*f, d*alpha, d^3+alpha^2+f^3+1, alpha^2*g^2+d^2*h^2+c, f^2*g^2+d^2*k^2+b, f^2*h^2+alpha^2*k^2+a]; F:=subs(o=alpha,F): A:= gBasis(F, tdeg(a, b, c, d, f, g, h, k), 2, 3, 2, alpha); ########################################################### ################# GBGR over extensions of Z_P^n ########### ########################################################### with(padic): with(Groebner): with(combinat): ######################## LM:=proc(f) global t,MM; if f=0 then RETURN(0); else RETURN(LeadingMonomial(f,t)) ; end if; end proc: ######################## LC:=proc(f) global t,MM; RETURN(LeadingCoefficient(f,t)); end proc: ########################The highest power of p in p-adic representation of 'ex' np:=proc(ex) global t,p,m,n,MM,ss,PP,alpha; local C,A,B,exx,npp; exx:=ex mod p^n; C:=convert(evalp(exx,p),list); A:=op(C[1]); B:=A[3][1..-2]; npp:=ordp(exx,p)+nops(B)-1; RETURN(npp); end proc: #######################Division Algorithm in R red:=proc(ex,b) #option trace; global t,p,n,m,MM,PP,alpha,ss; local r,q,exx,A,B,npp,landa,C,ordb,ordex; exx:=ex mod p^n; ordex:=ordp(exx,p); ordb:=ordp(b,p); #r:=evalp(exx mod p^(ordb),p); C:=convert(evalp(exx,p),list); A:=op(C[1]); B:=A[3][1..-2]; npp:=ordex+nops(B)-1; if npp>=ordb then B:=[seq(0,i=1..ordex),op(B)]; landa:=solve(op(msolve(simplify(b/p^ordb)*maple=1,p^n))); RETURN(add(B[i+1]*p^(i-ordb),i=ordb..nops(B)-1)*landa); else RETURN(0); end if; end proc: #######################Division in R[X] reduc:=proc(f,L) #option trace; global t,p,n,m,MM,ss,PP,alpha,rr; local r,i,flag,b,g,lm,lc; b:=f mod p^n; r := 0; rr:=0; while b<>0 do i := 1; flag := false; lm:=LM(b); lc:=LC(b); while i <= nops(L) and flag = false do if divide(lm, MM[L[i]][2]) and np(lc)>= ordp(MM[L[i]][3],p) then g:=expand(lm*red(lc,MM[L[i]][3])/MM[L[i]][2])mod p^n; b := simplify(b-expand(g*MM[L[i]][1])) mod p^n; flag := true; else i := i+1; end if; end do; if not flag then rr := expand(rr+lm*lc) mod p^n; b :=expand(b-lm*lc)mod p^n; end if; end do; while rr<>0 do lm:=LM(rr); lc:=LC(rr); flag:=false; if divide(lm, alpha^ss) then rr:= simplify(rr-expand(lm*red(lc,1)/alpha^ss*PP)) mod p^n; flag:=true; end if; if not flag then r := expand(r+lm*lc) mod p^n; rr :=expand(rr-lm*lc)mod p^n; end if; end do; RETURN(r); end proc: #####################Groebner Basis over Galois ring Z_p^n gBasis:=proc(F,tord,P,N,M,var) #option trace; global t,p,n,m,MM,ss,alpha,PP; local G,S1,S2,f,k,r,k1,k2,k12,spol,l,cc,bb,aa1,aa2,num,u,d; cc[1],bb[1]:=kernelopts(cputime,bytesused); alpha:=var; t:=prod(tord,plex(alpha)); p:=P; n:=N; m:=M; u:=0; d:=0; ss:=p^m-1; PP:=alpha^ss-1; MM:=[seq([f,LM(f),LC(f)],f in F)]; S1:=[seq(i,i=1..nops(F))]; S2:=choose(S1,2); S2:=sort(S2,tidy); G:=S1; while nops(S1)<>0 do f:=S1[1]; S1:=S1[2..-1]; k:=ordp(MM[f][3],p); r:=reduc(p^(n-k)*MM[f][1],G); if r<>0 then num:=nops(MM)+1; S1:=[op(S1),num]; S2:=[op(S2),seq([num,g],g in G)]; G:=[op(G),num]; MM:=[op(MM),[r,LM(r),LC(r)]]; S2:=sort(S2,tidy); else u:=u+1; end if; while nops(S2)<>0 do f:=S2[1]; S2:=S2[2..-1]; l:=lcm(MM[f[1]][2],MM[f[2]][2]); d:=max(d,degree(l)); k1:=ordp(MM[f[1]][3],p); k2:=ordp(MM[f[2]][3],p); k12:=max(k1,k2); aa1:=expand(MM[f[1]][3]/p^(k1)); aa2:=expand(MM[f[2]][3]/p^(k2)); spol:=expand((l*p^(k12-k1)*solve(op(msolve(aa1*maple=1,p^n)))*MM[f[1]][1]/MM[f[1]][2])-(l*p^(k12-k2)*solve(op(msolve(aa2*maple=1,p^n)))*MM[f[2]][1]/MM[f[2]][2])); r:=reduc(spol,G); if r<>0 then num:=nops(MM)+1; S1:=[op(S1),num]; S2:=[op(S2),seq([num,g],g in G)]; G:=[op(G),num]; MM:=[op(MM),[r,LM(r),LC(r)]]; S2:=sort(S2,tidy); else u:=u+1; end if; end do; end do; cc[2],bb[2]:=kernelopts(cputime,bytesused); printf("The time of computation is = %a\n", cc[2]-cc[1]); printf("The memory used of computation is = %a\n", bb[2]-bb[1]); printf("The number of reductions to zero is = %a\n",u); printf("The degree of the Groebner basis is = %a\n", d); printf("The corretness of the algorithm is =%a\n", IsGroebner(F,G)); RETURN([seq(MM[i][1],i in G)]); end proc: ############################################ IsGroebner:=proc(F,G) #option trace; global p,n,t,MM,ss; local A,B,k1,k2,k12,aa1,aa2,i,r,f,k,l,spol; for i from 1 to nops(F) do r:=reduc(F[i],G); if r<>0 then RETURN(false); end if; end do; A:=G; B:=choose(G,2); while nops(A)<>0 do f:=A[1]; A:=A[2..-1]; k:=ordp(MM[f][3],p); if reduc(p^(n-k)*MM[f][1],G)<>0 then RETURN(false); end if; end do; while nops(B)<>0 do f:=B[1]; B:=B[2..-1]; k1:=ordp(MM[f[1]][3],p); k2:=ordp(MM[f[2]][3],p); k12:=max(k1,k2); l:=lcm(MM[f[1]][2],MM[f[2]][2]); aa1:=expand(MM[f[1]][3]/p^(k1)); aa2:=expand(MM[f[2]][3]/p^(k2)); spol:=expand((l*p^(k12-k1)*solve(op(msolve(aa1*maple=1,p^n)))*MM[f[1]][1]/MM[f[1]][2])-(l*p^(k12-k2)*solve(op(msolve(aa2*maple=1,p^n)))*MM[f[2]][1]/MM[f[2]][2])); if reduc(spol,G)<>0 then RETURN(false); end if: end do; RETURN(true); end proc: ########################## tidy:=proc(P,Q) #option trace; global MM,t,p,n,m,ss; RETURN(TestOrder(lcm(MM[P[1]][2],M[P[2]][2]),lcm(MM[Q[1]][2],MM[Q[2]][2]),t)); end proc: ##################### #####Examples######## ##################### print("******************************************eco 8**********************************************"); F:=[(x1 + x1*x2 + x2*x3 + x3*x4 + x4*x5 + x5*x6 + x6*x7)*alpha - 1, (x2 + x1*x3 + x2*x4 + x3*x5 + x4*x6 + x5*x7)*alpha - 2, (x3 + x1*x4 + x2*x5 + x3*x6 + x4*x7)*alpha - 3, (x4 + x1*x5 + x2*x6 + x3*x7)*alpha - 4, (x5 + x1*x6 + x2*x7)*alpha - 5, (x6 + x1*x7)*alpha - 6, x7*alpha - 7, x1 + x2 + x3 + x4 + x5 + x6 + x7 + 1]: A:=gBasis(F,tdeg(x1,x2,x3,x4,x5,x6,x7),2,3,2,alpha): print("****************************************Roczen**********************************************"); F := [o+1, k^4+k, h*k, h^4+h, g*k, g*h, g^3+h^3+k^3+1, f*k, f^4+f, alpha*h, alpha*f, f^3*h^3+alpha^3*k^3+alpha^2+f^3+h^3+k^3+1, alpha^3*g+f^3*g+g, alpha, d*h^3+d*k^3+d, d*g, d*f, d*alpha, d^3+alpha^2+f^3+1, alpha^2*g^2+d^2*h^2+c, f^2*g^2+d^2*k^2+b, f^2*h^2+alpha^2*k^2+a]; F:=subs(o=alpha,F): A:= gBasis(F, tdeg(a, b, c, d, f, g, h, k), 2, 3, 2, alpha);