Mathematicaで描く正二十面体Regular Icosahedron
今回は正十二面体と双対性がある正二十面体を記述した。多面体の中で正多面体は、正四面体、正六面体、正八面体、正十二面体 、正二十面体の5個しかない。幾何の問題は図を見ただけで分かるのは達人で、一般の人は補助線を引いてみると、答が見えてくる。Mathematicaを使用して正二十面体の外接円等の諸元を補助線を引く事無く、一気に求める。一辺の長さを1とした。Mathematicaでは色々な関数、式を使って同じ答を出す事もある。Mathematicaの出力結果は厳密値を出す事もある。その場合は膨大なデータになり、字数が増えるので省略した。どうせ重心の結果は{0.0,0.0,0.0}のゼロだと決め付けてはいけない。数学は計算過程が重要になる。そう云う事で、この場合はgooブログの字数制限と云う大人の事情で、端折った結果を掲載した。
シリーズ物
Mathematicaで描く正四面体Tetrahedron
Mathematicaで描く正六面体Cube
Mathematicaで描く正八面体Octahedron
Mathematicaで描く正十二面体Regular Dodecahedron
Mathematicaで作成した正多面体諸元の表
Mathematicaで正多面体の三角関数を解く
Mathematicaで描く正多面体と素数の事始めI、II
Mathematicaで正八面体モニック多項式I、II、III、Ⅳ
Mathematicaで正八面体モニック多項式・演習問題
Mathematicaで正二十面体モニック多項式I、II、III、Ⅳ、Ⅴ
Mathematicaで正二十面体モニック多項式・演習問題I、II
Mathematicaで正多面体の黄金比の事始め
1.正二十面体の描画
In[]:
Graphics3D[{EdgeForm[{Thin, Blue}], FaceForm[{Pink, Opacity[0.7]}],PolyhedronData["Icosahedron", "Polyhedron"]},Boxed -> False]
Out[1]:
2.正二十面体の頂点と辺と面の数を求める
In[]:
Print["SchlaefliSymbol:",PolyhedronData["Icosahedron", "SchlaefliSymbol"]]
Print["頂点数:", PolyhedronData["Icosahedron", "VertexCount"]]
Print["辺の数:", PolyhedronData["Icosahedron", "EdgeCount"]]
Print["面の数:", PolyhedronData["Icosahedron", "FaceCount"]]
SchlaefliSymbol:{3,5}
頂点数:12
辺の数:30
面の数:20
3. 正二十面体の重心を求める
In[]:
PolyhedronData["Icosahedron","Centroid"]
RegionCentroid[PolyhedronData["Icosahedron","Polyhedron"]]
N[%]
RegionCentroid[PolyhedronData["Icosahedron","Polyhedron"]]//FullSimplify
Out[]:
{0,0,0}
{(3 (1 + Sqrt[5])^2 (5/Sqrt[50 - 10 Sqrt[5]] - 1/Sqrt[10 - 2 Sqrt[5]]))/(2 (10 - 2 Sqrt[5])) + (3 (-1 - Sqrt[5])^2 (-(5/Sqrt[50 - 10 Sqrt[5]]) + 1/Sqrt[10 - 2 Sqrt[5]]))/(2 (10 - 2 Sqrt[5])) - (2 ((-1 - Sqrt[5])^2/(10 - 2 Sqrt[5]) + 2 ((-1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]) - Sqrt[2/(5 - Sqrt[5])])^2))/Sqrt[10 - 2 Sqrt[5]] +
2 (-(5/2) Sqrt[(5 + Sqrt[5])/((50 - 10 Sqrt[5]) (5 - Sqrt[5]))] + 1/2 Sqrt[(5 + Sqrt[5])/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]) ((1 - Sqrt[5])^2/(4 (10 - 2 Sqrt[5])) + 2/(5 - Sqrt[5]) + ((1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]) - Sqrt[2/(5 - Sqrt[5])])^2) - 2 Sqrt[(5 + Sqrt[5])/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))] (((-1 -
Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]) + (1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]))^2 + ((-1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]) - Sqrt[2/(5 - Sqrt[5])])^2 + ((1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]) - Sqrt[2/(5 - Sqrt[5])])^2) + 2 (5/(2 Sqrt[50 - 10 Sqrt[5]]) - 1/(2 Sqrt[10 - 2 Sqrt[5]]) - 5/2 Sqrt[(5 + Sqrt[5])/((50 -
10 Sqrt[5]) (5 - Sqrt[5]))] + 1/2 Sqrt[(5 + Sqrt[5])/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]) ((-1 - Sqrt[5])^2/(4 (10 - 2 Sqrt[5])) + (-1 + Sqrt[5])^2/(4 (10 - 2 Sqrt[5])) + ((-1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]) + (-1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]))^2) + 2 (1/Sqrt[10 - 2 Sqrt[5]] - Sqrt[(5 + Sqrt[5])/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]) (((-1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]) + (1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]))^2 + ((-1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]) + (-1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]))^2 + ((1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]) + (-1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]))^2) + 2 (5/2 Sqrt[(5 + Sqrt[5])/((50 - 10 Sqrt[5]) (5 - Sqrt[5]))] - 1/2 Sqrt[(5 + Sqrt[5])/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]) (2/(5 - Sqrt[5]) + (-1 + Sqrt[5])^2/(4 (10 - 2 Sqrt[5])) + (Sqrt[2/(5 - Sqrt[5])] + (-1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]))^2) + 2 (-(5/(2 Sqrt[50 - 10 Sqrt[5]])) + 1/(2 Sqrt[10 - 2 Sqrt[5]]) + 5/2 Sqrt[(5 + Sqrt[5])/((50 - 10 Sqrt[5]) (5 - Sqrt[5]))] -
1/2 Sqrt[(5 + Sqrt[5])/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]) ((1 - Sqrt[5])^2/(4 (10 - 2 Sqrt[5])) + (1 + Sqrt[5])^2/(4 (10 - 2 Sqrt[5])) + ((1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]) + (1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]))^2) + (2 ((1 + Sqrt[5])^2/(10 - 2 Sqrt[5]) + 2 (Sqrt[2/(5 - Sqrt[5])] + (1 + Sqrt[5])/(2 Sqrt[10 -
2 Sqrt[5]]))^2))/Sqrt[10 - 2 Sqrt[5]] + 2 (-(1/Sqrt[10 - 2 Sqrt[5]]) + Sqrt[(5 + Sqrt[5])/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]) (((1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]) + (-1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]))^2 + ((1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]) + (1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]))^2 + ((-1 +
Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]) + (1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]))^2) + 2 Sqrt[(5 + Sqrt[5])/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))] ((Sqrt[2/(5 - Sqrt[5])] + (-1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]))^2 + (Sqrt[2/(5 - Sqrt[5])] + (1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]))^2 + ((-1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]) + (1 +Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]))^2),
1/(5 - Sqrt[5]) (5 + Sqrt[5]) (-(5/2) Sqrt[5/((50 - 10 Sqrt[5]) (10 - 2 Sqrt[5]))] - 1/(2 (10 - 2 Sqrt[5])) + Sqrt[5]/(2 (10 - 2 Sqrt[5])) + 5/(2 Sqrt[(50 - 10 Sqrt[5]) (10 - 2 Sqrt[5])]) + 5 Sqrt[2/((50 - 10 Sqrt[5]) (5 - Sqrt[5]))] - Sqrt[2/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]) + 1/(5 - Sqrt[5]) (5 +
Sqrt[5]) (5/2 Sqrt[5/((50 - 10 Sqrt[5]) (10 - 2 Sqrt[5]))] + 1/(2 (10 - 2 Sqrt[5])) - Sqrt[5]/(2 (10 - 2 Sqrt[5])) - 5/(2 Sqrt[(50 - 10 Sqrt[5]) (10 - 2 Sqrt[5])]) - 5 Sqrt[2/((50 - 10 Sqrt[5]) (5 - Sqrt[5]))] + Sqrt[2/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]) + 2 (-5 Sqrt[5/((50 - 10 Sqrt[5]) (10 - 2 Sqrt[5]))] + Sqrt[5]/(10 -
2 Sqrt[5])) (1/4 + (5 + Sqrt[5])/(4 (5 - Sqrt[5])) + (-(1/2) - 1/2 Sqrt[(5 + Sqrt[5])/(5 - Sqrt[5])])^2) + 2 (-(1/(10 - 2 Sqrt[5])) + Sqrt[5]/(10 - 2 Sqrt[5]) - 2 Sqrt[2/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]) (1/4 + (5 + Sqrt[5])/(4 (5 - Sqrt[5])) + (-(1/2) - 1/2 Sqrt[(5 + Sqrt[5])/(5 - Sqrt[5])])^2) - (4 Sqrt[5] ((5 + Sqrt[5])/(5 - Sqrt[5]) + 2 (-(1/2) - 1/2 Sqrt[(5 + Sqrt[5])/(5 - Sqrt[5])])^2))/(10 - 2 Sqrt[5]) + 2 (5 Sqrt[5/((50 - 10 Sqrt[5]) (10 - 2 Sqrt[5]))] - Sqrt[5]/(10 - 2 Sqrt[5])) (1/4 + (5 + Sqrt[5])/(4 (5 - Sqrt[5])) + (1/2 + 1/2 Sqrt[(5 + Sqrt[5])/(5 - Sqrt[5])])^2) + 2 (1/(10 - 2 Sqrt[5]) - Sqrt[5]/(10 - 2 Sqrt[5]) + 2 Sqrt[2/((10 -2 Sqrt[5]) (5 - Sqrt[5]))]) (1/4 + (5 + Sqrt[5])/(4 (5 - Sqrt[5])) + (1/2 + 1/2 Sqrt[(5 + Sqrt[5])/(5 - Sqrt[5])])^2) + (4 Sqrt[5] ((5 + Sqrt[5])/(5 - Sqrt[5]) + 2 (1/2 + 1/2 Sqrt[(5 + Sqrt[5])/(5 - Sqrt[5])])^2))/(10 - 2 Sqrt[5]),
(4 (1/2 Sqrt[5/(10 - 2 Sqrt[5])] + 1/(2 Sqrt[10 - 2 Sqrt[5]]) - Sqrt[2/(5 - Sqrt[5])]))/(10 - 2 Sqrt[5]) + (4 (-(1/2) Sqrt[5/(10 - 2 Sqrt[5])] - 1/(2 Sqrt[10 - 2 Sqrt[5]]) + Sqrt[2/(5 - Sqrt[5])]))/(10 - 2 Sqrt[5]) + (8 (1/2 Sqrt[5/(10 - 2 Sqrt[5])] - 1/(2 Sqrt[10 - 2 Sqrt[5]]) + 1/2 Sqrt[(5 + Sqrt[5])/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))] - 1/2 Sqrt[(5 (5 + Sqrt[5]))/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]))/(10 - 2 Sqrt[5]) + (8 (1/4 Sqrt[5/(10 - 2 Sqrt[5])] - 1/(4 Sqrt[10 - 2 Sqrt[5]]) - 1/Sqrt[2 (5 - Sqrt[5])] + Sqrt[1/2 (5 + Sqrt[5])]/(5 - Sqrt[5]) - 1/4 Sqrt[(5 + Sqrt[5])/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))] - 1/4 Sqrt[(5 (5 + Sqrt[5]))/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]))/(10 - 2 Sqrt[5]) + (8 (-(1/4) Sqrt[5/(10 - 2 Sqrt[5])] + 1/(4 Sqrt[10 - 2 Sqrt[5]]) + 1/Sqrt[2 (5 - Sqrt[5])] - Sqrt[1/2 (5 + Sqrt[5])]/(5 - Sqrt[5]) + 1/4 Sqrt[(5 + Sqrt[5])/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))] + 1/4 Sqrt[(5 (5 + Sqrt[5]))/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]))/(10 - 2 Sqrt[5]) + (8 (-(1/2) Sqrt[5/(10 -2 Sqrt[5])] + 1/(2 Sqrt[10 - 2 Sqrt[5]]) - 1/2 Sqrt[(5 + Sqrt[5])/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))] + 1/2 Sqrt[(5 (5 + Sqrt[5]))/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]))/(10 - 2 Sqrt[5]) - (Sqrt[2 (5 + Sqrt[5])] (4/(10 - 2 Sqrt[5]) +2 (-(5/Sqrt[50 - 10 Sqrt[5]]) - 1/Sqrt[10 - 2 Sqrt[5]])^2))/(5 - Sqrt[5]) + (-(1/2) Sqrt[5/(10 -2 Sqrt[5])] - 1/(2 Sqrt[10 - 2 Sqrt[5]])) (4/(10 - 2 Sqrt[5]) + 2 (-(5/Sqrt[50 - 10 Sqrt[5]]) - 1/Sqrt[10 - 2 Sqrt[5]])^2) + 2 (-(1/4) Sqrt[5/(10 - 2 Sqrt[5])] + 1/(4 Sqrt[10 - 2 Sqrt[5]]) - 1/4 Sqrt[(5 + Sqrt[5])/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))] - 1/4 Sqrt[(5 (5 + Sqrt[5]))/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]) (4/(10 -2 Sqrt[5]) + 2 (-(5/Sqrt[50 - 10 Sqrt[5]]) - 1/Sqrt[10 - 2 Sqrt[5]])^2) + (Sqrt[2 (5 + Sqrt[5])] (4/(10 - 2 Sqrt[5]) + 2 (5/Sqrt[50 - 10 Sqrt[5]] + 1/Sqrt[10 - 2 Sqrt[5]])^2))/(5 - Sqrt[5]) + (1/2 Sqrt[5/(10 - 2 Sqrt[5])] + 1/(2 Sqrt[10 - 2 Sqrt[5]])) (4/(10 - 2 Sqrt[5]) + 2 (5/Sqrt[50 - 10 Sqrt[5]] + 1/Sqrt[10 -2 Sqrt[5]])^2) + 2 (1/4 Sqrt[5/(10 - 2 Sqrt[5])] - 1/(4 Sqrt[10 - 2 Sqrt[5]]) + 1/4 Sqrt[(5 + Sqrt[5])/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))] + 1/4 Sqrt[(5 (5 + Sqrt[5]))/((10 - 2 Sqrt[5]) (5 - Sqrt[5]))]) (4/(10 - 2 Sqrt[5]) + 2 (5/Sqrt[50 - 10 Sqrt[5]] + 1/Sqrt[10 - 2 Sqrt[5]])^2)}
{1.77636*10-15,0.,0.}
{0,0,0}
4.正二十面体の外接球を求める
In[]:
Print["外接球:", \[ScriptCapitalR] = Circumsphere[Icosahedron[]]]
Print["外接球:", N[%]]
Print["外接半径:", PolyhedronData["Icosahedron", "Circumradius"]]
Print["外接半径:", N[%]]
Graphics3D[{EdgeForm[{Thin, Blue}], FaceForm[{Pink, Opacity[0.2]}],PolyhedronData[pname = "Icosahedron", "Polyhedron"],PolyhedronData[pname, "Circumsphere"]}, Boxed -> False]
Out[]:
外接球:Sphere[{0,0,0},Sqrt[5/8+Sqrt[5]/8]]
外接球:Sphere[{0.,0.,0.},0.951057]
外接半径:1/4 Sqrt[10+2 Sqrt[5]]
外接半径:0.951057
5.正二十面体の内接球の半径を求める
In[]:
Print["内接球:", \[ScriptCapitalR] = Insphere[Icosahedron[]]]
Print["内接球:", N[%]]
Print["内接半径:", PolyhedronData["Icosahedron", "Inradius"]]
Print["内接半径:", N[%]]
Graphics3D[{EdgeForm[{Thin, Blue}], FaceForm[{Pink, Opacity[0.2]}],PolyhedronData["Icosahedron", "Polyhedron"],PolyhedronData[pname, "Insphere"]}, Boxed -> False]
Out[]:
内接球:Sphere[{0,0,0},(3+Sqrt[5])/(4 Sqrt[3])]
内接球:Sphere[{0.,0.,0.},0.755761]
内接半径:1/12 (3 Sqrt[3]+Sqrt[15])
内接半径:0.755761
6.正二十面体の表面積を求める
In[]:
PolyhedronData["Icosahedron","SurfaceArea"]
N[%]
Out[]:
5Sqrt[3]
8.66025
7.正二十面体の体積を求める。
In[]:
PolyhedronData["Icosahedron","Volume"]
N[%]
FunctionExpand[%]
Volume[PolyhedronData["Icosahedron","Polyhedron"]]
N[%]
Out[]:
(5 GoldenRatio2)/6
2.18169
2.18169
5/12 (3+Sqrt[5])
2.1816949
8.Dihedral Angles二面角を求める
In[]:
PolyhedronData["Icosahedron", "DihedralAngles"][[1]]
N[PolyhedronData["Icosahedron", "DihedralAngles"][[1]]]*180/3.14159265358979
Out[]:
ArcSec[-(3/Sqrt[5])]
138.1896851°
9.Central Angleを求める
In[]:
\[Phi] = (1 + Sqrt[5])/2
Print["Central Angle=", 2 ArcSin[Sqrt[5 - Sqrt[5]]/Sqrt[10]]]
Print["Central Angle=",2 ArcSin[Sqrt[5 - Sqrt[5]]/Sqrt[10]]*180/3.14159265358979 "°"]
Print["Dihedral Angles Dodecahedron=", 2 ArcTan[\[Phi]]]
Print["Dihedral Angles Dodecahedron=",2 ArcTan[\[Phi]]*180/3.14159265358979 "°"]
Out[]:
Central Angle=2 ArcSin[Sqrt[1/10 (5-Sqrt[5])]]
Central Angle=63.43494882 °
正二十面体のCentral Angle:63.43494882°と正十二面体の二面角DihedralAngle:116.5650512° の和は180°になる。
Dihedral Angles Dodecahedron=2 ArcTan[1/2 (1+Sqrt[5])]
Dihedral Angles Dodecahedron=116.5650512 °
10.正二十面体の頂点座標を求める
In[]:
PolyhedronData["Icosahedron", "VertexCoordinates"]
N[%]
PolyhedronData["Icosahedron", "FaceIndices"]
With[{poly =PolyhedronData["Icosahedron", "Polyhedron"]},Graphics3D[{MapIndexed[Text[#2[[1]], #, Background -> Yellow] &,PolyhedronCoordinates[poly]], Opacity[.3], poly},Boxed -> False]]
Out[]:
頂点座標
{{0, 0, -(5/Sqrt[50 - 10 Sqrt[5]])}, {0, 0, 5/Sqrt[50 - 10 Sqrt[5]]}, {-Sqrt[(2/(5 - Sqrt[5]))],0, -(1/Sqrt[10 - 2 Sqrt[5]])}, {Sqrt[2/(5 - Sqrt[5])], 0, 1/Sqrt[10 - 2 Sqrt[5]]}, {(1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]), -(1/2), -(1/Sqrt[10 - 2 Sqrt[5]])},
{(1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]), 1/2, -(1/Sqrt[10 - 2 Sqrt[5]])}, {(-1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]), -(1/2), 1/Sqrt[10 - 2 Sqrt[5]]}, {(-1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]), 1/2, 1/Sqrt[10 - 2 Sqrt[5]]},
{(1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]), -(1/2) Sqrt[(5 + Sqrt[5])/(5 - Sqrt[5])], -(1/Sqrt[10 - 2 Sqrt[5]])}, {(1 - Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]),1/2 Sqrt[(5 + Sqrt[5])/(5 - Sqrt[5])], -(1/Sqrt[10 - 2 Sqrt[5]])},
{(-1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]), -(1/2) Sqrt[(5 + Sqrt[5])/(5 - Sqrt[5])],1/Sqrt[10 - 2 Sqrt[5]]}, {(-1 + Sqrt[5])/(2 Sqrt[10 - 2 Sqrt[5]]),1/2 Sqrt[(5 + Sqrt[5])/(5 - Sqrt[5])], 1/Sqrt[10 - 2 Sqrt[5]]}}
頂点座標
{{0., 0., -0.951057}, {0., 0., 0.951057}, {-0.850651, 0., -0.425325}, {0.850651, 0.,0.425325}, {0.688191, -0.5, -0.425325}, {0.688191, 0.5, -0.425325}, {-0.688191, -0.5, 0.425325}, {-0.688191, 0.5,0.425325}, {-0.262866, -0.809017, -0.425325},
{-0.262866,0.809017, -0.425325}, {0.262866, -0.809017, 0.425325}, {0.262866,0.809017, 0.425325}}
面リスト
{{2, 12, 8}, {2, 8, 7}, {2, 7, 11}, {2, 11, 4}, {2, 4, 12}, {5, 9, 1}, {6, 5, 1}, {10, 6, 1}, {3, 10, 1}, {9, 3, 1}, {12, 10, 8}, {8,3, 7}, {7, 9, 11}, {11, 5, 4}, {4, 6, 12}, {5, 11, 9}, {6, 4,5}, {10, 12, 6}, {3, 8, 10}, {9, 7, 3}}
頂点番号
11.正二十面体の展開図を求める
In[]:
PolyhedronData["Icosahedron","Net"]
Out[]:
12. Mean Square Spherical Radiusを求める
In[]:
Integrate[x^2 + y^2 + z^2, {x, y, z} \[Element]PolyhedronData[{"Icosahedron", #}, "Polyhedron"]]/PolyhedronData["Icosahedron", "Volume"] & /@PolyhedronData["Icosahedron", "Orientations"]
N[%]
Integrate[x^2 + y^2 + z^2, {x, y, z} \[Element]PolyhedronData[{"Icosahedron", #}, "Polyhedron"]]/PolyhedronData["Icosahedron", "Volume"] & /@PolyhedronData["Icosahedron", "Orientations"] // FullSimplify
N[%]
Out[]:
文字数が多いので省略
{0.392705, 0.392705, 0.392705}
{3/40 (3+Sqrt[5]),3/40 (3+Sqrt[5]), 3/40 (3+Sqrt[5])}
{0.392705, 0.392705, 0.392705}
13. 正二十面体の慣性InertiaTensorを求める
(*InertiaTensor単位質量を仮定した多面体立体の慣性テンソル*)
In[]:
PolyhedronData["Icosahedron", "InertiaTensor"]
N[%]
MomentOfInertia[PolyhedronData["Icosahedron", "Polyhedron"]]/Volume[PolyhedronData["Icosahedron", "Polyhedron"]] // FullSimplify
N[%]
Out[]:
{{1/20 (3+Sqrt[5]), 0, 0}, {0, 1/20 (3+Sqrt[5]), 0}, {0, 0,1/20 (3+Sqrt[5])}}
{{0.261803, 0., 0.}, {0., 0.261803, 0.}, {0., 0., 0.261803}}
{{1/20 (3+Sqrt[5]), 0, 0}, {0, 1/20 (3+Sqrt[5]), 0}, {0, 0,1/20 (3+Sqrt[5])}}
{{0.261803, 0., 0.}, {0., 0.261803, 0.}, {0., 0., 0.261803}}
14.多角形の双対性を求める
正多面体の面の形をaとする。面の数をfとする。正二十面体はa=3、f=20、af=60。正十二面体はa=5、f=12、af=60。正二十面体と正十二面体は双対である。
In[]:
Table[Graphics3D[{EdgeForm[{Thin, Blue}],FaceForm[{Pink, Opacity[0.6]}], DualPolyhedron[f[1]], f[1]},Boxed -> False], {f, {Icosahedron, Dodecahedron}}]
Out[]:
15.正二十面体諸元の表
Mathematicaの表作りする為のスクリプトは全て記述したが、出力は最後の結果の表だけを記述した。解の一部は厳密解ではなく、近似解である。
Out[]:
In[]:
(*正二十面体Icosahedron*)
ss = Table[{PolyhedronData["Icosahedron", "SchlaefliSymbol"]}]
v = Table[{PolyhedronData["Icosahedron", "VertexCount"]}]
e = Table[{PolyhedronData["Icosahedron", "EdgeCount"]}]
f = Table[{PolyhedronData["Icosahedron", "FaceCount"]}]
ce = Table[{PolyhedronData["Icosahedron", "Centroid"]}]
ci = Table[{PolyhedronData["Icosahedron", "Circumradius"]}]
cin = Table[{N[%]}]
in = Table[{PolyhedronData["Icosahedron", "Inradius"]}]
inn = Table[{N[%]}]
su = Table[{PolyhedronData["Icosahedron", "SurfaceArea"]}]
sun = Table[{N[%]}]
vo = Table[{Volume[PolyhedronData["Icosahedron", "Polyhedron"]]}]
von = Table[{N[%]}]
da = Table[{PolyhedronData["Icosahedron", "DihedralAngles"][[1]]}]
dan = Table[{N[PolyhedronData["Icosahedron", "DihedralAngles"][[1]]]*180/3.14159265358979}]
ve = Table[{PolyhedronData["Icosahedron", "VertexCoordinates"]}]
ven = Table[{N[%]}]
fa = Table[{PolyhedronData["Icosahedron", "FaceIndices"]}]
it = Table[{PolyhedronData["Icosahedron", "InertiaTensor"]}]
itn = Table[{N[%]}]
TableOfValues1 =Prepend[{ss, v, e, f, ce, ci, cin, in, inn, su, sun, vo, von, da,dan, ve, ven, fa, it, itn}, {"値"}]
Grid[TableOfValues1]
TableOfValues2 =MapThread[Prepend, {TableOfValues1, {"正二十面体Icosahedron", "SchlaefliSymbol","頂点数VertexCount", "辺の数EdgeCount", "面の数FaceCount", "重心Centroid","外接半径Circumradius", "外接半径Circumradius", "内接半径Inradius","内接半径Inradius", "表面積SurfaceArea", "表面積SurfaceArea", "体積Volume","体積Volume", "Dihedral Angles二面角", "Dihedral Angles二面角°","頂点座標VertexCoordinates", "頂点座標VertexCoordinates","面リストFaceIndices", "慣性テンソルInertiaTensor","慣性テンソルInertiaTensor"}}]
Grid[TableOfValues2, Frame -> All]
おまけ
外接球と内接球を纏めて描く。ロシアの人形でマトリョーシカがある。外側の人形を外すと内から、また同じ人形が出てくる。昔、プーチンが出続けた人形があった。それに似てなくもない。またトラと思いきや馬鹿トラでもある、またトラ∩馬鹿トラ。習近平しかり。
Graphics3D[{EdgeForm[{Thin, Blue}], FaceForm[{Pink, Opacity[0.2]}],Icosahedron[], Circumsphere[Icosahedron[]], Icosahedron[],Insphere[Icosahedron[]] }, Boxed -> False]
Print["外接半径:", PolyhedronData["Icosahedron", "Circumradius"]]
Print["外接半径:", N[%]]
Print["内接半径:", PolyhedronData["Icosahedron", "Inradius"]]
PolyhedronData["Icosahedron", "Inradius"]
Print["内接半径:", N[%]]
PolyhedronData["Icosahedron", "Circumradius"]
R = N[%]
PolyhedronData["Icosahedron", "Inradius"]
r = N[%]
Print["内接半径/外接半径%=", 100 r/R]
Out[]:
外接半径:1/4 Sqrt[10+2 Sqrt[5]]
外接半径:0.9510565163
内接半径:1/12 (3 Sqrt[3]+Sqrt[15])
内接半径:0.7557613141
内接半径/外接半径%=79.46544723