5 次方程式の短い解の公式 A   with  Mathematica14 .0

ClearAll["`*"];

このファイル(formulaA.nb)では「Solving Quintics and Septics by Radicals(Monammed A.Faggal, Daniel Lazard共著)」（以下【原論文】と略記)で示された「5次方程式の解の公式 (formulaA)」の説明をします．これは共著者の一人である Lazard 氏が，この論文の10年ほど前に発表された「ガロア分解式を使った解の公式」(3ページ)より，はるかに短く簡潔です．（私も自分で「ガロア分解式を使った解の公式（の様な物）」を作りましたが，それは5千行ぐらいになりました． 「(Subscript[a, 1])=0」 を代入するとこちらもずーと短くなると思いますが，それでも3ページよりは長いと思います.)

なお【原論文】では「7次方程式の解の公式」も載っていますが，それは「5次方程式の解の公式(formulaA)」とは少し異なる方法で導かれています．その方法も非常に鮮やかなので，それと同様にして，もう一つの短い「5次方程式の解の公式(formulaB)」も自作しました． そちらは「formulaB.nb」をご覧ください．なお，私のサイトには上記の「7次方程式の解の公式」の説明と，さらに「解を求めるプログラム」も置いてあります．

(Subscript[a, 1])と a1 など添え字の大きさのみ違う変数は同じ変数を表すものとします．原則として text の中では読みやすいように (Subscript[a, 1]) を使い，input 文の中では a1 を使います .) また，原則として，抽象的な関数は 大文字で，それを具体化した関数は小文字で表すとします．(これは【原論文】でも同じやり方です.)また変数に関しては具体的な数値には $a の様に 「$」を付けて区別する事もあります．そして Global変数は「$」を付けることが多いです．

このファイルは Mathematica 14.0 で作成されています．コマンドの簡単な説明は入れていますが，詳しい説明は Google してください．Wolfram のサイトで詳しい説明を例題付きで読むことができます．また原論文は Maple で書かれています．したがって，残念ながら，グレブナー基底に関しては再現できないこともありました．

Mathematica  をお持ちの方は 「ノートブックを評価」(15秒程度) して頂ければ　 対話的 （interactive） に読むことができて，分かりやすいと思います． お持ちでない方は  PDF  をご覧になってくださっても良いのですが，PDFは文の体裁がかなり崩れ,プログラムは右端が切れてしまいます （ここは是非WolframとAdobeに頑張ってほしい点です)．しかし，無料の  Wolfram  Player  を使えば  ，元の体裁のままノートブックを読むことができるのでお勧めです．

§1. (Subscript[F, 10])について

既約でmonicな有理数係数の5次の整式を f=(x^5)+(Subscript[a, 1])(x^4)+(Subscript[a, 2])(x^3)+(Subscript[a, 3])(x^2)+(Subscript[a, 4])x+(Subscript[a, 5]) , f=0 の解を (Subscript[x, 0]), (Subscript[x, 1]),(Subscript[x, 2]) ,(Subscript[x, 3]),(Subscript[x, 4 ])と置きます． 
k=0,1,2,3,4に対し「σ:(Subscript[x, k])→(Subscript[x, k+1]),τ: (Subscript[x, k])→ (Subscript[x, 3k]) 」（添え数字はMod5) とおくと,(Subscript[巡回群C, 5])=<σ>, 2(Subscript[面体群D, 5])=<σ,(τ^2)>, (Subscript[Frobenius群F, 20])=<σ,τ>で，位数はそれぞれ 5,10,20です．そして fのガロア群をGalとすると,fが可解の時，Galは上の3つのいずれかです．（σ,τ の定義は，私の以前のファイルとは異なりますが，以前の定義と共役です.)

{(Subscript[x, 0,])(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3]),(Subscript[x, 4])}のうち異なる2個をとりその和を作ります．その集合を Y={(Subscript[y, 1]),(Subscript[y, 2])...,(Subscript[y, 10])} と置きます．

Y=Plus@@@Subsets[{x0,x1,x2,x3,x4},{2}]

「F10=(x-(Subscript[y, 1]))(x-(Subscript[y, 2]))⋯(x-(Subscript[y, 10]))」と定義します．

F10=Product[x-Y[[k]],{k,1,10}]

これは vars={(Subscript[x, 0]),(Subscript[x, 1]),⋯,(Subscript[x, 4])} の対称式なので ,vars の基本対称式 (Subscript[s, k])で表されます．更に「解と係数の関係」より (Subscript[a, 1]),(Subscript[a, 2]),⋯,(Subscript[a, 5]) で表せます．

(RefLink[SymmetricReduction, paclet:ref/SymmetricReduction])[f,{(Subscript[x, 1]),…,(Subscript[x, n])}] 
(Subscript[x, 1]),…,(Subscript[x, n])において f==p+q であるような多項式のペア{p,q}を与える．ただし，p は対称な部分であり q は剰余である．

(RefLink[SymmetricReduction, paclet:ref/SymmetricReduction])[f,{(Subscript[x, 1]),…,(Subscript[x, n])},{(Subscript[s, 1]),…,(Subscript[s, n])}]
p における初等対称式を (Subscript[s, 1]),…,(Subscript[s, n])で置き換えたペア{p,q}を与える．

vars={x4,x3,x2,x1,x0};
F10=SymmetricReduction[F10,vars,{-a1,a2,-a3,a4,-a5}][[1]]//Collect[#,x]&

