「数学」のブログ記事一覧-横浜市金沢区の植物

Mathematicaによる5次方程式解法の事始めⅥ

2025-07-09 | 数学

Mathematicaによる5次方程式解法の事始めⅥ
はじめに
Mathematicaによる5次方程式解法の事始めで1次から5次方程式の解を求めた。その末尾に黄金比の十次方程式をHermite形式と.F.クライン形式で解いた。Mathematicaによる5次方程式解法の事始めⅣ迄は代数方程式の解を求めたが、今回はそれとは異なる。黄金比の解は既に既知なので、それを代数方程式に当てはめた。今回は更に、それを発展してHermite形式と.F.クライン形式で黄金比の1次から10次方程式を解いた。3次方程式のタルタリア形式及び4次方程式のフェラーリ形式を使う事なく、全てHermite形式と.F.クライン形式で解が求まる。この手法はタルタリア形式及びフェラーリ形式よりも入力スクリプトが短くなる。Mathematicaによる5次方程式解法の事始めⅠで記述したように16世紀のイタリアのニッコロタルタリアNiccolo Tartaglia (1500年–1557年)とルドヴィコ・フェラーリLodovico Ferrari（1522年–1565年）の時代からF.クライン Felix Klein（1849.4.25-1925.6.22）とシャルル・エルミート Charles Hermite(1822.12.24–1901.1.14)の20世紀・前後に時代が進み、数学が格段に進歩した。その強力なツールで高次方程式も扱えるようになった。

F.クライン Felix Klein 1849.4.25-1925.6.22

　20世紀・前後のドイツにおける指導的数学者の一人。Dusseldorfに生まれBonn大学を卒業、パリに学び、1827年Erlngen大学教授、1886年Gottingen大学教授となり、終生この職にあった。業績は数学の各部門にわたるが、本質的には幾何学者であった。Erlngen大学就任講演において、当時知られていた幾何学の各分野に群論の立場から鳥瞰図を与えた。それがErlngenの目録と呼ばれる物である。Euclid幾何学、非Euclid幾何学は共に射影幾何学に従属する幾何学である事もこの目録に含まれる。数学的業績として最も力をを注いだのは保形関数の研究であった事を、晩年の講義で述懐している。この講義は19世紀の数学の史料として重要である。彼はまた数学教育改善にも意を用い、ドイツにおける改革運動を指導した、教育者の為になされた講義もある。また数学雑誌「Mathematisches Annalen」を刊行し、教育改革に取り組んだ。1875年に哲学者ゲオルク・ヴィルヘルム・フリードリヒ・ヘーゲルGeorg Wilhelm Friedrich Hegelの孫アンネ・ヘーゲルAnne Hegelと結婚した。

シャルル・エルミート Charles Hermite 1822.12.24 – 1901.1.14
　1842年、ナポレオンが創設したÉcole Polytechniqueエコール・ポリテクニークに入学した。しかし、身体的ハンディの為、卒業する事なく、退学を余儀無くされた。1869年、エコール・ポリテクニークの数学教授に就任し、1876年まで同校に勤めた後、死去するまでパリ大学に勤めた。数学の業績は世界の主要な数学雑誌に掲載されており、主にアーベル関数と楕円関数、そして整数論を扱っていた。1858年、エルミートは5次方程式が楕円関数で解ける事を示した。1873年には、ネイピア数であるeが超越関数であることを証明した。

シリーズ物

Mathematicaで正多面体の黄金比の事始め

Mathematicaによる5次方程式解法の事始めⅤからの続き

7.六次方程式を解く

f(x)=x⁶-3 x⁵-2 x⁴+9 x³-2 x²-3 x+1

HermiteQuinticSolve[x, (-2.618033989 + x) (-1.618033989 +x) (-0.6180339887 + x) (-0.3819660113 + x) (0.6180339887 +x) (1.618033989 + x) == 0]

{{x -> -1.618033989}, {x -> -0.6180339887}, {x -> 0.3819660113}, {x ->0.6180339887}, {x -> 1.618033989}, {x -> 2.618033989}} ※解

KleinSolve[x, (-2.618033989 + x) (-1.618033989 + x) (-0.6180339887 +x) (-0.3819660113 + x) (0.6180339887 + x) (1.618033989 + x) == 0]

{{x -> -1.618033989}, {x -> -0.6180339887}, {x -> 0.3819660113}, {x ->0.6180339887}, {x -> 1.618033989}, {x -> 2.618033989}} ※解

In[]:

