comphp = (m,J) -> (R:=ring(J); N:= numgens ring(J); s:=apply(N,i->0); L:= flatten entries basis(m,R/J); for i from 0 to #L-1 do s = s + sum(exponents(L_i)); return s ); subhp = (m,I) -> ( N:= numgens ring(I); totdeg:= ((m+N-1)!*m / (m!*N!)); st:=comphp(m,I); apply(N, k -> totdeg - st_k)); R=QQ[a..l]; I = ideal({-k^2+j*l,-i*k+h*l,-i*j+h*k,-h*k+g*l,-h*j+g*k,-h^2+g*i,-g*k+f*l,-g*j+f*k,-g*h+f*i,-g^2+f*h,-f*k+e*l,-f*j+e*k,-f*h+e*i,-f*g+e*h,-f^2+e*g,-e*k+d*l,-e*j+d*k,-e*h+d*i,-e*g+d*h,-e*f+d*g,-e^2+d*f,-d*k+c*l,-d*j+c*k,-d*h+c*i,-d*g+c*h,-d*f+c*g,-d*e+c*f,-d^2+c*e,-c*k+b*l,-c*j+b*k,-c*h+b*i,-c*g+b*h,-c*f+b*g,-c*e+b*f,-c*d+b*e,-c^2+b*d,-b*k+a*l,-b*j+a*k,-b*h+a*i,-b*g+a*h,-b*f+a*g,-b*e+a*f,-b*d+a*e,-b*c+a*d,-b^2+a*c, j^2-d*i+a^2, j*k -e*i+a*b, k^2-f*i+a*c, k*l - g*i + a*d, l^2 - h*i +a*e}); wts={{-20, -24, -38, -2, -40, -31, -2, 28, 8, 10, 2, 2}, {20, 24, 38, 2, 40, 31, 2, -28, -8, -10, -2, -2}, {-6, 20, -26, 24, -33, -17, 3, 26, 39, -38, -7, 2}, {6, -20, 26, -24, 33, 17, -3, -26, -39, 38, 7, -2}, {34, -11, -49, 39, 33, 45, -39, 50, 9, 48, -40, 29}, {-34, 11, 49, -39, -33, -45, 39, -50, -9, -48, 40, -29}, {-43, 19, 14, -47, -22, 50, 27, -50, 27, 30, -23, -31}, {43, -19, -14, 47, 22, -50, -27, 50, -27, -30, 23, 31}, {-42, -20, 20, -34, -10, -50, 32, 27, 19, -32, -5, -8}, {42, 20, -20, 34, 10, 50, -32, -27, -19, 32, 5, 8}, {45, 28, 24, 21, -19, 23, 12, 26, -24, 20, 18, 11}, {-45, -28, -24, -21, 19, -23, -12, -26, 24, -20, -18, -11}, {7, 24, -50, 39, -24, 19, 14, -32, 3, -34, 17, -14}, {-7, -24, 50, -39, 24, -19, -14, 32, -3, 34, -17, 14}, {41, -14, -10, 31, -4, 34, -40, -6, -47, 11, -7, -10}, {-41, 14, 10, -31, 4, -34, 40, 6, 47, -11, 7, 10}, {-34, -21, 42, 50, -50, -10, 32, -25, -42, -28, 50, -28}, {34, 21, -42, -50, 50, 10, -32, 25, 42, 28, -50, 28}, {-44, 22, 4, -12, -23, -19, 5, 18, -5, 40, -18, -45}, {44, -22, -4, 12, 23, 19, -5, -18, 5, -40, 18, 45}, {24, -17, 0, 49, -37, 27, -47, -50, 21, 5, -16, 13}, {-24, 17, 0, -49, 37, -27, 47, 50, -21, -5, 16, -13}, {-19, -47, -21, 9, 23, -29, -46, 45, 7, 12, -42, -37}, {19, 47, 21, -9, -23, 29, 46, -45, -7, -12, 42, 37}, {-8, 32, 19, -22, -20, -47, -12, -15, -26, -10, -33, -16}, {8, -32, -19, 22, 20, 47, 12, 15, 26, 10, 33, 16}, {16, -49, -19, -16, 31, 41, 13, -35, -31, -40, -16, -2}, {-16, 49, 19, 16, -31, -41, -13, 35, 31, 40, 16, 2}, {48, -43, 1, 44, -20, 24, 44, -37, -13, -23, -28, -30}, {-48, 43, -1, -44, 20, -24, -44, 37, 13, 23, 28, 30}, {-13, 37, -50, 0, 4, -48, -4, 5, -34, -30, 33, 1}, {13, -37, 50, 0, -4, 48, 4, -5, 34, 30, -33, -1}, {-28, 50, -44, 36, -31, -16, -17, -42, 15, 48, 4, 25}, {28, -50, 44, -36, 31, 16, 17, 42, -15, -48, -4, -25}, {20, -22, 20, 34, 34, -21, 29, 15, 46, -33, 14, 11}, {-20, 22, -20, -34, -34, 21, -29, -15, -46, 33, -14, -11}, {5, -21, 45, -40, 27, -3, 49, -14, 27, -16, -31, -2}, {-5, 21, -45, 40, -27, 3, -49, 14, -27, 16, 31, 2}, {-1, 35, -33, 19, 29, -41, 17, 19, -24, 31, -23, -10}, {1, -35, 33, -19, -29, 41, -17, -19, 24, -31, 23, 10}, {-42, 27, 50, 35, -12, -44, -6, 43, -33, -40, 4, -20}, {42, -27, -50, -35, 12, 44, 6, -43, 33, 40, -4, 20}, {21, -48, -1, 50, 27, -42, 42, -38, 43, -18, -34, -28}, {-21, 48, 1, -50, -27, 42, -42, 38, -43, 18, 34, 28}, {-43, -33, 46, 6, -6, -10, 10, -15, 25, 49, 46, -3}, {43, 33, -46, -6, 6, 10, -10, 15, -25, -49, -46, 3}, {32, 47, 37, 2, -29, 2, 35, 50, -8, 41, 46, -19}, {-32, -47, -37, -2, 29, -2, -35, -50, 8, -41, -46, 19}}; --I checked: the 48 initial ideals associated to these weights work for m up to 12, also m=50 and m=117 clearDenominators = (w) -> ( denom:=product apply(#w, k-> if class w_k ===ZZ then 1 else denominator(w_k)); apply(#w, k-> lift(denom*(w_k),ZZ)) ); inWId = (I,w) -> ( R:= ring I; K:=coefficientRing R; n:=numgens R; Sw := K[gens R, Weights => clearDenominators(w), MonomialOrder => GLex, Global=>false]; W := map(Sw,R,vars Sw); inwI:= ideal leadTerm W(I); gensinwI := gens(inwI); V:= map(R,Sw, vars R); L:= apply(numColumns(gensinwI), i-> V(gensinwI_(0,i)) ); return L); urinids = apply(#wts, i -> inWId(I,wts_i) ); printPt = (L) -> ( str:= "1"; for j from 0 to #L-1 do str = concatenate(str," ",toString L_j); return str ); M2ToPolymakeV = (points) -> ( polymakeinput := concatenate("POINTS",newline); for i from 0 to #points - 1 do ( polymakeinput = concatenate(polymakeinput,printPt(points_i),newline)); return polymakeinput ) createPolymakeInputFile = (points,fn) -> ( f := openOut fn; f << M2ToPolymakeV(points); f < ( createPolymakeInputFile(Q,pmfn); polymakesession := concatenate("!polymake ", pmfn," VERTICES"); polymakesession << closeOut; st := get polymakesession; augpoly := prepend(P,Q); createPolymakeInputFile(augpoly,augpmfn); polymakesession = concatenate("!polymake ", augpmfn," VERTICES"); polymakesession << closeOut; augst := get polymakesession; set polymakeVToM2(st) === set polymakeVToM2(augst)) polymakeVToM2 = (st) -> ( p := concatenate("VERTICES",concatenate(newline,"1 ")); st = replace(p,"{{",st); p = concatenate(newline,"1 "); st = replace(p,"},{",st); st = replace(" ",", ",st); st = concatenate(st,"}}"); return value st ) --winids ={}; --for i from 0 to #inids-1 do ( --r=random(0,9); --if r <=8 then winids = append(winids,inids_i); --) checkm = (mm,winids) -> ( mpts={}; for i from 0 to #winids -1 do ( mpts = append(mpts, subhp(mm, ideal(winids_i)))); bary = (sum (mpts_0)) / (#(mpts_0) ) ; bary = apply(#(mpts_0), k-> bary); mpts=prepend(bary,mpts); M2ToPolymakeV(mpts) ) showsStability = (mm,inids) -> ( mpts:={}; for i from 0 to #inids -1 do ( mpts = append(mpts, subhp(mm, ideal(inids_i)))); pmfn := concatenate("w",toString mm,".poly"); augpmfn := concatenate("a",toString m,".poly"); polymakesession:=""; bary:={}; bary = (sum (mpts_0)) / (#(mpts_0) ) ; bary = apply(#(mpts_0), k-> bary); bool:= isPInQ(bary,mpts,pmfn,augpmfn); return bool );