F10=a1 a2 a3 a4-(a3^2) a4-(a1^2) (a4^2)-a1 (a2^2) a5+a2 a3 a5+2 a1 a4 a5-(a5^2)+(a1 a2 (a3^2)-(a3^3)+a1 (a2^2) a4-4 a1 (a4^2)-4 (a1^2) a2 a5-(a2^2) a5+4 a1 a3 a5+4 a4 a5) x+(2 a1 (a2^2) a3+(a1^2) (a3^2)-a2 (a3^2)+(a1^2) a2 a4+(a2^2) a4-3 a1 a3 a4-4 (a4^2)-4 (a1^3) a5-9 a1 a2 a5+7 a3 a5) (x^2)+(a1 (a2^3)+4 (a1^2) a2 a3+(a2^2) a3-4 a3 a4-16 (a1^2) a5-4 a2 a5) (x^3)+(3 (a1^2) (a2^2)+(a2^3)+2 (a1^3) a3+6 a1 a2 a3-(a3^2)-2 (a1^2) a4-2 a2 a4-22 a1 a5) (x^4)+(3 (a1^3) a2+6 a1 (a2^2)+5 (a1^2) a3+2 a2 a3-5 a1 a4-11 a5) (x^5)+((a1^4)+9 (a1^2) a2+3 (a2^2)+4 a1 a3-3 a4) (x^6)+(4 (a1^3)+9 a1 a2+a3) (x^7)+(6 (a1^2)+3 a2) (x^8)+4 a1 (x^9)+(x^10);

すなわち