\!\(TraditionalForm\`\[Phi] = FunctionExpand[GoldenRatio]\)

8.八次方程式を解く

f(x)=x⁸-10 x⁶+23 x⁴-10 x²+1

HermiteQuinticSolve[x, (-2.618033989 + x) (-1.618033989 +x) (-0.6180339887 + x) (-0.3819660113 + x) (0.3819660113 +x) (0.6180339887 + x) (1.618033989 + x) (2.618033989 + x) == 0]

{{x -> -2.618033989}, {x -> -1.618033989}, {x -> -0.6180339887}, {x -> -0.3819660113}, {x -> 0.3819660113}, {x -> 0.6180339887}, {x ->1.618033989}, {x -> 2.618033989}} ※解

KleinSolve[x, (-2.618033989 + x) (-1.618033989 + x) (-0.6180339887 +x) (-0.3819660113 + x) (0.3819660113 + x) (0.6180339887 +x) (1.618033989 + x) (2.618033989 + x) == 0]

{{x -> -2.618033989}, {x -> -1.618033989}, {x -> -0.6180339887}, {x-> -0.3819660113}, {x -> 0.3819660113}, {x -> 0.6180339887}, {x ->1.618033989}, {x -> 2.618033989}} ※解

In[]:

\!\(TraditionalForm\`\[Phi] = FunctionExpand[GoldenRatio]\)

\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\) = (1 - Sqrt[5])/2
g01 = Table[{GoldenRatio // TraditionalForm}]
g02 = Table[{FunctionExpand[GoldenRatio]}]
g03 = Table[{\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)}]
g04 = Table[{N[\[Phi]]}]
g05 = Table[{N[\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)]}]
g06 = Table[{N[\[Phi]^2]}]
g07 = Table[{N[\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2]}]
g08 = Table[{poly = Expand[(x - \[Phi]) (x + \[Phi]) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x - \[Phi]^2) (x + \\[Phi]^2) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2)]}]
g09 = Table[{poly // TraditionalForm}]
g10 = Table[{HermiteQuinticSolve[(x - \[Phi]) (x + \[Phi]) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x - \[Phi]^2) (x + \\[Phi]^2) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) == 0, x] // N // Chop //Sort}]
g11 = Table[{NSolve[(x - \[Phi]) (x + \[Phi]) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x - \[Phi]^2) (x + \\[Phi]^2) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) == 0, x] // Chop}]
g12 = Table[{KleinSolve[(x - \[Phi]) (x + \[Phi]) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x - \[Phi]^2) (x + \\[Phi]^2) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) == 0, x] // N // Chop //Sort}]
g13 = Table[{NSolve[(x - \[Phi]) (x + \[Phi]) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x - \[Phi]^2) (x + \\[Phi]^2) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) == 0, x]}]
TableOfValues1 =Prepend[{g01, g02, g03, g04, g05, g06, g07, g08, g09, g10, g11, g12,g13}, {"黄金比の八次方程式の解"}]
Grid[TableOfValues1]
TableOfValues2 =MapThread[Prepend, {TableOfValues1, {"\[Phi]関数","GoldenRatio//TraditionalForm", "\!\(\*FormBox[\(\[Phi]\),TraditionalForm]\)", "\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)","N[\[Phi]]", "N[\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)]","N[\!\(\*SuperscriptBox[\(\[Phi]\), \(2\)]\)]","N[\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\)]"," poly=Expand[(x-\[Phi])(x+\[Phi])(x-\!\(\*OverscriptBox[\(\[Phi]\)\,\(_\)]\))(x+\!\(\*OverscriptBox[\(\[Phi]\), \\(_\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x+\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x-\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))(x+\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))", "poly//TraditionalForm","HermiteQuinticSolve[(x-\[Phi])(x+\[Phi])(x-\!\(\*OverscriptBox[\(\\[Phi]\), \(_\)]\))(x+\!\(\*OverscriptBox[\(\[Phi]\), \\(_\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x-\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))==0,x]//N//Chop//Sort","NSolve[(x-\[Phi])(x+\[Phi])(x-\!\(\*OverscriptBox[\(\[Phi]\), \\(_\)]\))(x+\!\(\*OverscriptBox[\(\[Phi]\), \\(_\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x-\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))==0,x]//Chop","KleinSolve[(x-\[Phi])(x+\[Phi])(x-\!\(\*OverscriptBox[\(\[Phi]\),\\(_\)]\))(x+\!\(\*OverscriptBox[\(\[Phi]\), \\(_\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x-\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))==0,x]//N//Chop//Sort","NSolve[(x-\[Phi])(x+\[Phi])(x-\!\(\*OverscriptBox[\(\[Phi]\), \\(_\)]\))(x+\!\(\*OverscriptBox[\(\[Phi]\), \\(_\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x-\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))==0,x]"}}]
Grid[TableOfValues2, Frame -> All]

9.十次方程式を解く

f(x)= x¹⁰- 4 x⁹ -11 x⁸ + 40x⁷+ 33 x⁶- 92 x⁵- 33 x⁴ +40 x³ + 11 x²- 4 x-1

注：黄金比の代数方程式で、偶数の次数（6,8,10）の場合は係数が対照になる。ここにも黄金比の妙な値が出てくる。

HermiteQuinticSolve[x, (-4.236067977 + x) (-2.618033989 +x) (-1.618033989 + x) (-0.6180339887 + x) (-0.3819660113 +x) (0.2360679775 + x) (0.3819660113 + x) (0.6180339887 +x) (1.618033989 + x) (2.618033989 + x) == 0]

{{x -> -2.618033989}, {x -> -1.618033989}, {x -> -0.6180339887}, {x -> -0.3819660113}, {x -> -0.2360679775}, {x -> 0.3819660113}, {x ->0.6180339887}, {x -> 1.618033989}, {x -> 2.618033989}, {x ->4.236067977}} ※解

KleinSolve[x, (-4.236067977 + x) (-2.618033989 + x) (-1.618033989 +x) (-0.6180339887 + x) (-0.3819660113 + x) (0.2360679775 +x) (0.3819660113 + x) (0.6180339887 + x) (1.618033989 +x) (2.618033989 + x) == 0]

Out[]:

In[]:

\!\(TraditionalForm\`\[Phi] = FunctionExpand[GoldenRatio]\)

\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\) = (1 - Sqrt[5])/2
g01 = Table[{GoldenRatio // TraditionalForm}]
g02 = Table[{FunctionExpand[GoldenRatio]}]
g03 = Table[{\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)}]
g04 = Table[{N[\[Phi]]}]
g05 = Table[{N[\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)]}]
g06 = Table[{N[\[Phi]^2]}]
g07 = Table[{N[\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2]}]
g08 = Table[{N[\[Phi]^3]}]
g09 = Table[{N[\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^3]}]
g10 = Table[{poly = Expand[(x - \[Phi]) (x + \[Phi]) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x - \[Phi]^2) (x + \\[Phi]^2) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x - \[Phi]^3) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^3)]}]
g11 = Table[{poly // TraditionalForm}]
g12 = Table[{HermiteQuinticSolve[(x - \[Phi]) (x + \[Phi]) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x - \[Phi]^2) (x + \\[Phi]^2) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x - \[Phi]^3) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^3) == 0, x] // N // Chop //Sort}]
g13 = Table[{NSolve[(x - \[Phi]) (x + \[Phi]) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x - \[Phi]^2) (x + \\[Phi]^2) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x - \[Phi]^3) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^3) == 0, x] // Chop}]
g14 = Table[{KleinSolve[(x - \[Phi]) (x + \[Phi]) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x - \[Phi]^2) (x + \\[Phi]^2) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x - \[Phi]^3) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^3) == 0, x] // N // Chop //Sort}]
g15 = Table[{NSolve[(x - \[Phi]) (x + \[Phi]) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)) (x - \[Phi]^2) (x + \\[Phi]^2) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x +\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^2) (x - \[Phi]^3) (x -\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)^3) == 0, x]}]
TableOfValues1 =Prepend[{g01, g02, g03, g04, g05, g06, g07, g08, g09, g10, g11, g12,g13, g14, g15}, {"黄金比の十次方程式の解"}]
Grid[TableOfValues1]
TableOfValues2 =MapThread[Prepend, {TableOfValues1, {"\[Phi]関数","GoldenRatio//TraditionalForm", "\!\(\*FormBox[\(\[Phi]\),TraditionalForm]\)", "\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)","N[\[Phi]]", "N[\!\(\*OverscriptBox[\(\[Phi]\), \(_\)]\)]","N[\!\(\*SuperscriptBox[\(\[Phi]\), \(2\)]\)]","N[\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\)]", "N[\!\(\*SuperscriptBox[\(\[Phi]\), \(3\)]\)]","N[\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(3\)]\)]"," poly=Expand[(x-\[Phi])(x+\[Phi])(x-\!\(\*OverscriptBox[\(\[Phi]\)\, \(_\)]\))(x+\!\(\*OverscriptBox[\(\[Phi]\), \\(_\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x+\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x-\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))(x+\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(3\)]\))(x-\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(3\)]\))]", "poly//TraditionalForm","HermiteQuinticSolve[(x-\[Phi])(x+\[Phi])(x-\!\(\*OverscriptBox[\(\\[Phi]\), \(_\)]\))(x+\!\(\*OverscriptBox[\(\[Phi]\), \\(_\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x+\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x-\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))(x+\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(3\)]\))(x-\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(3\)]\))==0,x]//N//Chop//Sort","NSolve[(x-\[Phi])(x+\[Phi])(x-\!\(\*OverscriptBox[\(\[Phi]\), \\(_\)]\))(x+\!\(\*OverscriptBox[\(\[Phi]\), \\(_\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x+\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x-\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))(x+\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(3\)]\))(x-!\\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(3\)]\))==0,x]//Chop","KleinSolve[(x-\[Phi])(x+\[Phi])(x-\!\(\*OverscriptBox[\(\[Phi]\),\ \(_\)]\))(x+\!\(\*OverscriptBox[\(\[Phi]\), \\(_\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x+\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x-\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))(x+\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(3\)]\))(x-\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(3\)]\))==0,x]//N//Chop//Sort","NSolve[(x-\[Phi])(x+\[Phi])(x-\!\(\*OverscriptBox[\(\[Phi]\), \\(_\)]\))(x+\!\(\*OverscriptBox[\(\[Phi]\), \\(_\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x+\!\(\*SuperscriptBox[\(\[Phi]\), \\(2\)]\))(x-\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(2\)]\))(x+\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \
\(2\)]\))(x-\!\(\*SuperscriptBox[\(\[Phi]\), \\(3\)]\))(x-\!\(\*SuperscriptBox[OverscriptBox[\(\[Phi]\), \(_\)], \\(3\)]\))==0,x]"}}]
Grid[TableOfValues2, Frame -> All]

完

Mathematicaによる5次方程式解法の事始めⅣ

2025-07-07 | 数学

Mathematicaによる5次方程式解法の事始めⅣ

後日談
これ迄掲載した一次方程式から五次方程式の例題をHermite形式とKlein形式で解いた。最初からこの形式で解けば手っ取り早いが、今回は古代バビロニア（紀元前2000～600年）の昔から20世紀・前後迄の長い歴史の中で、代数方程式を学習し、その時代の解法で解いた。しかし、最後はそれらをHermite形式とF.Klein形式で解いた。

参考文献
正二十面体と5次方程式　F.クライン「著」　関口　次郎「訳」　シュプリンガー・フェアラーク東京（株）
注：100年前の本で、正二十面体とあるが画像は全く無い。正二十面体の面数、頂点座標数、辺数の関係式がハイライトになる、その恒等式が原書に度々登場する。この本の研究論文にはこの恒等式が記述されており、有名な式。この本は翻訳書であり、20世紀後半の参考文献も記載されている、訳者の文も参考になる、この本は、数学の宝の採石場で、玉を掘り当てるのは読者次第。その前に、代数方程式の歴史を述べ、Mathematicaで一から五次方程式を解く、係数a,b,c,d,eだけでは分かりにくいので、実際の例題を解く。特に、三次方程式以降は式の係数次第で解き方が異なるので、例題も数パターン必要だった。

F.クライン Felix Klein 1849.4.25-1925.6.22

Mathematicaによる5次方程式解法の事始めⅢからの続き

1次方程式から5次方程式をHermiteとKlein形式で解く。

1.Hermite形式と.F.クライン形式

1.a.Hermite形式

(*参考スクリプト：解を求めるには不要。*)

HermiteQuinticSolve[t_^5 - t_ + rho_ == 0, t_] :=Module[{k, b, q}, k = Tan[ArcSin[16/(25 5^(1/2) rho^2)]/4]; b = (k^2)^(1/8)/(2 5^(3/4) k^(1/2) (1 - k^2)^(1/2))* If[Re[rho] == 0, -Sign[Im[rho]], Sign[Re[rho]]]; q = EllipticNomeQ[k^2]; Map[{t -> #}&,{ b ((-1)^(3/4)*

(InverseEllipticNomeQ[q^(1/5)/E^((2*I)/5*Pi)]^(1/8) +I*InverseEllipticNomeQ[E^((2*I)/5*Pi)*q^(1/5)]^(1/8))*(InverseEllipticNomeQ[q^(1/5)/E^((4*I)/5*Pi)]^(1/8) +InverseEllipticNomeQ[E^((4*I)/5*Pi)*q^(1/5)]^(1/8))*(InverseEllipticNomeQ[q^(1/5)]^(1/8) +InverseEllipticNomeQ[q^5]^(1/8) q^(5/8)/(q^5)^(1/8))),b (-InverseEllipticNomeQ[q^(1/5)]^(1/8) + E^((3*I)/4*Pi)*InverseEllipticNomeQ[E^((2*I)/5*Pi)*q^(1/5)]^(1/8))*(InverseEllipticNomeQ[q^(1/5)/E^((2*I)/5*Pi)]^(1/8)/ E^((3*I)/4*Pi) +I*InverseEllipticNomeQ[E^((4*I)/5*Pi)*q^(1/5)]^(1/8))*I*InverseEllipticNomeQ[q^(1/5)/E^((4*I)/5*Pi)]^(1/8) +InverseEllipticNomeQ[q^5]^(1/8) q^(5/8)/(q^5)^(1/8)),

b (InverseEllipticNomeQ[q^(1/5)/E^((2*I)/5Pi)]^(1/8)/E^((3I)/4Pi) -I*InverseEllipticNomeQ[q^(1/5)/E^((4*I)/5*Pi)]^(1/8))*(-InverseEllipticNomeQ[q^(1/5)]^(1/8) -I*InverseEllipticNomeQ[E^((4*I)/5*Pi)*q^(1/5)]^(1/8))*(InverseEllipticNomeQ[E^((2*I)/5*Pi)*q^(1/5)]^(1/8)*E^((3*I)/4*Pi) +

InverseEllipticNomeQ[q^5]^(1/8) q^(5/8)/(q^5)^(1/8)),b (InverseEllipticNomeQ[q^(1/5)]^(1/8) -I*InverseEllipticNomeQ[q^(1/5)/E^((4*I)/5*Pi)]^(1/8))*(-InverseEllipticNomeQ[E^((2*I)/5*Pi)*q^(1/5)]^(1/8)*E^((3*I)/4*Pi) -I*InverseEllipticNomeQ[E^((4*I)/5*Pi)*q^(1/5)]^(1/8))*

(InverseEllipticNomeQ[q^(1/5)/E^((2*I)/5*Pi)]^(1/8)/E^((3*I)/4*Pi) +InverseEllipticNomeQ[q^5]^(1/8) q^(5/8)/(q^5)^(1/8)),b (InverseEllipticNomeQ[q^(1/5)]^(1/8) -InverseEllipticNomeQ[q^(1/5)/E^((2*I)/5*Pi)]^(1/8)/E^((3*I)/4*Pi))*(-InverseEllipticNomeQ[E^((2*I)/5*Pi)*q^(1/5)]^(1/8) *

E^((3*I)/4*Pi) +I*InverseEllipticNomeQ[q^(1/5)/E^((4*I)/5*Pi)]^(1/8))*(-I*InverseEllipticNomeQ[E^((4*I)/5*Pi)*q^(1/5)]^(1/8) +InverseEllipticNomeQ[q^5]^(1/8) q^(5/8)/(q^5)^(1/8)) } ]]

1.b.F.クライン形式

(*参考スクリプト：解を求めるには不要。*)

f[u_,v_]=u* v (u¹⁰+11 u⁵ v⁵-v¹⁰);

H[u_,v_]=-u²⁰-v²⁰+228(u¹⁵ v⁵-u⁵ v¹⁵)-494 u¹⁰ v¹⁰;

T[u_,v_]=u³⁰+v³⁰+522 (u²⁵ v⁵-u⁵ v²⁵)-10005 (u²⁰ v¹⁰+u¹⁰ v²⁰);

W[k_,u_,v_]=-e^(4k) u⁸+e^(3k) u⁷ v-7 e^(2k) u⁶ v²-7 e^k u⁵ v³+7 e^(4k) u³ v⁵-7 e^(3k) u² v⁶-e^(2k) u v⁷-e^k v⁸;

t[k_,u_,v_]=e^(3k) u⁶+2 e^(2k) u⁵ v-5 e^k u⁴ v²-5e^(4k) u² v⁴-2 e^(3k) u v⁵+e^(2k) v⁶;

e=Exp[2Pi I/5];

u[Z_]:=(12)^(1/20) 1/(1728Z)^(1/60)*Hypergeometric2F1[-1/60,29/60,4/5,1728 Z];

v[Z_]:=1/(12^11)^(1/20) (1/(1728 Z))^(-11/60)*Hypergeometric2F1[11/60,41/60,6/5,1728 Z];

{a V==8 l³+l² m+72 l m² Z+m³ Z,b V==-l⁴+18 l² m² Z+l m³ Z+27 m⁴ Z²,c V==l⁵-10 l³ m² Z+45 l m⁴ Z²+m⁵ Z²,1+V Z==1728 Z}

lhsIcoEq[u_,v_,Z_]:=u⁵ v⁵ (u^10+11 u^5 v^5-v^10)⁵-(u^30+v^30-10005 (u^20 v^10+u^10 v^20)+522 (u^25 v^5-u^5 v^25))² Z

lhsIcoEq[z,1,Z]

lhsIcoEq[N[u[2.-0.7I]],N[v[2.-0.7I]],2.-0.7I]//Chop

KleinSolve[p_==0,y_]:=Module[{a,b,c,n,l,m,w,Z,fm,Hm,Tm,um,vm,sol},{a,b,c}=({1/5,1/5,1} (Coefficient[p,y,#]&/@{2,1,0}))/Coefficient[p,y,5];

l=(-#2/#1/2+Sqrt[#2²/#1²/4-#3/#1])&[(a⁴+a b c-b³),-(11a³ b-a c²+2b² c),(64 a² b²-27a³ c-b c²)];

w=(l b+c)/a;V=(l^2-3w)³/(l c-w b);

Z=1/(1728-V);m=(V a-8 l³-72 l w)/(l²+w);

um=u[Z];vm=v[Z];fm=f[um,vm];

Hm=H[um,vm];Tm=T[um,vm];

{y->#}&/@Sort[Table[l fm W[k,um,vm]/Hm+m fm³ t[k,um,vm] W[k,um,vm]/Tm/Hm,{k,0,4}]]]/;MatchQ[CoefficientList[p,y],{_,_,_,0,0,_}]

2.1次方程式
f (x) = 2 x - 3

In[]:
HermiteQuinticSolve[2 x - 3 == 0, x] // N // Chop // Sort
NSolve[2 x - 3 == 0, x] // Chop
KleinSolve[2 x - 3 == 0, x] // N // Chop // Sort
NSolve[2 x - 3 == 0, x]

Out[]:

HermiteQuinticSolve[x, -3. + 2. x == 0]

{{x -> 1.5}} ※解

KleinSolve[x, -3. + 2. x == 0]

{{x -> 1.5}} ※解

3.2次方程式
f (x) = f(x)=2 x²+5 x-3

In[]:
HermiteQuinticSolve[2 x²+5 x-3 == 0, x] // N // Chop // Sort
NSolve[2 x²+5 x-3 == 0, x] // Chop
KleinSolve[2 x²+5 x-3 == 0, x] // N // Chop // Sort
NSolve[2 x²+5 x-3 == 0, x]

Out[]:

HermiteQuinticSolve[x, -3. + 5. x + 2. x² == 0]

{{x -> -3.}, {x -> 0.5}} ※解

KleinSolve[x, -3. + 5. x + 2.x² == 0]

{{x -> -3.}, {x -> 0.5}} ※解

4.3次方程式:例題は3パターンある。
4.1.Ex1
Case ∆=0の場合。※∆=f²-4m³

f(x)=x³- 4x²+5x-2

In[]:
HermiteQuinticSolve[x³- 4x²+5x-2 == 0, x] // N // Chop // Sort
NSolve[x³- 4x²+5x-2 == 0, x] // Chop
KleinSolve[x³- 4x²+5x-2 == 0, x] // N // Chop // Sort
NSolve[x³- 4x²+5x-2 == 0, x]

Out[]:

HermiteQuinticSolve[x, -2. + 5. x - 4. x² + x³ == 0]

{{x -> 1.}, {x -> 1.}, {x -> 2.}} ※解

KleinSolve[x, -2. + 5. x - 4. x² + x³ == 0]

{{x -> 1.}, {x -> 1.}, {x -> 2.}} ※解　

4.2.Ex2
Case ∆>0の場合。※∆=f²-4m³

f (x) =x³+5.2x²+7.5x-2.74

In[]:
HermiteQuinticSolve[x³+5.2x²+7.5x-2.74 == 0, x] // N //Chop // Sort
NSolve[x³+5.2x²+7.5x-2.74 == 0, x] // Chop
KleinSolve[x³+5.2x²+7.5x-2.74 == 0, x] // N // Chop // Sort
NSolve[x³+5.2x²+7.5x-2.74== 0, x]

Out[]:

HermiteQuinticSolve[x, -2.74 + 7.5 x + 5.2 x² + x³== 0]

{{x -> -2.749770373 - 1.259404395 I}, {x -> -2.749770373 +1.259404395 I}, {x -> 0.299540745}} ※解　Iは虚数

KleinSolve[x, -2.74 + 7.5 x + 5.2 x² + x³ == 0]

{{x -> -2.749770373 - 1.259404395 I}, {x -> -2.749770373 +1.259404395 I}, {x -> 0.299540745}} ※解　Iは虚数

4.3.Ex3
f(x)=x³+8.1x²+17.2x+6.4

In[]:

HermiteQuinticSolve[x³+8.1x²+17.2x+6.4== 0, x] // N //Chop // Sort
NSolve[x³+8.1x²+17.2x+6.4 == 0, x] // Chop
KleinSolve[x³+8.1x²+17.2x+6.4 == 0, x] // N // Chop // Sort
NSolve[x³+8.1x²+17.2x+6.4 == 0, x]

Out[]:

HermiteQuinticSolve[x, 6.4 + 17.2 x + 8.1 x² + x³ == 0]

{{x -> -4.784878851}, {x -> -2.844977995}, {x -> -0.4701431535}} ※解

KleinSolve[x, 6.4 + 17.2 x + 8.1 x² + x³ == 0]

{{x -> -4.784878851}, {x -> -2.844977995}, {x -> -0.4701431535}} ※解

5.4次方程式:例題は4パターンある。
5.1.Ex1

f(x)=x⁴-2x³-25x²+26x+120
In[]:
HermiteQuinticSolve[x⁴-2x³-25x²+26x+120 == 0, x] // N //Chop // Sort
NSolve[x⁴-2x³-25x²+26x+120== 0, x] // Chop
KleinSolve[x⁴-2x³-25x²+26x+120 == 0, x] // N //Chop // Sort
NSolve[x⁴-2x³-25x²+26x+120 == 0, x]

Out[]:

HermiteQuinticSolve[x, 120. + 26. x - 25. x² - 2. x³ + x⁴ == 0]

{{x -> -4.}, {x -> -2.}, {x -> 3.}, {x -> 5.}} ※解

KleinSolve[x, 120. + 26. x - 25.x² - 2. x³ + x⁴ == 0]

{{x -> -4.}, {x -> -2.}, {x -> 3.}, {x -> 5.}} ※解

5.2.Ex2
f(x)= x⁴-4x³-16x+35

In[]:
HermiteQuinticSolve[x⁴-4x³-16x+35 == 0, x] // N //Chop // Sort
NSolve[x⁴-4x³-16x+35== 0, x] // Chop
KleinSolve[x⁴-4x³-16x+35 == 0, x] // N // Chop // Sort
NSolve[x⁴-4x³-16x+35 == 0, x]

Out[]:

HermiteQuinticSolve[x, 35. - 16. x - 4. x³ + x⁴ == 0]

{{x -> -1. - 2. I}, {x -> -1. + 2. I}, {x -> 1.585786438}, {x ->4.414213562}} ※解　Iは虚数

KleinSolve[x, 35. - 16. x - 4. x³ + x⁴ == 0]

{{x -> -1. - 2. I}, {x -> -1. + 2. I}, {x -> 1.585786438}, {x ->4.414213562}} ※解　Iは虚数

5.3.Ex3
f(x)= x⁴-12x²+8x+12

In[]:
HermiteQuinticSolve[x⁴-12x²+8x+12 == 0, x] // N //Chop // Sort
NSolve[x⁴-12x²+8x+12 == 0, x] // Chop
KleinSolve[x⁴-12x²+8x+12 == 0, x] // N // Chop // Sort
NSolve[x⁴-12x²+8x+12 == 0, x]

Out[]:

HermiteQuinticSolve[x, 12. + 8. x - 12. x² + x⁴ == 0]

{{x -> -3.645751311}, {x -> -0.7320508076}, {x -> 1.645751311}, {x ->2.732050808}} ※解

KleinSolve[x, 12. + 8. x - 12.x² +x⁴ == 0]

{{x -> -3.645751311}, {x -> -0.7320508076}, {x -> 1.645751311}, {x ->2.732050808}} ※解

5.4.Ex4
f(x)= x⁴+4x³-4x²+12

In[]:
HermiteQuinticSolve[x⁴+4x³-4x²+12 == 0, x] // N //Chop // Sort
NSolve[x⁴+4x³-4x²+12 == 0, x] // Chop
KleinSolve[x⁴+4x³-4x²+12 == 0, x] // N // Chop // Sort
NSolve[x⁴+4x³-4x²+12 == 0, x]

Out[]:

HermiteQuinticSolve[x, 12. - 4. x² + 4. x³ + x⁴ == 0]

{{x -> -4.732050808}, {x -> -1.267949192}, {x -> 1. - 1. I}, {x ->1. + 1. I}} ※解　Iは虚数

KleinSolve[x, 12. - 4. x² + 4. x³ + x⁴ == 0]

{{x -> -4.732050808}, {x -> -1.267949192}, {x -> 1. - 1. I}, {x ->1. + 1. I}} ※解　Iは虚数

6.5次方程式:例題は2パターンある。
6.1.Ex1

f(x)=x⁵ - 2 x⁴ - x³ + 6 x - 4

In[]:

HermiteQuinticSolve[x⁵ - 2 x⁴ - x³ + 6 x - 4 == 0, x] // N //Chop // Sort
NSolve[x⁵ - 2 x⁴ - x³ + 6 x - 4 == 0, x] // Chop
KleinSolve[x⁵ - 2 x⁴ - x³ + 6 x - 4 == 0, x] // N // Chop // Sort
NSolve[x⁵ - 2 x⁴ - x³ + 6 x - 4 == 0, x]

Out[]:

HermiteQuinticSolve[x, -4. + 6. x - 1. x³ - 2. x⁴ + x⁵ == 0]

{{x -> -1. + 1. I}, {x -> -1. - 1. I}, {x -> 1.}, {x -> 1.}, {x ->2.}} ※解　Iは虚数

KleinSolve[x, -4. + 6. x - 1. x³ - 2. x⁴ + x⁵ == 0]

{{x -> -1. + 1. I}, {x -> -1. - 1. I}, {x -> 1.}, {x -> 1.}, {x ->2.}} ※解　Iは虚数

6.2.Ex2

f(x)=x⁵ - 2 x⁴ - 2x³+2x²+ 6 x - 4

In[]:

HermiteQuinticSolve[x⁵ - 2 x⁴ - 2x³+2x²+ 6 x - 4 == 0, x] // N //Chop // Sort
NSolve[x⁵ - 2 x⁴ - 2x³+2x²+ 6 x - 4== 0, x] // Chop
KleinSolve[x⁵ - 2 x⁴ - 2x³+2x²+ 6 x - 4 == 0, x] // N // Chop // Sort
NSolve[x⁵ - 2 x⁴ - 2x³+2x²+ 6 x - 4 == 0, x]

Out[]:

HermiteQuinticSolve[x, -4. + 6. x+ 2.x²- 2. x³ - 2. x⁴ + x⁵ == 0]

{{x -> -1.114379327 - 0.830976257 I}, {x -> -1.114379327 +0.830976257 I}, {x -> 0.6595838031}, {x -> 1.569174852}, {x ->2.}} ※解　Iは虚数

KleinSolve[x, -4. + 6. x+ 2.x²- 2. x³ - 2. x⁴ + x⁵ == 0]

{{x -> -1.114379327 - 0.830976257 I}, {x -> -1.114379327 +0.830976257 I}, {x -> 0.6595838031}, {x -> 1.569174852}, {x ->2.}} ※解　Iは虚数

続編：Mathematicaによる5次方程式解法の事始めⅤ

Mathematicaによる5次方程式解法の事始めⅤ

2025-07-01 | 数学

Mathematicaによる5次方程式解法の事始めⅤ
はじめに
Mathematicaによる5次方程式解法の事始めで1次から5次方程式の解を求めた。Mathematicaによる5次方程式解法の事始めⅣ迄は代数方程式の解を求めたが、今回はそれとは異なる。黄金比の解は既に既知なので、それを代数方程式に当てはめた。今回は更に、それを発展してHermite形式と.F.クライン形式で黄金比の1次から10次方程式を解いた。3次方程式のタルタリア形式及び4次方程式のフェラーリ形式を使う事なく、全てHermite形式と.F.クライン形式で解が求まる。この手法はタルタリア形式及びフェラーリ形式よりも入力スクリプトが短くなる。Mathematicaによる5次方程式解法の事始めⅠで記述したように16世紀のイタリアのニッコロタルタリアNiccolo Tartaglia (1500年–1557年)とルドヴィコ・フェラーリLodovico Ferrari（1522年–1565年）の時代からF.クライン Felix Klein（1849.4.25-1925.6.22）とシャルル・エルミート Charles Hermite(1822.12.24–1901.1.14)の20世紀・前後に時代が進み、数学が格段に進歩した。その強力なツールで高次方程式も扱えるようになった。

F.クライン Felix Klein 1849.4.25-1925.6.22

シリーズ物

Mathematicaで正多面体の黄金比の事始め

Mathematicaによる5次方程式解法の事始めⅣからの続き

1.Hermite形式と.F.クライン形式

1.a.Hermite形式

(*参考スクリプト：解を求めるには不要。*)

E^((3*I)/4*Pi) +I*InverseEllipticNomeQ[q^(1/5)/E^((4*I)/5*Pi)]^(1/8))*(-I*InverseEllipticNomeQ[E^((4*I)/5*Pi)*q^(1/5)]^(1/8) +InverseEllipticNomeQ[q^5]^(1/8) q^(5/8)/(q^5)^(1/8)) } ]]

1.b.F.クライン形式

(*参考スクリプト：解を求めるには不要。*)

f[u_,v_]=u* v (u¹⁰+11 u⁵ v⁵-v¹⁰);

H[u_,v_]=-u²⁰-v²⁰+228(u¹⁵ v⁵-u⁵ v¹⁵)-494 u¹⁰ v¹⁰;

T[u_,v_]=u³⁰+v³⁰+522 (u²⁵ v⁵-u⁵ v²⁵)-10005 (u²⁰ v¹⁰+u¹⁰ v²⁰);

W[k_,u_,v_]=-e^(4k) u⁸+e^(3k) u⁷ v-7 e^(2k) u⁶ v²-7 e^k u⁵ v³+7 e^(4k) u³ v⁵-7 e^(3k) u² v⁶-e^(2k) u v⁷-e^k v⁸;

t[k_,u_,v_]=e^(3k) u⁶+2 e^(2k) u⁵ v-5 e^k u⁴ v²-5e^(4k) u² v⁴-2 e^(3k) u v⁵+e^(2k) v⁶;

e=Exp[2Pi I/5];

u[Z_]:=(12)^(1/20) 1/(1728Z)^(1/60)*Hypergeometric2F1[-1/60,29/60,4/5,1728 Z];

v[Z_]:=1/(12^11)^(1/20) (1/(1728 Z))^(-11/60)*Hypergeometric2F1[11/60,41/60,6/5,1728 Z];

{a V==8 l³+l² m+72 l m² Z+m³ Z,b V==-l⁴+18 l² m² Z+l m³ Z+27 m⁴ Z²,c V==l⁵-10 l³ m² Z+45 l m⁴ Z²+m⁵ Z²,1+V Z==1728 Z}

lhsIcoEq[u_,v_,Z_]:=u⁵ v⁵ (u^10+11 u^5 v^5-v^10)⁵-(u^30+v^30-10005 (u^20 v^10+u^10 v^20)+522 (u^25 v^5-u^5 v^25))² Z

lhsIcoEq[z,1,Z]

lhsIcoEq[N[u[2.-0.7I]],N[v[2.-0.7I]],2.-0.7I]//Chop

KleinSolve[p_==0,y_]:=Module[{a,b,c,n,l,m,w,Z,fm,Hm,Tm,um,vm,sol},{a,b,c}=({1/5,1/5,1} (Coefficient[p,y,#]&/@{2,1,0}))/Coefficient[p,y,5];

l=(-#2/#1/2+Sqrt[#2²/#1²/4-#3/#1])&[(a⁴+a b c-b³),-(11a³ b-a c²+2b² c),(64 a² b²-27a³ c-b c²)];

w=(l b+c)/a;V=(l^2-3w)³/(l c-w b);

Z=1/(1728-V);m=(V a-8 l³-72 l w)/(l²+w);

um=u[Z];vm=v[Z];fm=f[um,vm];

Hm=H[um,vm];Tm=T[um,vm];

{y->#}&/@Sort[Table[l fm W[k,um,vm]/Hm+m fm³ t[k,um,vm] W[k,um,vm]/Tm/Hm,{k,0,4}]]]/;MatchQ[CoefficientList[p,y],{_,_,_,0,0,_}]

2.一次方程式を解く

f(x)=x - (1+Sqrt[5])/2

Out[]:

HermiteQuinticSolve[x, -1.618033989 + x == 0]

{{x -> 1.618033989}} ※解

KleinSolve[x, -1.618033989 + x == 0]

{{x -> 1.618033989}} ※解

In[]:

\!\(TraditionalForm\`\[Phi] = FunctionExpand[GoldenRatio]\)
g01 = Table[{GoldenRatio // TraditionalForm}]
g02 = Table[{FunctionExpand[GoldenRatio]}]
g03 = Table[{N[\[Phi]]}]
g04 = Table[{HermiteQuinticSolve[(x - \[Phi]) == 0, x] // N // Chop //Sort}]
g05 = Table[{NSolve[(x - \!\(TraditionalForm\`\[Phi]\)) == 0, x] //Chop}]
g06 = Table[{KleinSolve[(x - \[Phi]) == 0, x] // N // Chop // Sort}]
g07 = Table[{NSolve[(x - \[Phi]) == 0, x]}]
TableOfValues1 =Prepend[{g01, g02, g03, g04, g05, g06, g07}, {"黄金比の一次方程式の解"}]
Grid[TableOfValues1]
TableOfValues2 =MapThread[Prepend, {TableOfValues1, {"\[Phi]関数","GoldenRatio//TraditionalForm", "\!\(\*FormBox[\(\[Phi]\),TraditionalForm]\)", "N[\[Phi]]","HermiteQuinticSolve[(x-\[Phi])==0,x]//N//Chop//Sort","NSolve[(x-\!\(\*FormBox[\(\[Phi]\),TraditionalForm]\)) ==0,x]//Chop",
"KleinSolve[(x-\[Phi])==0,x]//N//Chop//Sort","NSolve[(x-\[Phi])==0,x]"}}]
Grid[TableOfValues2, Frame -> All]

3.二次方程式を解く

f(x)=x²-x-1

HermiteQuinticSolve[x, (-1.618033989 + x) (0.6180339887 + x) == 0]

{{x -> -0.6180339887}, {x -> 1.618033989}} ※解

KleinSolve[x, (-1.618033989 + x) (0.6180339887 + x) == 0]

{{x -> -0.6180339887}, {x -> 1.618033989}} ※解

Out[]:

In[]:

\!\(TraditionalForm\`\[Phi] = FunctionExpand[GoldenRatio]\)

4.三次方程式を解く

x³+x²+(5 Sqrt[5]/2-13/2)x-3 Sqrt[5]/2+7/2

HermiteQuinticSolve[x, (-2.618033989 + x) (-1.618033989 +x) (0.6180339887 + x) == 0]

{{x -> -0.6180339887}, {x -> 1.618033989}, {x -> 2.618033989}} ※解

KleinSolve[x, (-2.618033989 + x) (-1.618033989 + x) (0.6180339887 +x) == 0]

{{x -> -0.6180339887}, {x -> 1.618033989}, {x -> 2.618033989}} ※解

In[]:

\!\(TraditionalForm\`\[Phi] = FunctionExpand[GoldenRatio]\)

5.四次方程式を解く

f(x)=x⁴-4 x³+3x²+2 x-1

HermiteQuinticSolve[x, (-2.618033989 + x) (-1.618033989 +x) (-0.3819660113 + x) (0.6180339887 + x) == 0]

{{x -> -0.6180339887}, {x -> 0.3819660113}, {x -> 1.618033989}, {x ->2.618033989}} ※解

KleinSolve[x, (-2.618033989 + x) (-1.618033989 + x) (-0.3819660113 +x) (0.6180339887 + x) == 0]

{{x -> -0.6180339887}, {x -> 0.3819660113}, {x -> 1.618033989}, {x ->2.618033989}} ※解

In[]:

\!\(TraditionalForm\`\[Phi] = FunctionExpand[GoldenRatio]\)

6.五次方程式を解く

f(x)= x⁵+ (-2 + Sqrt[5]) x⁴ -3 x³+(6 - 3 Sqrt[5])x²+x-2 + Sqrt[5]

HermiteQuinticSolve[x, (-1.618033989 + x) (-0.6180339887 +x) (0.2360679775 + x) (0.6180339887 + x) (1.618033989 + x) == 0]

{{x -> -1.618033989}, {x -> -0.6180339887}, {x -> -0.2360679775}, {x -> 0.6180339887}, {x -> 1.618033989}} ※解

KleinSolve[x, (-1.618033989 + x) (-0.6180339887 + x) (0.2360679775 +x) (0.6180339887 + x) (1.618033989 + x) == 0]

{{x -> -1.618033989}, {x -> -0.6180339887}, {x -> -0.2360679775}, {x -> 0.6180339887}, {x -> 1.618033989}} ※解

Out[]:

In[]:

\!\(TraditionalForm\`\[Phi] = FunctionExpand[GoldenRatio]\)

続編：Mathematicaによる5次方程式解法の事始めⅥ

Mathematicaによる5次方程式解法の事始めⅢ

2025-06-21 | 数学

Mathematicaによる5次方程式解法の事始めⅢ

はじめに
　Mathematicaで描く正多面体と素数の事始め等正多面体シリーズをMathematicaで記述した。ここではF.クラインの正二十面体と五次方程式を記述する。しかしこれは手強いので代数方程式の事始めから記述する。相当な字数になり、goo blogの字数制限と言う大人の事情でVol.I~Vol.Ⅶに分割した。

参考文献
正二十面体と5次方程式　F.クライン「著」　関口　次郎「訳」　シュプリンガー・フェアラーク東京（株）
注：100年前の本で、正二十面体とあるが画像は全く無い。正二十面体の面数、頂点座標数、辺数の関係式がハイライトになる、その恒等式が原書に度々登場する。この本の研究論文にはこの恒等式が記述されており、有名な式。この本は翻訳書であり、20世紀後半の参考文献も記載されている、訳者の文も参考になる、この本は、数学の宝の採石場で、玉を掘り当てるのは読者次第。その前に、代数方程式の歴史を述べ、Mathematicaで一から五次方程式を解く、係数a,b,c,d,eだけでは分かりにくいので、実際の例題を解く。特に、三次方程式以降は式の係数次第で解き方が異なるので、例題も数パターン必要になる。

F.クライン Felix Klein 1849.4.25-1925.6.22

Mathematicaによる5次方程式解法の事始めⅡからの続き

2.5 Mathematicaで5次方程式を解く

2.5.1.Hermite形式で解く。

Hermite形式t⁵ - t + rho = 0 を解く。

(*参考スクリプト：解を求めるには不要。*)

E^((3*I)/4*Pi) +I*InverseEllipticNomeQ[q^(1/5)/E^((4*I)/5*Pi)]^(1/8))*(-I*InverseEllipticNomeQ[E^((4*I)/5*Pi)*q^(1/5)]^(1/8) +InverseEllipticNomeQ[q^5]^(1/8) q^(5/8)/(q^5)^(1/8)) } ]]

In[]:

HermiteQuinticSolve[t⁵-t+I == 0, t] //N // Chop // Sort

NSolve[t⁵-t+I == 0, t] // Chop

Out[]:

HermiteQuinticSolve[t,(0. +1. I)-1. t+t⁵==0]

{{t->-1.08395-0.181232 I},{t->-0.352472+0.764884 I},{t->0. -1.1673 I},{t->0.352472 +0.764884 I},{t->1.08395 -0.181232 I}}　※解　Iは虚数

2.5.2.F.クライン形式で解く。

F.クライン形式y⁵+5.I y²-12. y+1.-I=0を解く。Iは虚数

(*参考スクリプト：解を求めるには不要。*)

f[u_,v_]=u* v (u¹⁰+11 u⁵ v⁵-v¹⁰);

H[u_,v_]=-u²⁰-v²⁰+228(u¹⁵ v⁵-u⁵ v¹⁵)-494 u¹⁰ v¹⁰;

T[u_,v_]=u³⁰+v³⁰+522 (u²⁵ v⁵-u⁵ v²⁵)-10005 (u²⁰ v¹⁰+u¹⁰ v²⁰);

W[k_,u_,v_]=-e^(4k) u⁸+e^(3k) u⁷ v-7 e^(2k) u⁶ v²-7 e^k u⁵ v³+7 e^(4k) u³ v⁵-7 e^(3k) u² v⁶-e^(2k) u v⁷-e^k v⁸;

t[k_,u_,v_]=e^(3k) u⁶+2 e^(2k) u⁵ v-5 e^k u⁴ v²-5e^(4k) u² v⁴-2 e^(3k) u v⁵+e^(2k) v⁶;

e=Exp[2Pi I/5];

u[Z_]:=(12)^(1/20) 1/(1728Z)^(1/60)*Hypergeometric2F1[-1/60,29/60,4/5,1728 Z];

v[Z_]:=1/(12^11)^(1/20) (1/(1728 Z))^(-11/60)*Hypergeometric2F1[11/60,41/60,6/5,1728 Z];

{a V==8 l³+l² m+72 l m² Z+m³ Z,b V==-l⁴+18 l² m² Z+l m³ Z+27 m⁴ Z²,c V==l⁵-10 l³ m² Z+45 l m⁴ Z²+m⁵ Z²,1+V Z==1728 Z}

lhsIcoEq[u_,v_,Z_]:=u⁵ v⁵ (u^10+11 u^5 v^5-v^10)⁵-(u^30+v^30-10005 (u^20 v^10+u^10 v^20)+522 (u^25 v^5-u^5 v^25))² Z

lhsIcoEq[z,1,Z]

lhsIcoEq[N[u[2.-0.7I]],N[v[2.-0.7I]],2.-0.7I]//Chop

KleinSolve[p_==0,y_]:=Module[{a,b,c,n,l,m,w,Z,fm,Hm,Tm,um,vm,sol},{a,b,c}=({1/5,1/5,1} (Coefficient[p,y,#]&/@{2,1,0}))/Coefficient[p,y,5];

l=(-#2/#1/2+Sqrt[#2²/#1²/4-#3/#1])&[(a⁴+a b c-b³),-(11a³ b-a c²+2b² c),(64 a² b²-27a³ c-b c²)];

w=(l b+c)/a;V=(l^2-3w)³/(l c-w b);

Z=1/(1728-V);m=(V a-8 l³-72 l w)/(l²+w);

um=u[Z];vm=v[Z];fm=f[um,vm];

Hm=H[um,vm];Tm=T[um,vm];

{y->#}&/@Sort[Table[l fm W[k,um,vm]/Hm+m fm³ t[k,um,vm] W[k,um,vm]/Tm/Hm,{k,0,4}]]]/;MatchQ[CoefficientList[p,y],{_,_,_,0,0,_}]

In[]:

KleinSolve[y⁵+5.I y²-12. y+1.-I==0,y]//N//Chop//Sort

NSolve[y⁵+5.I y²-12. y+1.-I==0,y]

Out[]:

{{y->-1.90456-0.333135 I},{y->-0.0430531-1.43083 I},{y->-0.0120031+2.20094 I},{y->0.0895118 -0.0828539 I},{y->1.87011 -0.354121 I}}　※解　Iは虚数

2.5.3a.一般の五次方程式をHermite形式と.F.クライン形式で解く。

f(x)=x⁵ - 2 x⁴ - x³ + 6 x - 4

In[]:

Out[]:

HermiteQuinticSolve[x, -4. + 6. x - 1. x³ - 2. x⁴ + x⁵ == 0]

{{x -> -1. + 1. I}, {x -> -1. - 1. I}, {x -> 1.}, {x -> 1.}, {x ->2.}} ※解　Iは虚数

KleinSolve[x, -4. + 6. x - 1. x³ - 2. x⁴ + x⁵ == 0]

{{x -> -1. + 1. I}, {x -> -1. - 1. I}, {x -> 1.}, {x -> 1.}, {x ->2.}} ※解　Iは虚数

2.5.3b.一般の五次方程式をHermite形式と.F.クライン形式で解く。

f(x)=x⁵ - 2 x⁴ - 2x³+2x²+ 6 x - 4

In[]:

Out[]:

HermiteQuinticSolve[x, -4. + 6. x+ 2.x²- 2. x³ - 2. x⁴ + x⁵ == 0]

{{x -> -1.114379327 - 0.830976257 I}, {x -> -1.114379327 +0.830976257 I}, {x -> 0.6595838031}, {x -> 1.569174852}, {x ->2.}} ※解　Iは虚数

KleinSolve[x, -4. + 6. x+ 2.x²- 2. x³ - 2. x⁴ + x⁵ == 0]

{{x -> -1.114379327 - 0.830976257 I}, {x -> -1.114379327 +0.830976257 I}, {x -> 0.6595838031}, {x -> 1.569174852}, {x ->2.}} ※解　Iは虚数

3.F.クラインの恒等式の導入

3.1.正二十面体Icosahedronの場合

f=12(*頂点数*)

H=20(*面数*)

T=30(*辺数*)

1728=12³

degree 60

In[]:

f = u*v (u¹⁰ +11u⁵v⁵- v¹⁰)
H = -(u²⁰ + v²⁰) + 228(u¹⁵v⁵- u⁵v¹⁵ )- 494u¹⁰v¹⁰
T =(u³⁰ + v³⁰) + 522(u²⁵v⁵- u⁵v²⁵ )- 10005(u²⁰ v¹⁰+u¹⁰v²⁰)

Print["1728f⁵-H³-T²=",Expand[1728f⁵-H³-T²]]

Out[]:

1728f⁵-H³-T²=0

3.2.正八面体Octahedronの場合

f=6(*頂点数*)

H=8(*面数*)

T=12(*辺数*)

degree 24

In[]:

f = u*v (u⁴ - v⁴)
H = u⁸ + 14 u⁴ v⁴ + v⁸
T = u¹² - 33 u⁸ v⁴- 33u⁴ v⁸ + v¹²
Print["108 f⁴ - H³ + T²=",Expand[108 f⁴ - H³ + T²]]

Out[]:

108 f⁴ - H³ + T²=0

続編：Mathematicaによる5次方程式解法の事始めⅣ

Mathematicaによる5次方程式解法の事始めⅡ

2025-06-21 | 数学

Mathematicaによる5次方程式解法の事始めⅡ

F.クライン Felix Klein 1849.4.25-1925.6.22

Mathematicaによる5次方程式解法の事始めⅠからの続き

2. 3.Mathematicaで3次方程式を解く

3次方程式を解くのは面倒くさいが、タルタリアのお陰で解けるようになった。例題は3パターンある。

例題2.3.2.

Case ∆>0の場合。※∆=f²-4m³

f(x)=x³+5.2x²+7.5x-2.74

In[]:

f(x)=x³+x²*b+x*c+d

(α+y)³+b (α+y)²+c(α+y)+d

α³+y³+3α²*y+3α*y²+b*α²+b*y²+2b*α*y+c*α+c*y+d

α³+y³+(3α+b)y²+3α²*y+b*α²+2b*α*y+c*α+c*y+d

f(α)=α³+b*α²+c*α+d

f(x)=x³+x²*b+x*c+d

f(x)=x³+5.2x²+7.5x\[Minus]2.7

b=5.2

c=7.5

d=-2.7

α=-b/3

y=p+q

α=\[Minus]b/3(*(5)*)

y³+(3α²+2b*α+c)y+α³+b*α²+c*α+d

p³+q³+3p*q(p+q)+(3α²+2b*α+c)(p+q)+f (α)

(p+q)(3p*q+3α²+2b*α+c)+p³+q³+f(α)

p*q=\[Minus](3α²+2b*α+c)/3=(b²\[Minus]3c)/9

m=(b²\[Minus]3c)/9(*(12)*)

2b³\[Minus]9b*c+27d

f=f(α)=α³+b*α²+c*α+d=(2b³\[Minus]9b*c+27d)/27

p³+q³=-f

p³*q³=m³

z₁=p³

z₂=q³

\[Minus](z₁+z₂)=f

z₁*z₂=m³

z²+f*z+m³

∆=f²-4m³

z₁=(-f+Sqrt[f²-4m³])/2

z₂=(-f-Sqrt[f²-4m³])/2

p^3_i=z₁*e^(2πi)I

q^3_j=z₂*e^(2πj)I

p_i=(Subscript[z, 1]*e^((2πi)I))^1/3=(Subscript[z, 1])^1/3*e^(2πi)I/3

q_j=(Subscript[z, 2]*e^((2πj)I))^1/3=(Subscript[z, 2])^1/3*e^(2πj)I/3

p_i*q_j==((Subscript[z, 1])^1/3*e^(2πi)I/3)((Subscript[z, 2])^1/3*e^(2πj)I/3)=(Subscript[z, 1] Subscript[z, 2])^1/3*e^{(2π(i+j))I/3}=m*e^{(2π(i+j))I/3}

p_i*q_j=m

e^{(2π(i+j))I/3}=1

e^{(2π(0+0))I/3}=1

x₀=-b/3+p₀+q₀=-b/3+(Subscript[z, 1])^1/3+(Subscript[z, 2])^1/3

i=1

j=2

e^{(2π(1+2))I/3}=1

x₁=-b/3+p₁+q₁=-b/3+(Subscript[z, 1])^1/3*e^(2πI)/3+(Subscript[z, 2])^1/3*e^(4πI)/3=-b/3-((Subscript[z, 1])^1/3+(Subscript[z, 2])^1/3)/2+Sqrt[3]((Subscript[z, 1])^1/3-(Subscript[z, 2])^1/3)*I/2(*(35)*)

(*(i=2,j=1)\[DoubleRightArrow](e^((2π(2+1))I/3)=1)(36)*)

i=2

j=1

e^{(2π(2+1))I/3}=1

x₂=-b/3+p₂+q₂=-b/3+(Subscript[z, 1])^1/3*e^(4πI)/3+(Subscript[z, 2])^1/3*e^(2πI)/3=-b/3-((Subscript[z, 1])^1/3+(Subscript[z, 2])^1/3)/2-Sqrt[3]((Subscript[z, 1])^1/3-(Subscript[z, 2])^1/3)*I/2

Print["α=",N[-b/3]]

Print[" f=f(α)=",N[α³\[Minus]4α²+5α\[Minus]2]]

Print[" m=",N[(b²-3c)/9]]

Print["m³=",N[m³]]

Print["∆=",N[f²\[Minus]4m³]]

Print["z₁=",N[(-f+Sqrt[f²\[Minus]4m³])/2]]

Print["z₂=",N[(-f-Sqrt[f²\[Minus]4m³])/2]]

Print["x₀=",N[-b/3+(Subscript[z, 1])^1/3+(Subscript[z, 2])^1/3]]

Print["x₁=",N[x₁=-b/3+p₁+q₁=-b/3+(Subscript[z, 1])^1/3*e^(2πI)/3+(Subscript[z, 2])^1/3*e^(4πI)/3=-b/3-((Subscript[z, 1])^1/3+(Subscript[z, 2])^1/3)/2+Sqrt[3]((Subscript[z, 1])^1/3-(Subscript[z, 2])^1/3)*I/2]]

Print["x₂=",N[-b/3+p₂+q₂=-b/3+(Subscript[z, 1])^1/3*e^(4πI)/3+(Subscript[z, 2])^1/3*e^(2πI)/3=-b/3-((Subscript[z, 1])^1/3+(Subscript[z, 2])^1/3)/2-Sqrt[3]((Subscript[z, 1])^1/3-(Subscript[z, 2])^1/3)*I/2]]

Out[]:

α= -1.73333

f=f(α)= -27.8921

m= 0.504444

m³= 0.128363

∆= 27.4135

z₁= 5.26019

z₂= 0.0244027

x₀= 0.295858　　　　　　※解

x₁= -2.74793+1.25494 I　※解　Iは虚数

x₂= -2.74793-1.25494 I　※解　Iは虚数

例題2.3.3.

f(x)=x³+8.1x²+17.2x+6.4

２通りの方法で解いた。

Ex2.3.3a

In[]:

{CubicFormula2[{8.1, 17.2, 6.4}],List @@ Last /@ Roots[x³ + 8.1 x² + 17.2 x + 6.4 == 0, x]} // N // Chop

Out[]:

{-4.784878851, -2.844977995, -0.4701431535}}　※解

Ex2.3.3b

In[]:

Plus @@ (Subscript[a, #] x^# & /@ Range[0, 3]) == 0 // TraditionalForm

Solve[Plus @@ (Subscript[a, #] x^# & /@ Range[0, 3]) == 0,x] // TraditionalForm

f (x) = x³ + 8.1 x² + 17.2 x + 6.4

a₃ = 1

a₂ = 8.1

a₁ = 17.2

a₀ = 6.4

Solve[Plus @@ (Subscript[a, #] x^# & /@ Range[0, 3]) == 0,x] // TraditionalForm

Out[]:

a₃ x³+a₂x²+ a₁x+a₀==0

注：3次方程式は解が3個あるので、上式には同じ式が3個ある。

{{x->-4.784878851},{x->-2.844977995},{x->-0.4701431535}}　※解

2.4 Mathematicaで4次方程式を解く

Ferrari Quartic で解く。例題は4パターンある。

例題2.4.1.

f(x)=x⁴-2x³-25x²+26x+120

In[]:

Plus@@(Subscript[a,#]x^#&/@Range[0,4])==0//TraditionalForm

Solve[Plus@@(Subscript[a,#]x^#&/@Range[0,4])==0,x]//TraditionalForm

Factor[x⁴-2x³-25x²+26x+120]

Solve[x⁴-2x³-25x²+26x+120==0,x]

Roots[x⁴-2x³-25x²+26x+120==0,x]//TraditionalForm

Roots[x⁴-2x³-25x²+26x+120==0,x]//TraditionalForm//FullSimplify

a₄=1

a₃=-2

a₂=-25

a₁=26

a₀=120

Solve[Plus@@(Subscript[a,#]x^#&/@Range[0,4])==0,x]//TraditionalForm

Out[]:

a₄ x⁴+a₃ x³+a₂ x²+a₁ x+a₀==0

注：4次方程式は解が4個あるので、上式には同じ式が4個ある。

{{x→-4},{x→-2},{x→3},{x→5}}

x==-4\[Or]x==-2\[Or]x==3\[Or]x==5

{{x->-4},{x->-2},{x->3},{x->5}}　※解　

例題2.4.2.

f(x)= x⁴-4x³-16x+35
In[]:

Factor[x⁴-4x³-16x+35]

Solve[x²+2x+5==0,x]

Solve[x²-6x+7==0,x]

Solve[x⁴-4x³-16x+35==0,x]

Roots[x⁴-4x³-16x+35==0,x]//TraditionalForm

Roots[xx⁴-4x³-16x+35==0,x]//TraditionalForm//FullSimplify

a₄=1

a₃=-4

a₂=0

a₁=-16

a₀=35

Solve[Plus@@(Subscript[a,#]x^#&/@Range[0,4])==0,x]//TraditionalForm

Out[]:

a₄ x⁴+a₃ x³+a₂ x²+a₁ x+a₀==0の解は例題2.4.1と同一なので、省略した。

{{x->-1-2 I},{x->-1+2 I},{x->3-Sqrt[2]},{x->3+Sqrt[2]}}　※解　Iは虚数

例題2.4.3.
f(x)= x⁴-12x²+8x+12

Factor[x⁴-12x²+8x+12]]

Solve[x⁴-12x²+8x+12==0,x]

Roots[x⁴-12x²+8x+12==0,x]//TraditionalForm

Roots[x⁴-12x²+8x+12==0,x]//TraditionalForm//FullSimplify

a₄=1

a₃=0

a₂=-12

a₁=8

a₀=12

Solve[Plus@@(Subscript[a,#]x^#&/@Range[0,4])==0,x]//TraditionalForm

Out[]:

a₄ x⁴+a₃ x³+a₂ x²+a₁ x+a₀==0の解は例題2.4.1と同一なので、省略した。

{{x->1-Sqrt[3]},{x->1+Sqrt[3]},{x->-1-Sqrt[7]},{x->Sqrt[7]-1}}　※解

例題2.4.4.
f(x)= x⁴+4x³-4x²+12

Solve[x⁴+4x³-4x²+12==0,x]

Roots[x⁴+4x³-4x²+12==0,x]//TraditionalForm

Roots[x⁴+4x³-4x²+12==0,x]//TraditionalForm//FullSimplify

a₄=1

a₃=4

a₂=-4

a₁=0

a₀=12

Solve[Plus@@(Subscript[a,#]x^#&/@Range[0,4])==0,x]//TraditionalForm

Out[]:

a₄ x⁴+a₃ x³+a₂ x²+a₁ x+a₀==0の解は例題2.4.1と同一なので、省略した。

{{x->1-I},{x->1+I},{x->-3-Sqrt[3]},{x->Sqrt[3]-3}}　※解　Iは虚数

続編：Mathematicaによる5次方程式解法の事始めⅢ

goo blog お知らせ

	【11/18】goo blogサービス終了のお知らせ
	【PR】ドコモのサブスク【GOLF me！】初月無料
	【コメント募集中】goo blogでの思い出は？
	「#gooblog引越し」で体験談を募集中