# ================================================================================================================================= # # Description : Computes the border basis of a zero-dimensional ideal and the corresponding order ideal # # The main algorithms are presented in a paper authored by: Amir Hashemi, Martin Kreuzer, and Samira Pourkhajouei # # ================================================================================================================================= # # Authors Contact: # Amir Hashemi # # Martin Kreuzer # # Samira Pourkhajouei # # ================================================================================================================================= # with(PolynomialIdeals): with(Groebner): #<----------------------------------------------------------------------------- firstborder := proc (O, var) return(`minus`({seq(seq(i*j, j in var), i in O)}, {op(O)})); end proc: #<----------------------------------------------------------------------------- LM := proc (f, T) if f = 0 then return(0); else return(LeadingMonomial(f, T)); end if: end proc: #<----------------------------------------------------------------------------- LC := proc (f, T) if f = 0 then return(0); else return(LeadingCoefficient(f, T)); end if: end proc: #<----------------------------------------------------------------------------- LN := proc (f, L, T) local m, g; m := LM(f, T); g := expand(f-m); return(expand(m+NormalForm(g, L, T))); end proc: #<----------------------------------------------------------------------------- supp := proc (g, T) local N, f, A; N := NULL; f := g; while f <> 0 do A := LeadingTerm(f, T); f := f-A[1]*A[2]; N := N, A[2]; end do; return (N); end proc: #<----------------------------------------------------------------------------- Finalred := proc (VV, T, O, var) local V, VR, v, H, F, B, i; V := VV; VR := NULL; V := sort(V, proc (a, b) options operator, arrow; TestOrder(LM(a, T), LM(b, T), T) end proc); while V <> [] do v := V[1]; V := V[2 .. -1]; H := `minus`({supp(v, T)}, {LM(v, T), op(O)}); if nops(H) = 0 and v <> 0 then VR := VR, v/LC(v, T); else v := LN(v, [VR], T); if v <> 0 then VR := VR, v/LC(v, T); end if; end if; end do; F := firstborder(O, var); B := NULL; for i in [VR] do if `subset`({LM(i, T)}, F) then B := B, i; end if; end do; return [B]; end proc: #<----------------------------------------------------------------------------- Sher := proc (p, q, T, F) local i, j, a, b; i := p[5][2]; j := q[5][2]; a := p[5][1]*F[i][3]; b := q[5][1]*F[j][3]; if a <> b then return(TestOrder(a, b, T)); else return(evalb(i < j)); end if; end proc: #<----------------------------------------------------------------------------- Shersort := proc (p, q, T, F) local i, j, a, b; i := p[5][2]; j := q[5][2]; a := p[5][1]*F[i][3]; b := q[5][1]*F[j][3]; if a <> b then return(TestOrder(a, b, T)); else if i=j then return(TestOrder(p[3],q[3],T)); else return(evalb(i u2[2] then return(false); end if; if divide(u1[1], u2[1], 'q') then t := q*p2[3]; if TestOrder(t, p1[3], T) and t <> p1[3] then return(true); end if; end if; return(false); end proc: #<----------------------------------------------------------------------------- Coverlist := proc (g, L, T) local i; i := 1; while i <= nops(L) do if Cover(g, L[i], T) then return (true); else i := i+1; end if; end do; return (false); end proc: #<----------------------------------------------------------------------------- lem12 := proc (L, G, T, var, SS, d,n1) local V, W, n, Sy, H, f, rrr, j, Y, i, Anc, flag1, flag2, flag3, c; global redzero, NumofAnc, coverV, cov, Fideal,m,numpairs,samesig,stud,numchange; V := L; W := NULL; n := 0; Sy := op(SS); H := sort(G, proc (a, b) options operator, arrow; Shersort(a, b, T, Fideal) end proc); numpairs:=numpairs+nops(G); while H <> [] do f := H[1]; rrr := f; j := 2; while j<= nops(H) and H[j][5] = f[5] do samesig:=samesig+1; j := j+1; end do; H := H[j.. -1]; Y := f[2]; i := 1; Anc:=f[4]; if not Coverlist(f, V, T) then if not member(Anc, [Sy]) then flag1:=false; flag2:=true; flag3:=false;stud:=stud+1; while f[1] <> 0 and i <= nops(V) and flag2=true do if f[3] = V[i][3] then if Sher(V[i], f, T, Fideal) then c:=LC(f[1], T); f[1] := expand(f[1]-c*V[i][1]); f := [f[1], f[2], LM(f[1], T), f[4], f[5],f[6]]; flag1:=true; i := 1; elif V[i][2]=f[2] and evalb(V[i][6]/f[6]<>1) then c:=LC(f[1], T); f[1] := expand(f[1]-c*V[i][1]); f := [f[1], f[2], LM(f[1], T), f[4], f[5],expand(f[6]-c*V[i][6])]; flag1:=true; i := 1; else numchange:=numchange+1; H := [V[i], op(H)]; f := [expand(f[1]/LC(f[1], T)), op(f[2..6])]; V := subsop(i = f, V); flag2:=false; end if; else i := i+1; end if; end do; if degree(f[1]) <> d+1 then Sy := Sy, f[4]; end if: if flag2=true then if f[1] <> 0 and flag1 = true then m := m+1; V := [op(V), [expand(f[1]/LC(f[1], T)), Y, LM(f[1],T), Z[m], f[5],expand(f[6]/LC(f[1], T))]]; W := W, V[-1]; elif flag1 = false then V := [op(V), [expand(f[1]/LC(f[1], T)), Y, LM(f[1],T), f[4],f[5],expand(f[6]/LC(f[1], T))]]; W := W, V[-1]; else redzero := redzero+1; end if; end if: else NumofAnc := NumofAnc+1; end if; else coverV := coverV+1; end if; end do; return([W], [Sy],V[1..n1]); end proc: #<----------------------------------------------------------------------------- posoper := proc (LL, var, T, FF) local L, C, CC, HH, aa, Aa, Bb, i; L := LL; C := NULL; CC := NULL; HH := [seq(FF[i][1], i = 1 .. nops(FF))]; aa := [seq(seq([op(expand(v*l[1 .. 4])), [v*l[5][1], l[5][2]],v*l[6]], l = L), v = var)]; aa := sort(aa, proc (a, b) options operator, arrow; Shersort(a, b, T, Fideal) end proc); Aa := [seq(aa[i][1], i = 1 .. nops(aa))]; Bb := `minus`({op(Aa)}, {op(HH)}); for i in Bb do member(i, Aa, 'q'); C := C, aa[q]; end do; return [C]; end proc: #<----------------------------------------------------------------------------- deg := proc (f, d) if degree(f[1]) <= d then return(true); else return(false); end if; end proc: #<----------------------------------------------------------------------------- degg := proc (f, d) if degree(f[1]) = d then return(true); else return(false); end if; end proc: #<----------------------------------------------------------------------------- stable := proc (V1, T, TT, var, d, qqq) local V, W, n, J, H, WW, qq, NN, Jj, j; global flag3,coverV; V := V1; W := V; n := nops(W); qq := qqq; NN := V; while 0 < n do J := posoper(NN, var, T, V); J := select(degg, J, d+1); if flag3 = false then H := J; flag3 := true; else H := [op({op(posoper(W, var, T, V)), op(J)})]; end if; WW := lem12(V, H, T, var, qq, d,nops(V)); W := select(deg, WW[1], d); n := nops(W); if n <> 0 then NN:=WW[3]; V := [op(NN), op(W)]; qq := WW[2]; end if; end do; return (V, S, WW[1]); end proc: #<----------------------------------------------------------------------------- CoupledBorderBasis := proc (va, T, var) local O, F, d, L, n, N, M, B, i, U, V, firsttime, firstbytes, VV, S, syz, Fi, secondtime, secondbytes, ti, Ss, sy,V2; global redzero, NumofAnc, coverV, flag3, Fideal,m,numpairs,samesig,stud,numchange; firsttime, firstbytes := kernelopts(cputime, bytesused); VV := va; Ss := NULL; coverV := 0; NumofAnc := 0; redzero := 0; numpairs:=0;samesig:=0;stud:=0;numchange:=0; flag3:= true; if not IsZeroDimensional(VV, var) then ERROR("The ideal is not zero dimensional"); else d := max([seq(degree(i), i in VV)]); VV := [seq([VV[i], e[i], LM(VV[i], T), Z[i], [1, i], e[i]], i = 1 .. nops(VV))]; Fideal := VV; m:=nops(VV); L := [op(randpoly(var, degree = d, dense, coeffs = proc () 1 end proc))]; V, syz,V2 := lem12([], VV, T, var, [Ss], d,m); U, sy, S := stable(V2, T, TT, var, d, []); O := `minus`({op(L)}, {seq(v[3], v = U)}); F := firstborder(O, var); while not `subset`(F, {op(L)}) do d := d+1; U := [op({op(U), op(S)})]; flag3 := false; U, sy, S := stable(U, T, TT, var, d, []); L := [op(randpoly(var, degree = d, dense, coeffs = proc () 1 end proc))]; O := `minus`({op(L)}, {seq(v[3], v = U)}); F := firstborder(O, var); end do; Fi := {op(Finalred([seq(U[i][1], i = 1 .. nops(U))], T, O, var))}; end if; secondtime, secondbytes := kernelopts(cputime, bytesused); ti := [secondtime-firsttime, secondbytes-firstbytes]; printf("%-1s %1s %1s %1s: %3a %3a\n", The, cpu, time, is, ti[1], sec); printf("%-1s %1s %1s: %3a %3a\n", The, used, memory, ti[2], bytes); printf("%-1s %1s %1s %1s: %3a\n", The, number, of, Pairs, numpairs); printf("%-1s %1s %1s %1s: %3a\n", The, number, of, Treatedpairs, stud); printf("%-1s %1s %1s %1s: %3a\n", The, number, of, Covercriterion, coverV+samesig); printf("%-1s %1s %1s %1s: %3a\n", The, number, of, Anccriterion, NumofAnc); printf("%-1s %1s %1s %1s %1s: %3a \n", The, number, of, zero, reductions, redzero): return(Fi,O): end proc: print("####################--E.1 "); #F:=CoupledBorderBasis([y^4 + x*y^2*z + x^2-2*x*y + y^2 + z^2, -x^3*y^2+x*y*z^3 + y^4 + x*y^2*z-2*x*y, x*y^4 + y*z^4-2*x^2*y-3],tdeg(x,y,z),[x,y,z]); print("####################--E.2 "); #F:=CoupledBorderBasis([2*t^2 + u^2 + 2*x^2 + 2*y^2 + 2*z^2-u, 2*t*u + x*y + 2*t*z + 2*y*z-t, t^2 + 2*t*y + 2*u*z + 2*x*z-z, 2*t*x + 2*u*y + 2*t*z-y, 2*t + u + 2*x + 2*y + 2*z-1],tdeg(x,y,z,t,u),[x,y,z,t,u]); print("####################--E.3 "); #F:=CoupledBorderBasis([x+3*x*y^3+y^4+y*z^2, -x^2*z+2*y^3*z+z^2+2*y*z^2+3*x*y*z^2, 3*x^3+x*y^2+y*z^2-z*x*z^3],tdeg(x,y,z),[x,y,z]); print("####################--E.4 "); F:=CoupledBorderBasis([x^2+y^4+x^3*z+y*z-2*x*z^3, -x^2*y^2-y^3*z-z^3-3*y*z^3, y^4-x^2*z+2*y^2*z-2*x*y*z^2],tdeg(x,y,z),[x,y,z]); print("####################--E.5 "); #F:=CoupledBorderBasis([2*t*x*y+y^2*z-2*x-z, t^2*x+2*t*y*z-x-2*z, 4*t*x^2*y+2*t*y^3-x^3*z+4*x*y^2*z-10*t*y+4*x^2+4*x*z-10*y^2+2, 2*t^3*y+4*t^2*x*z+4*t*y*z^2-x*z^3-10*t^2-10*t*y+4*x*z+4*z^2+2],tdeg(x,y,z,t),[x,y,z,t]); print("####################--E.6 "); #F:=CoupledBorderBasis([y^4+x*y^2*z+x^2-2*x*y+y^2+z^2, y^4*x+y*z^4-2*x^2*y-3, -x^3*y^2+x*y*z^3+y^4+x*y^2*z-2*x*y],tdeg(x,y,z),[x,y,z]); print("####################--E.7 "); #F:=CoupledBorderBasis([x^7-y-3*z, x*y^5-5057*z^2-2, y*z^6-x-z+14],tdeg(x,y,z),[x,y,z]); print("####################--E.8 "); #F:=CoupledBorderBasis([w^5-11*w^4+41*w^3-61*w^2+30*w, 7*w^4-74*w^3+257*w^2-286*w+24*x-144, -59*w^4+614*w^3-1909*w^2+1594*w+120*y-480,107*w^4-962*w^3+2497*w^2-2002*w+120*z-120],tdeg(x,y,z,w),[x,y,z,w]); print("####################--E.9 "); #F:=CoupledBorderBasis([x^4+83*x^3+73*y^2-85*z^2-427*t, y^3-x,z^3+z-t, t^3-324*z^2+94*y^2+76*x],tdeg(x,y,z,t),[x,y,z,t]); print("####################--E.10 "); #F:=CoupledBorderBasis([x^2*y^2+x^2*y, y^4+2*y^3+y^2, x^3-x*y^2-x*y],tdeg(x,y),[x,y]); print("####################--E.11 "); #F:=CoupledBorderBasis([x^2*y*z + x*y^2*z + x*y*z^2 + x*y*z + x*y + x*z + y*z, x^2*y^2*z + x*y^2*z^2 + x^2*y*z + x*y*z + y*z + x + z, x^2*y^2*z^2 + x^2*y^2*z + x*y^2*z + x*y*z + x*z + z + 1],tdeg(x,y,z),[x,y,z]); print("####################--E.12 "); #F:=CoupledBorderBasis([x^4+83*x^3+73*y^2-85*z^2-437*t, y^3-z-t, z^3+z-t, t^4-12*z^2+77*y^2+15*x],tdeg(x,y,z,t),[x,y,z,t]);