(Subscript[F, 10])=(Underscript[Π, 0≤i<j≤4]){[x-((Subscript[x, i])+(Subscript[x, j]))}=(x^10)+4 (Subscript[a, 1]) (x^9) +(6 (Subscript[a, 1]^2)+3 (Subscript[a, 2]))(x^8) +(4 (Subscript[a, 1]^3)+9 (Subscript[a, 1]) (Subscript[a, 2])+(Subscript[a, 3]))(x^7) +((Subscript[a, 1]^4)+9 (Subscript[a, 1]^2) (Subscript[a, 2])+3 (Subscript[a, 2]^2)+4 (Subscript[a, 1]) (Subscript[a, 3])-3 (Subscript[a, 4]))(x^6) +(3 (Subscript[a, 1]^3) (Subscript[a, 2])+6 (Subscript[a, 1]) (Subscript[a, 2]^2)+5 (Subscript[a, 1]^2) (Subscript[a, 3])+2 (Subscript[a, 2]) (Subscript[a, 3])-5 (Subscript[a, 1]) (Subscript[a, 4])-11 (Subscript[a, 5]))(x^5) +(3 (Subscript[a, 1]^2) (Subscript[a, 2]^2)+(Subscript[a, 2]^3)+2 (Subscript[a, 1]^3) (Subscript[a, 3])+6 (Subscript[a, 1]) (Subscript[a, 2]) (Subscript[a, 3])-(Subscript[a, 3]^2)-2 (Subscript[a, 1]^2) (Subscript[a, 4])-2 (Subscript[a, 2]) (Subscript[a, 4])-22 (Subscript[a, 1]) (Subscript[a, 5]))(x^4) +((Subscript[a, 1]) (Subscript[a, 2]^3)+4 (Subscript[a, 1]^2) (Subscript[a, 2]) (Subscript[a, 3])+(Subscript[a, 2]^2) (Subscript[a, 3])-4 (Subscript[a, 3]) (Subscript[a, 4])-16 (Subscript[a, 1]^2) (Subscript[a, 5])-4 (Subscript[a, 2]) (Subscript[a, 5]))(x^3) +(2 (Subscript[a, 1]) (Subscript[a, 2]^2) (Subscript[a, 3])+(Subscript[a, 1]^2) (Subscript[a, 3]^2)-(Subscript[a, 2]) (Subscript[a, 3]^2)+(Subscript[a, 1]^2) (Subscript[a, 2]) (Subscript[a, 4])+(Subscript[a, 2]^2) (Subscript[a, 4])-3 (Subscript[a, 1]) (Subscript[a, 3]) (Subscript[a, 4])-4 (Subscript[a, 4]^2)-4 (Subscript[a, 1]^3) (Subscript[a, 5])-9 (Subscript[a, 1]) (Subscript[a, 2]) (Subscript[a, 5])+7 (Subscript[a, 3]) (Subscript[a, 5]))(x^2) +((Subscript[a, 1]) (Subscript[a, 2]) (Subscript[a, 3]^2)-(Subscript[a, 3]^3)+(Subscript[a, 1]) (Subscript[a, 2]^2) (Subscript[a, 4])-4 (Subscript[a, 1]) (Subscript[a, 4]^2)-4 (Subscript[a, 1]^2) (Subscript[a, 2]) (Subscript[a, 5])-(Subscript[a, 2]^2) (Subscript[a, 5])+4 (Subscript[a, 1]) (Subscript[a, 3]) (Subscript[a, 5])+4 (Subscript[a, 4]) (Subscript[a, 5]))x +(Subscript[a, 1]) (Subscript[a, 2]) (Subscript[a, 3]) (Subscript[a, 4])-(Subscript[a, 3]^2) (Subscript[a, 4])-(Subscript[a, 1]^2) (Subscript[a, 4]^2)-(Subscript[a, 1]) (Subscript[a, 2]^2) (Subscript[a, 5])+(Subscript[a, 2]) (Subscript[a, 3]) (Subscript[a, 5])+2 (Subscript[a, 1]) (Subscript[a, 4]) (Subscript[a, 5])-(Subscript[a, 5]^2)

【コメント】原論文では，終結式 (resultant) を使って導いています .

§2. (Subscript[F, 1]), (Subscript[F, 2])について

σ によるYの軌道分解は 次の (Subscript[O, 1]),(Subscript[O, 2])の二つしかありません．(Mod5 で考えると，(Subscript[O, 1])は添え数字の差が1, (Subscript[O, 2])は差が2)

O1=Table[Total[vars[[Sort[Mod[{0,1}+k,5]]+1]]],{k,0,4}];
O2=Table[Total[vars[[Sort[Mod[{0,2}+k,5]]+1]]],{k,0,4}];
Column[{"(Subscript[O, 1]):"<>ToString[O1],"(Subscript[O, 2]):"<>ToString[O2]}]

(Subscript[O, 1]),(Subscript[O, 2])の要素を解に持つ5次の整式をそれぞれ (Subscript[F, 1]),(Subscript[F, 2 ])と置きます．

F1=Product[(x-O1[[k]]),{k,1,5}]
F2=Product[(x-O2[[k]]),{k,1,5}]

(Subscript[F, 1]),(Subscript[F, 2])はσ ,(τ^2)で変わらず,τによって (Subscript[F, 1])⟷(Subscript[F, 2]) と移ります．また 「f=0」の判別式を D とおくと,(Sqrt[D]) はσ,(τ^2)で変わらず,τによって (Sqrt[D])⟷-(Sqrt[D]) と移ります．(Subscript[故にF, 1]),(Subscript[F, 2])の係数は Q((Sqrt[D]))に入ります．また「5次の整式の根が1つの軌道を形成する場合、その整式は既約多項式または(((x-α))^5)となる」ので，Gal=(Subscript[F, 10])(Subscript[またはC, 5])のとき，(Subscript[F, 1]),(Subscript[F, 2])は共に「Q上既約な5次式」となります．Gal=(Subscript[F, 20])のとき，(Subscript[F, 10])はQ上既約ですが，Q((Sqrt[D]))上では (Subscript[F, 10])=(Subscript[F, 1])(Subscript[F, 2])と 因数分解されます．

【例1】f=7+10 x-10 (x^2)-15 (x^3)+(x^5)(Gal=(Subscript[C, 5]))

f=7+10 x-10 (x^2)-15 (x^3)+(x^5);
f10 = F10 /. AssociationThread[{a1, a2, a3, a4, a5} -> Reverse@CoefficientList[f, x, 5]]
d=Sqrt[Discriminant[f,x]](*d=(Sqrt[D])*)
Factor[f10]

(Subscript[f, 10])(Subscript[はQ上でf, 1]),(Subscript[f, 2])に因数分解できました．

【例2】f=4+10 x-(x^2)-6 (x^3)+(x^5)(Gal=(Subscript[F, 10]))

f=4+10 x-(x^2)-6 (x^3)+(x^5);
f10 = F10 /. AssociationThread[{a1, a2, a3, a4, a5} -> Reverse@CoefficientList[f, x, 5]]
d=Sqrt[Discriminant[f,x]](*d=(Sqrt[D])*)
Factor[f10]

(Subscript[f, 10])(Subscript[はQ上でf, 1]),(Subscript[f, 2])に因数分解できました．

【例3】f=12-6 x+12 (x^2)-9 (x^3)+(x^5)(Gal=(Subscript[F, 20]))

f=5+5 x-5 (x^3)+(x^5)
f10 = F10 /. AssociationThread[{a1, a2, a3, a4, a5} -> Reverse@CoefficientList[f, x, 5]]
Factor[f10];
d=Sqrt[Discriminant[f,x]](*d=(Sqrt[D])*)
$f10=Factor[f10,Extension->d]
f1=FactorList[$f10,Extension->d][[3,1]]*(-1/2)//Expand
f2=FactorList[$f10,Extension->d][[4,1]]*(1/2)//Expand

(Subscript[f, 10])はQ上既約ですが，Q((Sqrt[D]))(Subscript[上ではf, 1]),(Subscript[f, 2])に因数分解できました．

f1, f2を見つけるプログラム findF12 は次の様に作れます．出力は{f1,f2}で，$f1,$f2 は f1,f2のGlobal変数です．

findF12[f_]:=Module[{factors,pos},
Clear[a1,a2,a3,a4,a5];
$f10 = F10 /. AssociationThread[{a1, a2, a3, a4, a5} -> Reverse@CoefficientList[f, x, 5]]; 
factors=FactorList[$f10,Extension->Sqrt[Discriminant[f,x]]];
 pos=Position[Exponent[factors, x], 5][[All,1]];
{$f1,$f2}=Expand[#/Coefficient[#,x,5]]&/@factors[[All,1]][[pos]];
If[$f1==x^5,{$f1,$f2}={$f2,$f1}];
Return[{$f1,$f2}]
]

(*例*)findF12[5+5 x-5 (x^3)+(x^5)]

$f1

Gal=(Subscript[F, 20]) のとき，f1とf2は (Sqrt[D]) の係数の符号のみ異なります．したがって (Subscript[f, 1])+(Subscript[f, 2]) ,(Sqrt[D])((Subscript[f, 1])-(Subscript[f, 2]))の係数は Qに含まれます.

$f1+$f2
Sqrt[5]($f1-$f2)//Expand

§3. (SuperPlus[F]), (SuperMinus[F])について

(SuperPlus[F])=(Subscript[f, 1])+(Subscript[f, 2]), (SuperMinus[F])=(Subscript[f, 1])-(Subscript[f, 2]) と定義します．(SuperPlus[F])と (SuperMinus[F]) の係数は，それぞれ Q,Q((Sqrt[D]))に入ります．さらに (SuperPlus[F]),(Sqrt[5])(F^(- ))の (5-i)次の係数をそれぞれ (Subscript[e, i ,]) (Subscript[d, i])と置きます．(1≤i≤5)
なお，Mathematicaの仕様で (SuperPlus[F])=Fp, (SuperMinus[F])=Fm と書きます．一般の整式fの場合は，(Subscript[d, i]),(Subscript[e, i ])は, (Subscript[x, 0])~(Subscript[x, 4]) の式になります．

Fp=F1+F2
Fm=F1-F2

{e1,e2,e3,e4,e5}=CoefficientList[Fp,x,5]//Reverse
{d1,d2,d3,d4,d5}=Sqrt[5]CoefficientList[Fm,x,5]//Reverse

【コメント】(Subscript[d, i]),(Subscript[e, i])の定義は「非常に」分かりにくいです．アルファベット順を考えると (SuperPlus[F]),(Sqrt[5])(F^(- ))の係数をそれぞれ (Subscript[d, i]),(Subscript[e, i]) とすべきと思うのですが，逆になっています．ここでは原論文の通りにしました．それぐらいはまだ良いのですが，もっと問題なのは， (Subscript[d, i]) の定義は 本文では 「(Sqrt[D])((Subscript[f, 1])-(Subscript[f, 2]))の(5-i)次の係数」となっていて，この後の「解の公式」が導けず,苦労しました．しかし章末にあるアルゴリズムを読むと「(Sqrt[5])((Subscript[f, 1])-(Subscript[f, 2]))の(5-i)次の係数」となっているので，定義を変更する事により上手くいきました．更には，(Subscript[一般の関数F, 1]),(Subscript[F, 2])に対しては， (Subscript[D, i])は 「((Subscript[F, 1])-(Subscript[F, 2]))の(5-i)次の係数」 となっています．なんと3通りも異なる定義が使われています.((Subscript[しかも本文のd, i]),(Subscript[e, i])の定義は上述の様に間違いです!) また7次方程式でも (Subscript[F, 1]),(Subscript[F, 2]), (SuperPlus[F]),(SuperMinus[F]) は定義されますが，その係数はそれぞれ (Subscript[b, i]),(Subscript[c, i]),(SuperPlus[d]),(SuperMinus[d]) となっていて5次方程式とは異なる文字が使われています．

§4. 解の公式A とその証明

以下 「f=(x^5)+ (Subscript[a, 2])(x^3)+(Subscript[a, 3])(x^2)+(Subscript[a, 4])x+(Subscript[a, 5]) ((Subscript[a, 1])=0)」と仮定します．

解の公式は (Subscript[a, i]),(Subscript[d, i]),(Subscript[e, i ])で表す事ができます．（他にも色々な表現があります.なので解の公式「A」としてます.)

§4-0  解の公式A

ζ を1の虚数5乗根とするとき，Lagrange  (Subscript[分解式は次のr, 0])~(Subscript[r, 4])になります．(原論文では Fourier transform と呼んでいます.)

Clear[x0,x1,x2,x3,x4]
r0=x0+ x1+ x2+ x3 + x4 ;
r1=x0+ζ x1+ ζ^2 x2 +ζ^3 x3 +ζ^4 x4;
r2=x0+ζ^2 x1+ ζ^4 x2 +ζ x3 +ζ^3 x4;
r3=x0+ζ^3 x1+ ζ x2 +ζ^4 x3 +ζ^2 x4;
r4=x0+ζ^4 x1+ ζ^3 x2 +ζ^2 x3 +ζ x4;

σ,τ によって (Subscript[r, k]) は次の様に移ります．

「σ: (Subscript[r, 0])→(Subscript[r, 0]),(Subscript[r, 1])→(ζ^4)(Subscript[r, 1]), (Subscript[r, 2])→(ζ^3)(Subscript[r, 2]),(Subscript[r, 3])→(ζ^2)(Subscript[r, 3]),(Subscript[r, 4])→(Subscript[ζr, 4])」,「τ:(Subscript[r, k])→(Subscript[r, 2k]), (τ^2):(Subscript[r, k])→(Subscript[r, 4k])」

そして解の公式 （の一歩手前） は次の4式となります．まず両辺の固定群を調べておくと，左辺は (Subscript[F, 10])で動かず (Subscript[F, 20])で動きます．右辺も同様です．

({{{, ({{(Subscript[r, 1])(Subscript[r, 4])=-(1/2)(Subscript[d, 2])-(5/2)(Subscript[a, 2]), (1)}, {((Subscript[r, 1])^5)+((Subscript[r, 4])^5)=((125 )/2)(Subscript[d, 5])+125 (Subscript[e, 5])-((25 )/4)(Subscript[d, 3]) (Subscript[a, 2])-((75 )/4)(Subscript[d, 2]) (Subscript[a, 3])-((125 )/2)(Subscript[a, 2]) (Subscript[a, 3])-((375 )/2)(Subscript[a, 5]), (2)}, {((Subscript[r, 4])^2)(Subscript[r, 2])+((Subscript[r, 1])^2)(Subscript[r, 3])=-(5/2)(Subscript[d, 3])-(25/2)(Subscript[a, 3]), (3)}, {((Subscript[r, 1])^3)(Subscript[r, 2])+((Subscript[r, 4])^3)(Subscript[r, 3])=((25 )/2)(Subscript[d, 4])+((15 )/2)(Subscript[e, 4])-((15 )/2)(Subscript[d, 2]) (Subscript[a, 2])-40(Subscript[a, 4])-((5 )/2)((Subscript[a, 2])^2), (4)}})}})

この式を証明するには全てを (Subscript[x, 0])~(Subscript[x, 4 ])の式に直して証明します．(Subscript[r, i,])(Subscript[e, i]),(Subscript[d, i])は既に そうなっています．また (Subscript[a, i])を (Subscript[x, 0])~(Subscript[x, 4 ])の式に直した式を (Subscript[$a, i])とおき，(Subscript[k次の基本対称式をs, k])とおきます．更にイデアル I={s1 ,s2-a2,s3+a3,s4-a4,s5+a5}のグレブナー基底を作り base と置きます．((Subscript[s, k])の名前付け)

({{(RefLink[GroebnerBasis, paclet:ref/GroebnerBasis])[{(Subscript[poly, 1]),(Subscript[poly, 2]),…},{(Subscript[x, 1]),(Subscript[x, 2]),…}]
多項式の集合 (Subscript[poly, i])についてグレブナー(Gröbner)基底を形成する多項式を求める}, {(RefLink[GroebnerBasis, paclet:ref/GroebnerBasis])[{(Subscript[poly, 1]),(Subscript[poly, 2]),…},{(Subscript[x, 1]),(Subscript[x, 2]),…},{(Subscript[y, 1]),(Subscript[y, 2]),…}]
(Subscript[変数y, i])を消去したグレブナー基底を求める．}})

{s1,s2,s3,s4,s5}= Table[ SymmetricPolynomial[k,{x0,x1,x2,x3,x4}],{k,1,5}]
{$a1,$a2,$a3,$a4,$a5}={(-1),1,(-1),1,(-1)} {s1,s2,s3,s4,s5}
base=GroebnerBasis[{s1 ,s2-a2,s3+a3,s4-a4,s5+a5},{x4,x3,x2,x1,x0}]

【コメント】「base」は 基本対称式 (Subscript[s, k])に (((-1))^k)(Subscript[a, k]) という名前を付けただけです．(k=2,..,5)  例えば次と同じ使い方です．
「問」((Subscript[x, 1])^3)+((Subscript[x, 2])^3)+((Subscript[x, 3])^3) を (Subscript[x, 1])+(Subscript[x, 2])+(Subscript[x, 3]), (Subscript[x, 1])(Subscript[x, 2])+(Subscript[x, 2])(Subscript[x, 3])+(Subscript[x, 3])(Subscript[x, 1]), (Subscript[x, 1])(Subscript[x, 2])(Subscript[x, 3 ])を用いて表せ 
「解答」grb=GroebnerBasis[{x1+x2+x3-p, x1 x2+x2 x3+x3 x1-q, x1 x2 x3-r},{x3,x2,x1,p,q,r}]
{-r+q x1-p (x1^2)+(x1^3),q-p x1+(x1^2)-p x2+x1 x2+(x2^2),-p+x1+x2+x3}
PolynomialReduce[x1^3+x2^3+x3^3,grb,{x3,x2,x1,p,q,r}]
{{3,2 p-2 x1+x2+x3,(p^2)-q-p x1-p x2+x1 x2+p x3-x1 x3-x2 x3+(x3^2)},(p^3)-3 p q+3 r}
第2要素は 「((Subscript[x, 1])^3)+((Subscript[x, 2])^3)+((Subscript[x, 3])^3)=((((Subscript[x, 1])+(Subscript[x, 2])+(Subscript[x, 3])))^3)-3((Subscript[x, 1])+(Subscript[x, 2])+(Subscript[x, 3]))((Subscript[x, 1])(Subscript[x, 2])+(Subscript[x, 2])(Subscript[x, 3])+(Subscript[x, 3])(Subscript[x, 1]))+3 (Subscript[x, 1])(Subscript[x, 2])(Subscript[x, 3 ])」を表します．

(1)~(4)の導き方は原論文の著者によると次の様になります．ちなみに「G=base」です．

For the first invariant F1,we compute its normal NF(F1)form by G.If it belongs to a basis of the free module of
  invariants (i.e.its leading term depends only on the (Subscript[x, i])),we　introduce a new indeterminate f1 and the polynomial 
  P1:=NF(F1)−f1.From now on,the normal form procedure is modified and consists in reducing first by G,
  then by P1, . . .,a polynomial being reducible by some Pi only if its leading term is the product
  of the leading term of Pi by a monomial which is independent of the (Subscript[x, i]).

上の方針に従うと，次の様になると思います . （残念ながら原論文では式の形では述べられていないので確信はありません .)

なお，Mathematica  では 「簡約」 は, PolynomialReduce (その内でも，余り=第2成分の方) を使います．「整式のMod」は PolynomialModを使います．PolynomialReduce と  PolynomialMod はほぼ同じですが，私は複数の整式（特にグレブナー基底）で割るときは PolynomialReduce を，一個の式で割るときは PolynomialMod を使っています．更に詳しいことは Google を御参照ください．

(RefLink[PolynomialReduce, paclet:ref/PolynomialReduce])[poly,{(Subscript[poly, 1]),(Subscript[poly, 2]),…},{(Subscript[x, 1]),(Subscript[x, 2]),…}]
(Subscript[poly, i]) によって poly  を簡約したリストを返す．求まるリストは{{(Subscript[a, 1]),(Subscript[a, 2]),…},b}の形であり，b は最小で，poly  は (Subscript[a, 1]) (Subscript[poly, 1])+(Subscript[a, 2]) (Subscript[poly, 2])+…+b に等しい．

({{, (RefLink[PolynomialMod, paclet:ref/PolynomialMod])[poly,m]
m を法として多項式 poly を与える．}, {, (RefLink[PolynomialMod, paclet:ref/PolynomialMod])[poly,{(Subscript[m, 1]),(Subscript[m, 2]),…}]
すべての (Subscript[m, i])を法として簡約する．}})

§4-1  (Subscript[r, 1])(Subscript[r, 4]) について

まずは poly1=(Subscript[r, 1])(Subscript[r, 4]) を (Subscript[x, 0])~ (Subscript[x, 4]) の式で表して 「1 + ζ + (ζ^2)+(ζ^3)+(ζ^4)=0」 と 「 (ζ^2)+(ζ^3)=(-1-(Sqrt[5]))/2」 を使って簡単にします．

poly1=r1*r4//PolynomialMod[#,Cyclotomic[5,ζ]]&//Collect[#,ζ]&
poly1=poly1/.{ζ^3->2Cos[4/5Pi]-ζ^2}//FullSimplify

poly1, d2   を   base   で簡約した余りを求め，それぞれ先頭に$を付けた名前を付けます．

$d2=PolynomialReduce[d2,base,{x4,x3,x2,x1,x0}][[2]]
$poly1=PolynomialReduce[poly1,base,{x4,x3,x2,x1,x0}][[2]]

$d2のLT(Leading Term)は (Subscript[x, i]) の式なので, $d2は独立変数です．よって   $poly1を ($d2-m1) で簡約します (m1は$d2の名前で 不定変数(indeterminate))

PolynomialReduce[$poly1,$d2-m1,{x4,x3,x2,x1,x0}]

これは  「poly1 = -(1/2) ($d2-m1)+(1/2)(-5 a2 - m1)」  を表しますが，m1は$d2の名前なので，($d2-m1)は零ベクトルです．故に  「poly1 = (簡約した余り) = (1/2) (-5 a2-m1)」  となります．

【検算】

私はグレブナー基底を使った計算はやや不安なので，検算します

Factor[poly1+1/2 d2+5/2 $a2]

「(Subscript[x, 0])+(Subscript[x, 1])+(Subscript[x, 2])+(Subscript[x, 3])+(Subscript[x, 4])=0」なので，確かに式(1)は正しいです．

§4-2  ((Subscript[r, 1])^5)+((Subscript[r, 4])^5)について

まずは poly2= ((Subscript[r, 1])^5)+((Subscript[r, 4])^5) を (Subscript[x, 0])~ (Subscript[x, 4]) の式で表して 「1 + ζ + (ζ^2)+(ζ^3)+(ζ^4)=0」 と 「 (ζ^2)+(ζ^3)=(-1-(Sqrt[5]))/2」 を使って簡単にします．

poly2=(r1^5+r4^5//PolynomialMod[#,Cyclotomic[5,ζ]]&//Collect[#,ζ]&)/.{ζ^2->2Cos[4/5Pi]-ζ^3}//Simplify

次に poly2, d5, e5, d3, d2 を base で簡約した余りを求め，それぞれ先頭に$を付けた名を与えます．

{$poly2,$d5,$e5,$d3,$d2 }=PolynomialReduce[#,base,{x4,x3,x2,x1,x0}][[2]]&/@{poly2,d5,e5,d3 ,d2 }

まず$d5のLTは (Subscript[x, i]) の式なので, $d5は独立変数です．よって   次は $e5を($d5-m1)で簡約して $$e5という名前を付けます .  (m1は$d5の名前で 不定変数(indeterminate))

$$e5=PolynomialReduce[$e5,$d5-m1,{x4,x3,x2,x1,x0}][[2]]

$$e5のLTは (Subscript[x, i]) の式なので, 独立変数です．よって   d3 a2 を{$b3 - m1, $$e5 - m2}で簡約して $$d3a2 という名前を付けます .  (m2は$$e5の名前で 不定変数) .

$$d3a2=PolynomialReduce[$d3 a2 ,{$d5-m1,$$e5-m2},{x4,x3,x2,x1,x0}][[2]]

$$d3a2のLTは (Subscript[x, i]) の式なので, 独立変数です．よって   $d2 a3 を{$b3 - m1, $$e5 - m2,$$d3a2-m3}で簡約します . (m3は$$d3a2の名前で 不定変数) .

$$d2a3=PolynomialReduce[$d2 a3,{$d5-m1,$$e5-m2, $$d3a2 -m3},{x4,x3,x2,x1,x0}][[2]]

$$d2a3のLTは (Subscript[x, i]) の式なので, 独立変数です．よって最後に poly2 を {$b3 - m1, $$e5 - m2, $$d3a2-m3,$$d2a3 - m4}で簡約します . (m4は$$d2a3 の名前で 不定変数) .

PolynomialReduce[$poly2,{$d5-m1,$$e5-m2, $$d3a2 -m3,$$d2a3-m4 },{x4,x3,x2,x1,x0}][[2]]//Expand

これは 「(r1^5)+((Subscript[r, 4])^5)=-((125 )/2)a2 a3-((375 )/2)a5+125 e5+((125 )/2)d5-((25 )/4)d3 a2-((75 )/4)d2 a3 」を意味します．

【検算】

poly2-(125/2 d5 +125 e5-25/4 d3 ($a2) -75/4 d2 ($a3)-125/2 (s2)($a3)-375/2 ($a5))//Factor

「(Subscript[x, 0])+(Subscript[x, 1])+(Subscript[x, 2])+(Subscript[x, 3])+(Subscript[x, 4])=0」なので，確かに式(2)は正しいです．

プログラム relation

上の長い操作を自動化したプログラムです.(評価してください)

Clear[ζ]

relation[bases_List,target_]:=Module[{vars,list,nbase,new,k},
vars={x4,x3,x2,x1,x0};
$target=Simplify[Collect[PolynomialMod[target,Cyclotomic[5,ζ]],ζ]/.{ζ^2->2Cos[4/5Pi]-ζ^3}];
polys=Append[bases,$target];
list=Simplify[PolynomialReduce[#,base,vars][[2]]&/@polys];
k=1;
nbase={list[[1]]-m1};
Do[k++;new=Simplify[PolynomialReduce[list[[k]],nbase,vars][[2]]];
AppendTo[nbase,new-ToExpression["m"<>ToString[k]]],Length[bases]-1];
Expand@Simplify[PolynomialReduce[Last[list],nbase,vars][[2]]]]

polyをbases(集合)で表したい時，構文は  relation[bases(リスト), poly]  です．この例の場合は次の様になります．

relation[{d5,e5, d3 a2 ,d2 a3} ,poly2]

base  はグレブナー基底なので,  bases  の順序を変えても結果は変わりません．

relation[{ d3 a2 ,e5, d5, d2 a3} ,poly2]

§4-3  ((Subscript[r, 4])^2)(Subscript[r, 2])+((Subscript[r, 1])^2)(Subscript[r, 3]) について

relation  を使って証明します．

poly3=r4^2 r2+r1^2 r3;
relation[{d3},poly3]

これは  poly3= -((25 a3)/2)-((5 (Subscript[d, 3]))/2) を表します.

【検算】

poly3=Simplify[Collect[PolynomialMod[poly3,Cyclotomic[5,ζ]],ζ]/.{ζ^2->2Cos[4/5Pi]-ζ^3}];
poly3+5/2 d3+25/2 $a3//Factor

「(Subscript[x, 0])+(Subscript[x, 1])+(Subscript[x, 2])+(Subscript[x, 3])+(Subscript[x, 4])=0」なので，確かに式(3)は正しいです．

§4-4 ((Subscript[r, 1])^3)(Subscript[r, 2])+((Subscript[r, 4])^3) (Subscript[r, 3]) について

poly4=(r1^3 r2+r4^3 r3//PolynomialMod[#,Cyclotomic[5,ζ]]&//Collect[#,ζ]&)/.{ζ^2->2Cos[4/5Pi]-ζ^3}//FullSimplify

relation[{d4, e4,d2 a2},poly4]

これは 「poly4=-((5 (a2^2))/2)-40 a4+((25 (Subscript[d, 4]))/2)+((15 (Subscript[e, 4]))/2)-((15 (Subscript[d, 2]) (Subscript[a, 2]))/2)」を表します．

【検算】

poly4-(25/2 d4+15/2 e4-15/2 d2(s2) -40 s4-5/2 (s2)^2)//Factor

「(Subscript[x, 0])+(Subscript[x, 1])+(Subscript[x, 2])+(Subscript[x, 3])+(Subscript[x, 4])=0」なので，確かに式(4)は正しいです．

§5. 解を求める

({{{, ({{(Subscript[r, 1])(Subscript[r, 4])=-(1/2)(Subscript[d, 2])-(5/2)(Subscript[a, 2]), (1)}, {((Subscript[r, 1])^5)+((Subscript[r, 4])^5)=((125 )/2)(Subscript[d, 5])+125 (Subscript[e, 5])-((25 )/4)(Subscript[d, 3]) (Subscript[a, 2])-((75 )/4)(Subscript[d, 2]) (Subscript[a, 3])-((125 )/2)(Subscript[a, 2]) (Subscript[a, 3])-((375 )/2)(Subscript[a, 5]), (2)}, {((Subscript[r, 4])^2)(Subscript[r, 2])+((Subscript[r, 1])^2)(Subscript[r, 3])=-(5/2)(Subscript[d, 3])-(25/2)(Subscript[a, 3]), (3)}, {((Subscript[r, 1])^3)(Subscript[r, 2])+((Subscript[r, 4])^3)(Subscript[r, 3])=((25 )/2)(Subscript[d, 4])+((15 )/2)(Subscript[e, 4])-((15 )/2)(Subscript[d, 2]) (Subscript[a, 2])-40(Subscript[a, 4])-((5 )/2)((Subscript[a, 2])^2), (4)}})}})

§4より上の式が確かめられました．(1)(2)より ((Subscript[r, 1])^5), ((Subscript[r, 2])^(5 ))は次の「R(x)=0」の２解となります．

R:=x^2-(((125 )/2)d5+125 e5-((25 )/4)d3 a2-((75 )/4)d2 a3-((125 )/2)a2 a3-((375 )/2)a5)x+(((-(1/2)d2-(5/2)a2))^5)

この2解を (Subscript[R, 1]), (Subscript[R, 2]) とすると， (Subscript[r, 1])=((Subscript[R, 1])^(1/5)), (Subscript[r, 4])=((Subscript[R, 2])^(1/5)) です．まず 「(Subscript[r, 1])=(Subscript[r, 4])=0」のとき((Subscript[F, 1])=(x^2)のとき)は,τにより 解の名前を変える事により，(Subscript[F, 1]) と (Subscript[F, 2]) を入れ替えます．このとき 「(Subscript[F, 1])=(Subscript[F, 2])=(x^2)」 とすると 「(Subscript[r, 1])=(Subscript[r, 2])=(Subscript[r, 3])=(Subscript[r, 4])=0」となり，(Subscript[x, k])=0(0≤k≤4) となり矛盾します．故に適当な解の名前の変換により 「(Subscript[r, 1])!=0」 とできます．以下「(Subscript[r, 1])!=0」とします．
(Subscript[このときr, 1])の5乗根はすべて異なりますが，どれをとってもfの解集合は同じになります.また (Subscript[r, 4]) は「 (Subscript[r, 1])(Subscript[r, 4])=-(1/2)(Subscript[d, 2])-(5/2)(Subscript[a, 2])」 となるように累乗根を取ります．

次に(3)(4)は {(Subscript[r, 2]),(Subscript[r, 3]) }についての一次方程式です．それに対応する行列の行列式Detは 「Det=((Subscript[r, 4])^5)-((Subscript[r, 1])^(5 ))」です．ここで「Det=0」 とならないことが以下の様に証明されます．((Subscript[u, k])→(Subscript[r, k])と変えています)

In fact,if (r1^5)=(r4^5)≠0,we have r4=(Subscript[(ω^i),  ])r1 for some i,where ω is the
primitive root of unit which has been chosen.Thus,if we denote
by k1 and k3 the right hand sides of Equations 1 and 3respectively,
we have (r1^2)=k1/(ω^i) and r2 (ω^2)+r3=k3.  As r2 r3=d2/2−5 a5 
(conjugate equation of Equation (1)),we see that all the ui and thus 
all the roots belong to an extension of K of degree prime to 5,which implies that f is not irreducible.

しかしこの証明は私には納得できなかったので，ここでは説明できません．(^^;)仮にこの証明が正しいとすると，(たぶんそうだと思いますが)(Subscript[r, 2]),(Subscript[r, 3]),(Subscript[r, 4])(Subscript[が全てr, 1])により 1通りに表せることになり，解の公式が完結します．

以下, §2で挙げたのと同じ「例3」の厳密解とその近似値を求めて，NSolveの数値解と比較します．

【例】f=12-6 x+12 (x^2)-9 (x^3)+(x^5)(Gal=(Subscript[F, 20]))

f=12-6 x+12 (x^2)-9 (x^3)+(x^5);

(ア)f1, f2   と   R   を求めます．

{f1,f2}=findF12[f]
{fp,fm}={f1+f2,f1-f2}
{a1,a2,a3,a4,a5}=CoefficientList[f,x,5]//Reverse;
{e1,e2,e3,e4,e5}=CoefficientList[fp,x,5]//Reverse;
{d1,d2,d3,d4,d5}=Sqrt[5]CoefficientList[fm,x,5]//Reverse;
R

(イ)R=0 (Subscript[の解のうち0でない解をR, 1])とし，(Subscript[その5乗根r, 1])を求め，式(1)(Subscript[によりr, 4 ])も求めます．

{R1,R2}=x/.Solve[R==0,x]

r1=R1^(1/5)//FullSimplify

r4=(-1/2 d2-5/2 a2)/r1//FullSimplify

(ウ)　(3)(4)を使って (Subscript[r, 2]), (Subscript[r, 3  ])を求めます．

{r2,r3}=1/(r4^5-r1^5){{r4^3,-r1^2},{-r1^3,r4^2}}.{-(5/2)d3-(25/2)a3,((25 )/2)d4+((15 )/2)e4-((15 )/2)d2 a2-40a4-((5 )/2)(a2^2)}//FullSimplify

(エ)Lagrange  の逆変換を使い  解X={(Subscript[x, 0]),(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3]),(Subscript[x, 4])} を求めます．長いので(Subscript[x, 1]) のみ表示します．

X=1/5{{1,1,1,1,1},ζ^{0,4,3,2,1},ζ^{0,3,1,4,2},ζ^{0,2,4,1,3},ζ^{0,1,2,3,4}}.{0,r1,r2,r3,r4};
TraditionalForm[x1]

(オ)「ζ = cos  (2  π/5) + ι   sin  (2  π/5)」   を代入して，近似値を求め，NSolveを使った数値解と比較します．御覧の様に一致します．

$X={x0,x1,x2,x3,x4}=X/.{ζ->Cos[2/5Pi]+I Sin[2/5Pi]}//Simplify;
N[$X,20]//Chop//Sort

x/.NSolve[f==0,x,20]

§6   原論文に載っているプログラム

上のプログラムはメインプログラムで，この他にサブプログラムがいくつか必要です．なお，私は既にガロア分解式を使った5次方程式を解くプログラム (solveQuinticProgramVer2) をアップしてあり，それでもすでに1秒以内に解は求まるので，この短い解の公式 (FormulaA) を使ったプログラムは（少なくとも当分の間は）書かないと思います．このファイルではこの素晴らしい解の公式を紹介したかっただけです．なお公式の右辺に関して「なぜ (Subscript[d, i]), (Subscript[e, i])  を使ったか？」という疑問が起こりますが，これに関しては 「MolienSeries.nb」をご覧ください．また，この他にも解の公式(FormulaB)も作りました．そちらは FormulaB.nb をご覧ください．