4.添加する元の定義式,および,5.分解体の相対定義式
取り敢えず,コードと例を記します.解説はまた後日.
load("grobner")$ factor2list(f0):=block([f:num(f0)],if op(f)="-" then args(-f) elseif op(f)="*" then args(f) else [f])$ rrem(S,T):=block([U:S],map(lambda([s],U:remainder(U,s[1],s[2])),T),U)$ RR6(csGG):=block([],[cs1,cs2,cs3]:csGG,kill(w),DA0:DA,Dws:[[DA,A]],DP:aiA:[], for i:1 thru length(cs3) do (push([DA0,A],DP), a[i]:concat(a,i),w[i]:concat(w,i), /* w[i] with A */ Dw:rat((w[i]^(pp:cs3[i])-1)/(w[i]-1)), Dwf:factor2list(factor(Dw,DA))[1], if (degDwf:hipow(Dwf,w[i]))=1 then (w[i]:rhs(solve(Dwf,w[i])[1]), if pp>2 then printn(concat("PROU_",pp," is a member."))) else (push([Dwf,w[i]],Dws),push([Dwf,w[i]],DP)), /* non-zero aix and ai */ tellrat(DA),algebraic:on, T:cs1[i+1],for g0 in cs1[i] while member(g:g0,T) do 0, LRx:makelist(apply("*",makelist(x-assoc(t,GGRS),t,T:map(lambda([u],mul(g,u)),T))),j,1,pp), printn(LRx), algebraic:off,untellrat(A), ai:0,for cnt:1 while ai=0 do (CNT:cnt,aix:rrem(sum((w[i]^mod(cnt*j,pp)*LRx[j]),j,1,pp),append(Dws,DP)), ai:if aix=0 then 0 else coeff(aix,x,hipow(aix,x)), printn([[cnt],ai])), /* w[i] with a[1],w[1],...,a[i-1],w[i-1] */ if degDwf=1 then w[i]:rrem(w[i],DP) else (pop(DP),push([Dwf:poly_normalize(rrem(Dwf,DP),[w[i]]),w[i]],DP)), /* Lagrange Resolvent */ LR[1]:aix,for cnt:2 thru pp do (LR[cnt]:rrem(sum(w[i]^mod(CNT*cnt*j,pp)*LRx[j],j,1,pp),DP), printn(concat("LR_",cnt)),printn(LR[cnt])), F:rrem(sum(a[i]^(j-1)*ai^(pp-j)*LR[j],j,1,pp),DP), F:subst(x=A,F),printn("F:"),printn(F), /* def. of a[i] */ aipp:rrem(ai^pp,DP)-a[i]^pp, /* reduction for F */ DP:delete([DA0,A],DP),fDP:map(first,DP),sDP:map(second,DP), GR:poly_grobner(append([F,aipp],fDP),append([A,a[i]],sDP)), printn("GR:"),printn(GR), /* monic rather than primitive */ a1n:num(rat(aipp)), na1n:ifactors(abs(poly_content(subst(a[i]=0,a1n),sDP))), na1n:apply("*",map(lambda([s],s[1]^floor(s[2]/cs3[i])),na1n)), da1n:ifactors(abs(coeff(a1n,a[i],cs3[i]))), da1n:apply("*",map(lambda([s],s[1]^ceiling(s[2]/cs3[i])),da1n)), printn(na1n/da1n), a1n:poly_normalize(subst(a[i]=na1n/da1n*a[i],a1n),[a[i]]), push([a1n,a[i]],DP), push([a[i]-da1n/na1n*ai,a[i]],aiA), DA0:sublist(GR,lambda([s],numberp(coeff(s,A,deg:hipow(s,A))) and deg<hipow(DA0,A)))[1], DA0:poly_normalize(subst(a[i]=na1n/da1n*a[i],DA0),[A]), printn([3,DA0,DP]) ), rr2:[solve(DA0,A)[1],DP], append([[DA0,A]],DP))$
実行例.p の各根のリスト RA は長いのでプリントしていません.
(%i24) for i:1 thru 15 do print([p:PL[i],mp(p),RR6(cs(nGG(DA)))])$ [x^2-2,A^2-8,[[2*a1+A,A],[a1^2-2,a1]]] [x^3-3*x-1,A^3-3*A-1,[[a1^2*w1+a1+A,A],[w1+a1^3+1,a1],[w1^2+w1+1,w1]]] [x^4-2,A^8+28*A^4+2500,[[a3+2*a2+A,A],[a3^2-a1,a3],[a2^2+a1,a2],[a1^2-2,a1]]] [x^4+x^2-1,A^8+10*A^6+47*A^4+110*A^2+841, [[(a3+2*a2)/2+A,A],[a3^2-2*a1+2,a3],[a2^2+2*a1+2,a2],[a1^2-5,a1]]] [x^4-2*x^3+2*x^2+2,A^12+4*A^10+24*A^8+48*A^6-560*A^4+3136, [[a3/21+A,A],[(-126*a1^2*w1)+a3^2+42*a2-84*a1^2+294*a1+294,a3], [(42*a1^2+588*a1)*w1+a2^2-168*a1^2+294*a1+1323,a2],[(-21*w1)+a1^3-7,a1], [w1^2+w1+1,w1]]] [x^4+2*x^3+3*x^2+4*x+5, A^24+24*A^23+336*A^22+3344*A^21+25740*A^20+159984*A^19+820856*A^18 +3519504*A^17+12721926*A^16+39075680*A^15+104485896*A^14+257189424*A^13 +603068156*A^12+1264487184*A^11+1484791560*A^10-3707413456*A^9 -23515353279*A^8-53513746296*A^7-7075256024*A^6+299352120960*A^5 +770653544880*A^4+869309952000*A^3+1145273500800*A^2+1451723788800*A +1818528595200, [[(a4+585)/585+A,A], [a1*(570*a2^2-2100*a2^2*w2)+1620*a2^2*w2+a4^2+2340*a3+2385*a2^2+114075*a2 +1711125,a4], [a1*((30*a2^2-29250*a2)*w2-660*a2^2-40950*a2) +2700*a2^2*w2+a3^2+1440*a2^2+1368900,a3], [4860*w2+a1*((-6300*w2)-8010)+a2^3-2295,a2],[w2^2+w2+1,w2],[a1^2-3,a1]]] [x^4+x+1, A^24-80*A^20+340*A^18+7520*A^16+23120*A^14-973378*A^12-462400*A^10 +50899280*A^8+74190340*A^6+67773664*A^4+2114616240*A^2+266962921, [[a4/624+A,A], [a1*(38*a2^2-140*a2^2*w2)-648*a2^2*w2+a4^2+9984*a3-954*a2^2+64896*a2,a4], [a1*((-65*a2*w2)-91*a2)+(60*a2^2+351*a2)*w2+a3^2+32*a2^2-117*a2+32448,a3], [(-3888*w2)+a1*((-840*w2)-1068)+a2^3+1836,a2],[w2^2+w2+1,w2],[a1^2-229,a1]]] [x^5-2,A^20+2500*A^10+50000, [[a3+A,A],[a3^5-5*a2,a3],[a2^2+22*a1+50,a2],[a1^2-5,a1]]] [x^5-5*x+12,A^10-10*A^8-75*A^6+1500*A^4-5500*A^2+16000, [[A-(a1*((3*a2^4-5*a2^3+25*a2^2)*w2^3+(3*a2^4+15*a2^3+25*a2^2)*w2^2 +10*a2^3*w2+9*a2^4+5*a2^3-50*a2^2) +((-20*a2^4)-25*a2^3)*w2^3+(10*a2^4-25*a2^3-250*a2^2)*w2^2 +((-10*a2^4)-250*a2^2)*w2-5*a2^4-25*a2^3-125*a2^2-625*a2) /3125,A], [a1*(20625*w2^3+20625*w2^2+33750)+90625*w2^3-21875*w2^2+68750*w2+a2^5+34375, a2],[w2^4+w2^3+w2^2+w2+1,w2],[a1^2+10,a1]]] [x^5+20*x+32,A^10-20*A^8+100*A^6+2000*A^4-32000*A^2+128000, [[(a1*((6*a2^4-10*a2^3+100*a2^2)*w2^3+(6*a2^4-70*a2^3+100*a2^2)*w2^2 -80*a2^3*w2-7*a2^4-40*a2^3+50*a2^2) +(10*a2^4+100*a2^3)*w2^3+(20*a2^4+100*a2^3+500*a2^2)*w2^2 +(30*a2^4+500*a2^2)*w2+15*a2^4-50*a2^3+250*a2^2+2500*a2) /12500 +A,A], [a1*(22500*w2^3+22500*w2^2+42500)+87500*w2^3-12500*w2^2+75000*w2+a2^5+37500, a2],[w2^4+w2^3+w2^2+w2+1,w2],[a1^2+5,a1]]] [x^5+11*x+44,A^10-22*A^8+77*A^6+4356*A^4-53724*A^2+189728, [[(a1*((23*a2^4-55*a2^3+605*a2^2)*w2^3+(23*a2^4-935*a2^3+605*a2^2)*w2^2 -990*a2^3*w2-106*a2^4-495*a2^3 +1815*a2^2) +(100*a2^4+715*a2^3)*w2^3+(50*a2^4+715*a2^3+6050*a2^2)*w2^2 +(150*a2^4+6050*a2^2)*w2+75*a2^4-165*a2^3+3025*a2^2+33275*a2) /166375 +A,A], [a1*(74800*w2^3+74800*w2^2+126775)+158125*w2^3-34375*w2^2+123750*w2+a2^5 +61875,a2],[w2^4+w2^3+w2^2+w2+1,w2], [a1^2+2,a1]]] [x^5+x^4-4*x^3-3*x^2+3*x+1,A^5+A^4-4*A^3-3*A^2+3*A+1, [[((10*a1^4+99*a1^3+121*a1^2)*w1^3+((-15*a1^4)+33*a1^3+242*a1^2)*w1^2 +(20*a1^4+77*a1^3-242*a1^2)*w1+26*a1^4 -33*a1^3+1331*a1+1331) /6655 +A,A],[385*w1^3+110*w1^2+220*w1+a1^5-66,a1],[w1^4+w1^3+w1^2+w1+1,w1]]] [x^5+100*x^2+1000, A^20+250000*A^14+20000000*A^12+625000000*A^10-5300000000*A^8+700000000000*A^6 +18750000000000*A^4-598000000000000*A^2+4205000000000000, [[(a1*(a2*(a3^4+2*a3^2)-6*a3^3)+a2*(a3^4+10*a3^2)+10*a3^3+40*a3)/40+A,A], [a3^5-50*a1*a2-110*a2,a3],[a2^2-22*a1+50,a2],[a1^2-5,a1]]] [x^6+x^3+1,A^6+A^3+1,[[a2/2+A,A],[a2^3-4*a1-4,a2],[a1^2+3,a1]]] [x^6-2,A^12-1012*A^6+19307236, [[a3+A,A],[a3^3-18*a2-35*a1,a3],[a2^2+6,a2],[a1^2-2,a1]]] Evaluation took 9.3890 seconds (9.4080 elapsed) using 4571.050 MB.