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

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

はじめに
    古来より黄金比の特性が研究されて来た。黄金比には古代、中世の数学者の名前が出てくる、また生物、建造物、品物等が黄金比に基づく物が有る云われるが、これらは俗説で、似て非なる物である。ガリレオと ピサの斜塔、ニュートンとリンゴの同程度の話。黄金比から派生した黄金角、黄金曲線も同様。まず黄金比GoldenRatioの事始めとしてMathematicaで基礎編を記述し、これから派生する黄金角GoldenAngle、黄金曲線GoldenSpiralと続き、これら事始めを習得した後、本命と云うべき正多面体の正十二面体と正二十面体の奥深い世界を探求するには正多面体と黄金比、正多面体と素数の関係性の習得が必須である。正十二面体と正二十面体から黄金比ϕを掘り当てるのは正多面体マニアの醍醐味である。これは後半の2.3黄金比GoldenRatioで作成した正十二面体と正二十面体の表にある。この表に黄金比ϕが何処に入っているか分かる入力式を記述したので、そこから手繰り寄せられる。その前に、まず黄金比の基本的性質から記述する。

シリーズ物
     Mathematicaで正多面体同士の頂点座標を結合して描画する

     Mathematicaで正多面体の黄金比の頂点座標

     Mathematicaでフィボナッチ と黄金比の事始め

　 Mathematicaで描く正多面体と素数の事始めⅠ、Ⅱ

1.黄金比事始め

1.1.黄金比GoldenRatio

Mathematicaでは黄金比をϕと記す。

基礎編

Out[]:

出力は全て黄金比(1 + Sqrt[5])/2になる。

In[]:

