４．添加する元の定義式，および，５．分解体の相対定義式

取り敢えず，コードと例を記します．解説はまた後日．

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.