\!\(TraditionalForm\`\[Phi] = FunctionExpand[GoldenRatio]\)
g01 = Table[{GoldenRatio // TraditionalForm}]
g02 = Table[{FunctionExpand[GoldenRatio]}]
g03 = Table[{1 + 1/\[Phi] // FullSimplify}]
g04 = Table[{1 + 1/(1 + 1/\[Phi]) // FullSimplify}]
g05 = Table[{1 + 1/(1 + 1/(1 + 1/\[Phi])) // FullSimplify}]
g06 = Table[{1 + 1/(1 + 1/(1 + 1/(1 + 1/\[Phi]))) // FullSimplify}]
g07 = Table[{\[Phi]^2 - 1 // FullSimplify}]
g08 = Table[{1/(1 - \!\(TraditionalForm\SuperscriptBox[TagBox["\[Phi]",Function[{}, GoldenRatio]],RowBox[{"-", "2"}]]\)) // FullSimplify}]
g09 = Table[{\!\(\*UnderoverscriptBox[\(\[Sum]\), \(n = 0\), \(\[Infinity]\)]\*FormBox[SuperscriptBox[TagBox["\[Phi]",Function[{}, GoldenRatio]],RowBox[{RowBox[{"-", "2"}], "n"}]],TraditionalForm]\) // FullSimplify}]
TableOfValues1 = Prepend[{g01, g02, g03, g04, g05, g06, g07, g08, g09}, {"黄金比"}] 
Grid[TableOfValues1]
TableOfValues2 = MapThread[  Prepend, {TableOfValues1, {"\[Phi]関数","GoldenRatio//TraditionalForm","\!\(\*FormBox[\(FunctionExpand[GoldenRatio]\),TraditionalForm]\)", "1+1/\[Phi]", 1 + 1/(1 + 1/\[Phi]),1 + 1/(1 + 1/(1 + 1/\[Phi])),1 + 1/(1 + 1/(1 + 1/(1 + 1/\[Phi]))),"\!\(\*SuperscriptBox[\(\[Phi]\), \(2\)]\)-1","1/(1-\!\(\*FormBox[SuperscriptBox[TagBox[\"\[Phi]\",Function[{}, GoldenRatio]],RowBox[{\"-\", \"2\"}]],TraditionalForm]\))","\!\(\*UnderoverscriptBox[\(\[Sum]\), \(n = 0\), \(\[Infinity]\)]\\)\!\(\*FormBox[SuperscriptBox[TagBox[\"\[Phi]\",Function[{}, GoldenRatio]], 
RowBox[{RowBox[{\"-\", \"2\"}], \"n\"}]],TraditionalForm]\)"}}]
Grid[TableOfValues2, Frame -> All] 

以下の2式の解を求める。関数ｘだと解は2個あるが、黄金比ϕは(1+Sqrt[5])/2の1個だけ。

Solve[ϕ²-ϕ-1==0,ϕ]

Solve[x²- x-1==0,x]

Solve[True,1/2 (1+Sqrt[5])]

{{x->1/2 (1-Sqrt[5])},{x->1/2 (1+Sqrt[5])}}

以上黄金比ϕは簡単な諸々の式変形が成り立つ。これが黄金比が、何か妙な値である事を連想させる。

 

黄金比は三角関数でも出力される。

Out[]:

出力は全て黄金比(1 + Sqrt[5])/2になる。この表の後半（-2Sin[666Degree]以降）は黄金比になる稀な例。

※この表の末尾の式は逆双曲線関数の指数関数である。

In[]:

\!\(TraditionalForm\`\[Phi] = FunctionExpand[GoldenRatio]\)
si = Table[{1 + 2 Sin[ \[Pi]/10] // FullSimplify}]
co = Table[{2 Cos[ \[Pi]/5]}]
se = Table[{Sec[\!\(TraditionalForm\`
\*FractionBox[\(2\ \[Pi]\), \(5\)]\)]/2}]
cs = Table[{Csc[\!\(TraditionalForm\`
\*FractionBox[\(\ \(\[Pi]\)\), \(10\)]\)]/2}]
s1 = Table[{-2 Sin[666 Degree]}]
s2 = Table[{-2 Cos[6*6*6 Degree]}]
s3 = Table[{-Cos[6*6*6 Degree] - Sin[666 Degree]}]
si = Table[{Sin[\[Pi]/2 - I Log[\!\(\*TagBox["\[Phi]",Function[{}, GoldenRatio]]\)]] - I*Sin[I Log[\!\(\*TagBox["\[Phi]",Function[{}, GoldenRatio]]\)]] // FullSimplify}]
ac = Table[{Exp[ArcCsch[2.]]}]
TableOfValues1 =Prepend[{si, co, se, cs, s1, s2, s3, si, ac}, {"黄金比"}] 
Grid[TableOfValues1]
TableOfValues2 =MapThread[  Prepend, {TableOfValues1, {"三角関数","1+2Sin[\!\(\*FractionBox[\(\[Pi]\), \(10\)]\)]","2Cos[\!\(\*FractionBox[\(\\\ \(\[Pi]\)\), \(5\)]\)]","Sec[\!\(\*FormBox[FractionBox[\(2  \[Pi]\), \(5\)],TraditionalForm]\)]/2","Csc[\!\(\*FormBox[FractionBox[\(\[Pi]\), \(10\)],
TraditionalForm]\)]/2", "-2Sin[666Degree]", "-2Cos[6*6*6Degree]","-Cos[6*6*6Degree]-Sin[666Degree]","\!\(\*FormBox[\(2  Sin[\*FractionBox[\(\[Pi]\), \(2\)] - \\[ImaginaryI]\\\ Log[\*TagBox[\"\[Phi]\",Function[{}, GoldenRatio]]]] - \[ImaginaryI]Sin[\[ImaginaryI]\\\ Log[\\*TagBox[\"\[Phi]\",
Function[{}, GoldenRatio]]]]\),TraditionalForm]\)", "Exp[ArcCsch[2.]]"}}]
Grid[TableOfValues2, Frame -> All] 

Seriesベキ級数展開

Out[]:

出力は黄金比になる。

In[]:

\!\(TraditionalForm\`\[Phi] = FunctionExpand[GoldenRatio]\)
fib = Table[{\!\(\*UnderoverscriptBox[\(\[Sum]\), \(n = 1\), \(\[Infinity]\)]\*FractionBox[SuperscriptBox[RowBox[{"(",RowBox[{"-", "1"}], ")"}],RowBox[{"n", "+", "1"}]],RowBox[{SubscriptBox[TagBox["F",Fibonacci], "n"], " ",SubscriptBox[TagBox["F",Fibonacci],RowBox[{"n", "+", "1"}]]}]]\) + 1}]
series = Table[{\!\(TraditionalForm\\*UnderoverscriptBox[\(\[Sum]\), \(n = 0\), \(\[Infinity]\)]
\*FractionBox[\(\*SuperscriptBox[\((\(-1\))\), \(n + 1\)]\ \(\((2\ n + 1)\)!\)\), \(\*SuperscriptBox[\(4\), \(2\ n + 3\)]\ \(\((n + 2)\)!\)\ \(n!\)\)] +\*FractionBox[\(13\), \(8\)]\) // FullSimplify}]
TableOfValues1 = Prepend[{fib, series}, {"黄金比"}] 
Grid[TableOfValues1]
TableOfValues2 =MapThread[Prepend, {TableOfValues1, {"Series","\!\(\*UnderoverscriptBox[\(\[Sum]\), \(n = 1\), \(\[Infinity]\)]\\)\!\(\*FractionBox[SuperscriptBox[\((\(-1\))\), \(n + 1\)], \\(\*SubscriptBox[TagBox[\"F\",Fibonacci], \"n\"]\\\ \*SubscriptBox[TagBox[\"F\",Fibonacci],RowBox[{\"n\", \"+\", \"1\"}]]\)]\)+1}","\!\(\*FormBox[\(\*UnderoverscriptBox[\(\[Sum]\), \(n = 0\), \(\\[Infinity]\)]\*FractionBox[\(\*SuperscriptBox[\((\(-1\))\), \(n + \1\)]\\\ \(\((2\\\ n + 1)\)!\)\), \(\*SuperscriptBox[\(4\), \(2\\\ n + \3\)]\\\ \(\((n + 2)\)!\)\\\ \(n!\)\)] + \*FractionBox[\(13\), \(8\)]\),TraditionalForm]\)}"}}]
Grid[TableOfValues2, Frame -> All] 

Identities恒等

Out[]:

In[]:

\!\(TraditionalForm\`\[Phi] = FunctionExpand[GoldenRatio]\)
id = Table[{\!\(TraditionalForm\`\*SuperscriptBox[TagBox["\[Phi]",Function[{}, GoldenRatio]],RowBox[{"n", "-", "1"}]] + \*SuperscriptBox[TagBox["\[Phi]",Function[{}, GoldenRatio]],RowBox[{"n", "-", "2"}]]\) // FullSimplify}]
TableOfValues1 = Prepend[{id}, {"黄金比"}] 
Grid[TableOfValues1]
TableOfValues2 =MapThread[Prepend, {TableOfValues1, {"Identities","\!\(\*FormBox[\(\*SuperscriptBox[TagBox[\"\[Phi]\",Function[{}, GoldenRatio]],RowBox[{\"n\", \"-\", \"1\"}]] + \*SuperscriptBox[TagBox[\"\[Phi]\",Function[{}, GoldenRatio]],RowBox[{\"n\", \"-\", \"2\"}]]\),
TraditionalForm]\)"}}]
Grid[TableOfValues2, Frame -> All] 

黄金比の指数数列

^Out[]:

^IN[]:

^{\!\(TraditionalForm\`\[Phi] = FunctionExpand[GoldenRatio]\)
fib = Table[{Sum[Fibonacci[i], i] }]
fib2 = Table[{Sum[Fibonacci[i], i] // FullSimplify }]
luc = Table[{Sum[LucasL[2 i]^2, i]}]
luc2 = Table[{Sum[LucasL[2 i]^2, i] // FullSimplify}]
TableOfValues1 = Prepend[{fib, fib2, luc, luc2}, {"黄金比"}] 
Grid[TableOfValues1]
TableOfValues2 =MapThread[Prepend, {TableOfValues1, {"GoldenRatioの指数数列","Sum[Fibonacci[i],i] ", "Sum[Fibonacci[i],i] ","Sum[LucasL[2 i]^2,i]", "Sum[LucasL[2 i]^2,i]"}}]
Grid[TableOfValues2, Frame -> All]} 

2.2黄金角GoldenAngle

黄金角も妙な関係式がある。

黄金角とは，完全な2 πの角度を黄金比で与えられる2つの部分に分ける角である．

出力は全て黄金角(3- Sqrt[5])πになる。

Out[]:

In[]:

\!\(TraditionalForm\`\[Phi] = FunctionExpand[GoldenRatio]\)
ga1 = Table[{N[360/(1 + \[Phi])] "°"}]
ga2 = Table[{FunctionExpand[GoldenAngle]}]
ga3 = Table[{N@GoldenAngle/Degree} "°"]
FunctionExpand[GoldenAngle]

ga4 = Table[{N[%]}]
FunctionExpand[GoldenAngle]
ga5 = Table[{DMSString[%] }]
ga6 = Table[{(2 (1 - 1/\[Phi]) // FullSimplify) \[Pi]}]
ga7 = Table[{(2 (2 - \[Phi]) // FullSimplify) \[Pi]}]
ga8 = Table[{(2/\[Phi]^2 // FullSimplify) \[Pi]}]
TableOfValues1 =Prepend[{ga1, ga2, ga3, ga4, ga5, ga6, ga7, ga8}, {"黄金角"}] 
Grid[TableOfValues1]
TableOfValues2 =MapThread[Prepend, {TableOfValues1, {"\[Phi]関数", "N[360/(1+\[Phi])]度","FunctionExpand[GoldenAngle]", "N@GoldenAngle/Degree","N[FunctionExpand[GoldenAngle]]", "DMSString[%]","2(1-1/\[Phi])\[Pi]", "2(2-\[Phi])\[Pi]","2/\!\(\*SuperscriptBox[\(\[Phi]\), \(2\)]\)\[Pi]"}}]
Grid[TableOfValues2, Frame -> All] 

2.3黄金曲線GoldenSpiral
Out[]:

In[]:
rect[0] := {{0, 0}, {1, -1}}
rect[n_] := Module[{m = Mod[n, 4], phi = 1/GoldenRatio,x1, x2, y1, y2},{{x1, y1}, {x2, y2}} = rect[n - 1];
Which[
m == 0, {{x1, y2}, {x1 + phi^n, y2 - phi^n}},
m == 1, {{x2, y2 + phi^n}, {x2 + phi^n, y2}},
m == 2, {{x2 - phi^n, y1 + phi^n}, {x2, y1}},
m == 3, {{x1 - phi^n, y1}, {x1, y1 - phi^n}}]
]
square[{{x1_, y1_}, {x2_, y2_}}] :=Line[{{x1, y1}, {x2, y1}, {x2, y2}, {x1, y2}, {x1, y1}}]
ParametricPlot[Evaluate[{(5 + 3 Sqrt[5])/10, (Sqrt[5] - 5)/10} + {-Cos[t],Sin[t]} 1.12053 Exp[.306349 t]], {t, -100, .25},AspectRatio -> Automatic, Ticks -> None, Axes -> False,PlotStyle -> Red,PlotRange -> {{-.2, 2}, {-1, 0}},Prolog -> Table[square[rect[i]], {i, 0, 10}]]

2.黄金比GoldenRatioで正多面体を作成する

   ここからはMathematicaで正多面体の黄金比の頂点座標の入門編。ネットでは正十二面体の黄金比の頂点座標を±記号を使って、数個の頂点座標を示してこれが正十二面体の頂点座標ですと云った例が見掛けるが、これは正しくない。正十二面体の頂点座標は20個有り、それに対応する面リストが必須で、これが無いと正十二面体は正確に描画できない。
2.1正十二面体RegularDodecahedronの作成
     黄金比の頂点座標のデータを入力してMathematicaで正十二面体を作成する。それには頂点座標とそれに対応する面リストが必須である。頂点座標:20個は以下の黄金比の座標を使用する。Mathematicaでは黄金比をϕと記す。
 {{0, -1, -ϕ²}, {0, +1,- ϕ²}, {0, -1, +ϕ²}, {0, +1, +ϕ²}, {-1, -ϕ², 0}, {+1, -ϕ², 0}, {-1, +ϕ², 0}, {+1, +ϕ², 0}, {-ϕ², 0, -1}, {-ϕ², 0, +1},{+ϕ², 0, -1}, {ϕ²,0, +1}, {-ϕ, -ϕ, -ϕ}, {-ϕ, -ϕ, +ϕ}, {-ϕ, +ϕ, -ϕ}, {-ϕ, +ϕ, +ϕ}, {+ϕ, -ϕ, -ϕ}, {+ϕ, -ϕ, +ϕ}, {+ϕ, +ϕ, -ϕ}, {+ϕ, +ϕ, +ϕ}}
    それに対応する面12個は以下の面リストを使用する。
 {{1, 2, 19, 11, 17}, {2, 1, 13, 9, 15}, {3, 4, 16, 10, 14}, {4, 3,18, 12, 20}, {5, 6, 18, 3, 14}, {6, 5, 13, 1, 17}, {7, 8, 19, 2,15}, {8, 7, 16, 4, 20}, {9, 10, 16, 7, 15}, {10, 9, 13, 5,14}, {11, 12, 18, 6, 17}, {12, 11, 19, 8, 20}}

    この操作で作成された正十二面体の辺の長さは2なので、表面積、体積等の諸元は普段の辺の長さ1と異なる事に注意したい。表面積、体積等の諸元も黄金比を使って算出する。

ϕ=(1+SQrt[5])/2

N[ϕ]=1.618033989

ϕ²=ϕ+1

In[]:

RegularDodecahedronVertexData ={{0, -1, -ϕ²}, {0, +1, -ϕ²}, {0, -1, +ϕ²}, {0, +1, +ϕ²}, {-1, -ϕ², 0}, {+1, -ϕ²,0}, {-1, +ϕ², 0}, {+1, +ϕ²,0}, {-ϕ², 0, -1}, {-ϕ², 0, +1},{+ϕ², 0, -1}, {+ϕ², 0, +1}, {-ϕ, -ϕ, -ϕ}, {-ϕ, -ϕ, +ϕ}, {-ϕ, +ϕ, -ϕ}, {-ϕ, +ϕ, +ϕ]}, {+ϕ, -ϕ, -ϕ}, {+ϕ, -ϕ, +ϕ}, {+ϕ, +ϕ, -ϕ}, {+ϕ, +ϕ, +ϕ}}

RegularDodecahedronVertexIndex ={{1, 2, 19, 11, 17}, {2, 1, 13, 9, 15}, {3, 4, 16, 10, 14}, {4, 3,18, 12, 20}, {5, 6, 18, 3, 14}, {6, 5, 13, 1, 17}, {7, 8, 19, 2,15}, {8, 7, 16, 4, 20}, {9, 10, 16, 7, 15}, {10, 9, 13, 5,14}, {11, 12, 18, 6, 17}, {12, 11, 19, 8, 20}}
p = RegularDodecahedron =Polyhedron[RegularDodecahedronVertexData,RegularDodecahedronVertexIndex]
Graphics3D[{EdgeForm[{Thin, Blue}], FaceForm[{Pink, Opacity[0.7]}],p}, Boxed -> False]

Out[]:

2.2正二十面体RegularIcosahedronの作成
     黄金比の頂点座標のデータを入力してMathematicaで正二十面体を作成する。それには頂点座標とそれに対応する面リストが必須である。頂点座標:12個は以下の黄金比の座標を使用する。Mathematicaでは黄金比をϕと記す。
{{0, -1, -ϕ}, {0, +1, -ϕ}, {0,-1, +ϕ}, {0, +1, +ϕ}, {-ϕ,0, -1}, {-ϕ, 0, +1}, {+ϕ,0, -1}, {+ϕ, 0, +1}, {-1, -ϕ,0}, {+1, -ϕ, 0}, {-1, +ϕ, 0}, {+1, +ϕ,0}}
それに対応する面20個は以下の面リストを使用する。
{{1, 2, 7}, {2, 1, 5}, {3, 4, 6}, {4, 3, 8}, {5, 6, 11}, {6, 5,9}, {7, 8, 10}, {8, 7, 12}, {9, 10, 3}, {10, 9, 1}, {11, 12,2}, {12, 11, 4}, {1, 7, 10}, {1, 9, 5}, {2, 5, 11}, {2, 12, 7}, {3,6, 9}, {3, 10, 8}, {4, 8, 12}, {4, 11, 6}}

この操作で作成された正二十面体の辺の長さは2なので、表面積、体積等の諸元は普段の辺の長さ1と異なる事に注意したい。表面積、体積等の諸元も黄金比を使って算出する。

In[]:

RegularIcosahedronVertexData ={{0, -1, -ϕ}, {0, +1, -ϕ}, {0, -1, +ϕ}, {0, +1, +ϕ},{-ϕ,0, -1}, {-ϕ, 0, +1}, {+ϕ,0, -1}, {+ϕ, 0, +1},{-1, -ϕ,0}, {+1, -ϕ, 0}, {-1, +ϕ, 0}, {+1, +ϕ,0}}

RegularIcosahedronVertexIndex ={{1, 2, 7}, {2, 1, 5}, {3, 4, 6}, {4, 3, 8}, {5, 6, 11}, {6, 5,9}, {7, 8, 10}, {8, 7, 12}, {9, 10, 3}, {10, 9, 1}, {11, 12,2}, {12, 11, 4}, {1, 7, 10}, {1, 9, 5}, {2, 5, 11}, {2, 12, 7}, {3,6, 9}, {3, 10, 8}, {4, 8, 12}, {4, 11, 6}}
p = RegularIcosahedron =Polyhedron[RegularIcosahedronVertexData,RegularIcosahedronVertexIndex]
Graphics3D[{EdgeForm[{Thin, Blue}], FaceForm[{Pink, Opacity[0.7]}],p}, Boxed -> False]

Out[]:

2.3黄金比GoldenRatioで作成した正十二面体と正二十面体の表

    この操作で作成された正十二面体と正二十面体の辺の長さは2なので、表面積、体積等の諸元は普段の辺の長さ1と異なる事に注意したい。表面積、体積等の諸元も黄金比を使って算出する。描いた正十二面体と正二十面体が正しいかの判断基準は双対である事。

1.双対な多面体は、以下の入れ違いの関係にあり、正十二面体の二面角DihedralAngle:116.5650512° と正二十面体のCentral Angle:63.43494882° の和は180° になる、また正二十面体の二面角DihedralAngle:138.1896851°と正十二面体のCentral Angle:41.8103149°の和は180°になる。

2.体積V/（表面積S*外接半径）が同じ値の正多面体は双対である。

3.双対な正多面体の場合は内接半径/外接半径％が同じになる。

     描いた正十二面体と正二十面体はこれら条件を全て満たしており、値も同一である。古来より正多面体は五個しかない。その中でも正十二面体と正二十面体の諸元が黄金比GoldenRatioと関連する事は興味深い。記述したように黄金比GoldenRatioϕ自体が妙な値であり、冒頭で述べたように古来より様々な俗説を生む結果になっている。黄金比ϕが入った式はそのままでは計算できない、Mathemaicaはそこ迄頭は良くない。入力スクリプトから入力式の黄金比ϕを辿るのは面倒なので、黄金比ϕが何処に入っているか分かる入力式の表も記述した。

Out[]:

In[]:

(*φを含む入力式付き*)
\[Phi] = (1 + Sqrt[5])/2
ss = PolyhedronData["Dodecahedron", "SchlaefliSymbol"]
ci = \[Phi]Sqrt[3]
cis = \[Phi]*Sqrt[3] // FullSimplify
cin = N[\[Phi]*Sqrt[3]]
in = Sqrt[\[Phi]^5/Sqrt[5]]
ins = Sqrt[\[Phi]^5/Sqrt[5]] // FullSimplify
inn = N[Sqrt[\[Phi]^5/Sqrt[5]]]
su = 12 Sqrt[(\[Phi]Sqrt[5])^3]
sus = 12 Sqrt[(\[Phi]*Sqrt[5])^3] // FullSimplify
sun = N[12 Sqrt[(\[Phi]*Sqrt[5])^3]]
vo = 4 \[Phi]^4 Sqrt[5]
vos = 4 \[Phi]^4*Sqrt[5] // FullSimplify
von = N[4 \[Phi]^4*Sqrt[5]]
da = 2 ArcTan[\[Phi]]
das = 2 ArcTan[\[Phi]] // FullSimplify
dan = N[2 ArcTan[\[Phi]]] 180/3.141592653589
ca = 2 ArcCos[\[Phi]/Sqrt[3]]
cas = 2 ArcCos[\[Phi]/Sqrt[3]] // FullSimplify
can = N[2 ArcCos[\[Phi]/Sqrt[3]]] 180/3.141592653589
md = Table[{PolyhedronData["Dodecahedron", "Name"], ss,"\[Phi]Sqrt[3]", cis, cin,"Sqrt[\!\(\*SuperscriptBox[\(\[Phi]\), \(5\)]\)/Sqrt[5]]", ins,inn, "12Sqrt[(\[Phi]Sqrt[5]\!\(\*SuperscriptBox[\()\), \(3\)]\)]",sus, sun, "4\!\(\*SuperscriptBox[\(\[Phi]\), \(4\)]\)Sqrt[5]", vos,von, "2ArcTan[\[Phi]]", das, dan, "2ArcCos[\[Phi]/Sqrt[3]]", cas,can}]
ss = PolyhedronData["Icosahedron", "SchlaefliSymbol"]
ci = Sqrt[\[Phi]Sqrt[5]]
cis = Sqrt[\[Phi]*Sqrt[5]] // FullSimplify
cin = N[Sqrt[\[Phi]*Sqrt[5]]]
in = \[Phi]^2/Sqrt[3]
ins = \[Phi]^2/Sqrt[3] // FullSimplify
inn = N[\[Phi]^2/Sqrt[3]]
su = 20 Sqrt[3]
su = 20 Sqrt[3]
sun = N[20 Sqrt[3]]
vo = 20 \[Phi]^2/3
vos = 20 \[Phi]^2/3 // FullSimplify
von = N[20 \[Phi]^2/3]
da = 2 ArcTan[\[Phi]^2]
da = 2 ArcTan[\[Phi]^2] // FullSimplify
dan = N[2 ArcTan[\[Phi]^2] // FullSimplify] 180/3.141592653589
ca = 2 ArcCos[Sqrt[5 + Sqrt[5]]/Sqrt[10]]
ca = 2 ArcCos[Sqrt[5 + Sqrt[5]]/Sqrt[10]] // FullSimplify
can = N[2 ArcCos[Sqrt[5 + Sqrt[5]]/Sqrt[10]]] 180/3.141592653589
mi = Table[{PolyhedronData["Icosahedron", "Name"], ss,"Sqrt[\[Phi]Sqrt[5]]", cis, cin,"\!\(\*SuperscriptBox[\(\[Phi]\), \(2\)]\)/Sqrt[3]", ins, inn,"20Sqrt[3]", sus, sun,"20\!\(\*SuperscriptBox[\(\[Phi]\), \(2\)]\)/3", vos, von,"2ArcTan[\!\(\*SuperscriptBox[\(\[Phi]\), \(2\)]\)]", das, dan, 
   "2ArcCos[Sqrt[5+Sqrt[5]]/Sqrt[10]]", cas, can}]
TableOfValues1 =Prepend[{md, mi}, {"Name", "SchlaefliSymbol", "外接半径Circumradius","外接半径Circumradius", "外接半径Circumradius", "内接半径Inradius","内接半径Inradius", "内接半径Inradius", "表面積SurfaceArea", "表面積SurfaceArea","表面積SurfaceArea", "体積Volume", "体積Volume", "体積Volume","DihedralAngles二面角", "DihedralAngles二面角", "DihedralAngles二面角°","CentralAngles", "CentralAngles", "CentralAngles°"}]
Grid[TableOfValues1]
TableOfValues2 =MapThread[Prepend, {TableOfValues1, {"和名", "正十二面体", "正二十面体"}}] 
Grid[TableOfValues2, Frame -> All] 

\[Phi] = (1 + Sqrt[5])/2
ss = PolyhedronData["Dodecahedron", "SchlaefliSymbol"]
v = PolyhedronData["Dodecahedron", "VertexCount"]
e = PolyhedronData["Dodecahedron", "EdgeCount"]
f = PolyhedronData["Dodecahedron", "FaceCount"]
ci = \[Phi]*Sqrt[3] // FullSimplify
in = Sqrt[\[Phi]^5/Sqrt[5]] // FullSimplify
su = 12 Sqrt[(\[Phi]*Sqrt[5])^3] // FullSimplify
vo = 4 \[Phi]^4*Sqrt[5] // FullSimplify
da = 2 ArcTan[\[Phi]]
ca = 2 ArcCos[\[Phi]/Sqrt[3]]
vsci = vo/(su*ci)
inci = 100 in/ci
md = Table[{PolyhedronData["Dodecahedron", "Name"], ss, v, e, f, ci,in, su, vo, da, ca, vsci, inci}]
ss = PolyhedronData["Icosahedron", "SchlaefliSymbol"]
v = PolyhedronData["Icosahedron", "VertexCount"]
e = PolyhedronData["Icosahedron", "EdgeCount"]
f = PolyhedronData["Icosahedron", "FaceCount"]
ci = Sqrt[\[Phi]*Sqrt[5]] // FullSimplify
in = \[Phi]^2/Sqrt[3] // FullSimplify
su = 20 Sqrt[3]
vo = 20 \[Phi]^2/3 // FullSimplify
da = 2 ArcTan[\[Phi]^2]
ca = 2 ArcCos[Sqrt[5 + Sqrt[5]]/Sqrt[10]]
vsci = vo/(su*ci)
inci = 100 in/ci
mi = Table[{PolyhedronData["Icosahedron", "Name"], ss, v, e, f, ci,in, su, vo, da, ca, vsci, inci}]
TableOfValues1 =Prepend[{md, mi}, {"Name", "SchlaefliSymbol", "頂点数V", "辺の数E", "面の数F","外接半径Circumradius", "内接半径Inradius", "表面積SurfaceArea", "体積Volume","DihedralAngles二面角", "CentralAngles", "体積/（表面積*外接半径）","内接半径/外接半径％"}]
Grid[TableOfValues1]
TableOfValues2 =MapThread[Prepend, {TableOfValues1, {"和名", "正十二面体", "正二十面体"}}] 
Grid[TableOfValues2, Frame -> All] 

ss = PolyhedronData["Dodecahedron", "SchlaefliSymbol"]
v = PolyhedronData["Dodecahedron", "VertexCount"]
e = PolyhedronData["Dodecahedron", "EdgeCount"]
f = PolyhedronData["Dodecahedron", "FaceCount"]
cin = N[\[Phi]*Sqrt[3]]
inn = N[Sqrt[\[Phi]^5/Sqrt[5]]]
sun = N[12 Sqrt[(\[Phi]*Sqrt[5])^3]]
von = N[4 \[Phi]^4*Sqrt[5]]
dan = N[2 ArcTan[\[Phi]] // FullSimplify] 180/3.141592653589
can = N[2 ArcCos[\[Phi]/Sqrt[3]]] 180/3.141592653589
vsci = von/(sun*cin)
inci = 100 inn/cin
md = Table[{PolyhedronData["Dodecahedron", "Name"], ss, v, e, f, cin,inn, sun, von, dan, can, vsci, inci}]
ss = PolyhedronData["Icosahedron", "SchlaefliSymbol"]
v = PolyhedronData["Icosahedron", "VertexCount"]
e = PolyhedronData["Icosahedron", "EdgeCount"]
f = PolyhedronData["Icosahedron", "FaceCount"]
cin = N[Sqrt[\[Phi]*Sqrt[5]]]
inn = N[\[Phi]^2/Sqrt[3]]
sun = N[20 Sqrt[3]]
von = N[20 \[Phi]^2/3]
dan = N[2 ArcTan[\[Phi]^2] // FullSimplify] 180/3.141592653589
can = N[2 ArcCos[Sqrt[5 + Sqrt[5]]/Sqrt[10]]] 180/3.141592653589
vsci = von/(sun*cin)
inci = 100 inn/cin
mi = Table[{PolyhedronData["Icosahedron", "Name"], ss, v, e, f, cin, 
   inn, sun, von, dan, can, vsci, inci}]

TableOfValues1n =Prepend[{md, mi}, {"Name", "SchlaefliSymbol", "頂点数V", "辺の数E", "面の数F","外接半径Circumradius", "内接半径Inradius", "表面積SurfaceArea", "体積Volume","DihedralAngles二面角°", "CentralAngles°", "体積/（表面積*外接半径）","内接半径/外接半径％"}]
Grid[TableOfValues1n]
TableOfValues2 = MapThread[Prepend, {TableOfValues1n, {"和名", "正十二面体", "正二十面体"}}] 
Grid[TableOfValues2, Frame -> All]