Mathematicaで描く正多面体と素数の事始めⅠ
はじめに
Mathematicaで描く正十二面体Regular Dodecahedronと正二十面体Regular Icosahedron、更に正八面体Octahedronモニック多項式、正二十面体Icosahedronモニック多項式を記述した。モニック多項式は正多面体と素数 橋本義武 著 放送大学 出版を元に記述した。この本を最初から読んで見ると、正多面体と素数の序章を記述している。更に、正多面体と素数の奥深い世界を探求するには、これら序章を通過しなければならない。今回はMathemaicaでこの序章に当たる所を記述した。相当な字数になり、goo blogの字数制限と言う大人の事情でVol.I~Vol.IIに分割した。
参考文献
正多面体と素数 橋本義武 著 放送大学 出版
シリーズ物
Mathematicaで描く正多面体と素数の事始めⅡ
Mathematicaで描く正四面体Tetrahedron
Mathematicaで描く正六面体Cube
Mathematicaで描く正八面体Octahedron
Mathematicaで描く正十二面体Regular Dodecahedron
Mathematicaで描く正二十面体Regular Icosahedron
Mathematicaで正八面体モニック多項式I、II、III、Ⅳ
Mathematicaで正八面体モニック多項式・演習問題
Mathematicaで正二十面体モニック多項式I、II、III、Ⅳ、Ⅴ
Mathematicaで正二十面体モニック多項式・演習問題I、II
Mathematicaで作成した正多面体諸元の表
Mathematicaで正多面体の三角関数を解く
Mathematicaで正多面体の黄金比の事始め
1.正多面体に現れる素数
1.1多面体と正多面体
1.1.1多面体
多面体（Polyhedron）とは、頂点（vertex）の間を結ぶ辺（edge）によって、表面が幾つかの多角形に分割されている立体の事である。表面の事だけを指す事もある。表面を分割している多角形を多面体の面（face）と呼ぶ。
多面体Pの頂点の個数をv=v（P）、辺の個数をe=e（P）、面の個数をf=f（P）で表す事にする。
例1.1 n角柱の場合、v=2n、e=3n、f=n+2である。n角錐の場合、v=n+1、e=2n、f=n+1である。
いずれの場合も、v-e+f=2となっている。
ドーナツのように、穴の開いている立体もある。ここで穴と云ったのは入口と出口のあるトンネルの事である。立体の穴と云ったら、外部に繋がっていない空間、「す」を指す事もある。「す」は「鬆」と書く。「骨粗鬆症」に使われる漢字である。トンネルと「す」の区別を付けてくれるのが、トポロジー（topology）である。なおトポロジーの教えでは、落とし穴のような物は穴ではない。それはただへこんでいるだけであり、落ちたら落ちたで這い上がれがいい。
トンネルの穴も「す」の穴もない立体については、次が成り立つ。
定理1.1（オイラー（Euler）の多面体定理）穴のない多面体に対し、v-e+f=2が成り立つ。
これはトポロジーの定理である。
証明のアイデアを述べる。
穴のない多面体の表面から面を1つ取り除く。これを変形して、平面の上に乗せる事ができる。これは多角形を多角形に分割した物になっている。よって、この定理は次の定理に帰着される。
定理1.2
多角形を多角形に分割する場合、頂点・辺・面の個数をそれぞれv、e、fとすると、v-e+f=1が成り立つ。
証明
元の多角形の周上の辺を1つ取り除くと面も1つ減る。この場合v-e+fは不変である。
この操作を繰り返すと、面がなくなって頂点と辺だけの図形になる。この図形は1つに繋がっていて、輪になっている部分はない。
定義1.1
（1）頂点を辺で繋いでできる図形をグラフ（graph）と云う。
（2）1つに繋がっていて、輪になっている部分のないグラフをツリー（木、tree）と云う。
（3）ツリーの頂点で、1つの辺のみに繋がっている物を端点あるいは外点と云う。2つ以上の辺に繋がっている物を内点と云う。
ここ迄の論議によって、オイラーEulerの多面体定理は次に帰着されている。
定理1.3
ツリーの頂点・辺の個数をそれぞれv、eとすると、v-e=1が成り立つ。
証明
端点を1つ取り除くと辺も1つ減る。この場合v-eは不変である。この操作を繰り返すと、辺がなくなって1つの頂点だけになる。従って、v-e=1-0=1。
1.1.2正多面体
定義1.2
多面体（Regular Polyhedron）とは、穴のない多面体であって、
（1）全ての互いに合同な正多角形
（2）各頂点から出る辺の個数が同じ
と云う条件を満たす物の事である。古代より、次の定理が知られている。
定理1.4
正多面体は、正四面体（Tetrahedron）、正六面体（Cube）、正八面体（Octahedron）、正十二面体（Dodecahedron）、正二十面体（Icosahedron）の5つのみである。これらをそれぞれ、Te、Cu、Oc、Do、Icと云う記号で表す事にする。
Mathematica
IN[1]:
platonics=PolyhedronData["Platonic"]
Out[1]:
{Tetrahedron,Cube,Octahedron,Dodecahedron,Icosahedron}
巨匠プラトンPlotonと正多面体は何の関係もない。プラトン哲学 ∪ 正多面体と素数は踏破できない高い山。
証明
正多面体の頂点には、少なくとも3つの面が集まっている。従って、正多面体の面に成りうる正多角形の内角は360°/3=120°より小さい。よって、正三、正四、正五角形のみがありうる。正三角形の場合、１つの頂点に3、4、5個の面が集まる事が可能である。正四角形（正方形）、正五角形の場合、１つの頂点に３つの面が集まる事が可能である。この５つの場合に対応する正多面体が、それぞれ正四面体、正六面体、正八面体、正十二面体、正二十面体である。正多角形は無限にあるのに、正多面体は５つしかない。この事実は、古代より神秘的な事と思われてきた。証明できる事であり、且つ神秘的である。と云う事が数学にはあるのである。正多面体五個を纏めて描く。外側から正十二面体、正二十面体、正六面体、正八面体、正四面体の順である(外接半径の大きい順）。参照：Mathematicaで作成した正多面体諸元の表。碌でもない奴に例えると次から次と出てくる。トランプ、習近平、プーチン、ネタニエフ、金正恩、何れも核の亡者。
In[]:
p = PolyhedronData[pname = "Platonic", "Polyhedron"]
Graphics3D[{EdgeForm[{Thin, Blue}], FaceForm[{Pink, Opacity[0.15]}],p}, Boxed -> False]
Out[]:
素人には詳解演習微分積分 水田義弘 著 サイエンス社の解説が分かり易い。第1章数列と極限1.1実数の性質
問題：正多面体の各面がa角形で、各頂点に集まる辺の数をbとする。2/a+2/b=1+2/e、ここでeは正多面体の辺の個数を表す。2/a+2/b＞1を解いて、正多面体を全て求めよ。
答：ab＜2(a+b)であるから(a-2)(b-2)＜4、a≧3、b≧3;
Mathematicaでこの不等式を解く。注：テキストで書くと不等式が表示されないので、ビットマップで入れた。gooブログのhtmlバグ。
In[]:
m1=Table[{PolyhedronData["Tetrahedron","Name"],"3",a3,"3"}]
m2=Table[{PolyhedronData["Octahedron","Name"],"3",a3,"4"}]
m3=Table[{PolyhedronData["Icosahedron","Name"],"3",a3,"5"}]
m4=Table[{PolyhedronData["Cube","Name"],"4",a4,"3"}]
m5=Table[{PolyhedronData["Dodecahedron","Name"],"5",a5,"3"}]
TableOfValues1=Prepend[{m1,m2,m3,m4,m5},{"Name","a角形","b","各頂点に集まる辺の数をb"}]
Grid[TableOfValues1]
TableOfValues2=MapThread[Prepend,{TableOfValues1,{"和名","正四面体","正八面体","正二十面体","正六面体","正十二面体"}}]
Grid[TableOfValues2,Frame->All]
Out[]:
正多面体を解く 一松 信 著 東海大学出版 に更に詳しい説明がなされている。
面の個数をfとすると、af=2eだから以下の五つの正多面体しかない。Mathematicaの表作りする為のスクリプトは全て記述したが、出力は最後の結果の表だけを記述した。
(*"頂点数VertexCount","辺の数EdgeCount","面の数FaceCount"*)
(*正多面体の各面がa角形で、各頂点に集まる辺の数をbとする*)
In[]:
a = 3
b = 3
v = PolyhedronData["Tetrahedron", "VertexCount"]
e = PolyhedronData["Tetrahedron", "EdgeCount"]
f = PolyhedronData["Tetrahedron", "FaceCount"]
m1 = Table[{PolyhedronData["Tetrahedron", "Name"], a, b, e, f, a*f,2 e, v}]
a = 3
b = 4
v = PolyhedronData["Octahedron", "VertexCount"]
e = PolyhedronData["Octahedron", "EdgeCount"]
f = PolyhedronData["Octahedron", "FaceCount"]
m2 = Table[{PolyhedronData["Octahedron", "Name"], a, b, e, f, a*f,2 e, v}]
a = 3
b = 5
v = PolyhedronData["Icosahedron", "VertexCount"]
e = PolyhedronData["Icosahedron", "EdgeCount"]
f = PolyhedronData["Icosahedron", "FaceCount"]
m3 = Table[{PolyhedronData["Icosahedron", "Name"], a, b, e, f, a*f,2 e, v}]
a = 4
b = 3
v = PolyhedronData["Cube", "VertexCount"]
e = PolyhedronData["Cube", "EdgeCount"]
f = PolyhedronData["Cube", "FaceCount"]
m4 = Table[{PolyhedronData["Cube", "Name"], a, b, e, f, a*f, 2 e, v}]
a = 5
b = 3
v = PolyhedronData["Dodecahedron", "VertexCount"]
e = PolyhedronData["Dodecahedron", "EdgeCount"]
f = PolyhedronData["Dodecahedron", "FaceCount"]
m5 = Table[{PolyhedronData["Dodecahedron", "Name"], a, b, e, f, a*f,2 e, v}]
TableOfValues1 =Prepend[{m1, m2, m3, m4, m5}, {"Name", "a", "b", "辺の数e", "面の数f","af", "2e", "頂点数v"}]
Grid[TableOfValues1]
TableOfValues2 =MapThread[Prepend, {TableOfValues1, {"和名", "正四面体", "正八面体", "正二十面体", "正六面体","正十二面体"}}]
Grid[TableOfValues2, Frame -> All]
Out[]
この表でのafが同じ値の正多面体がある。正六面体と正八面体、正十二面体と正二十面体。これら正多角形は双対である。これをMthematicaで描く。
a.正六面体と正八面体の双対性を求める。
In[]:
Table[Graphics3D[{EdgeForm[{Thin, Blue}],FaceForm[{Pink, Opacity[0.6]}], DualPolyhedron[f[1]], f[1]},Boxed -> False], {f, {Cube, Octahedron}}]
Out[]:
b.正十二面体と正二十面体の双対性を求める。
In[]:
Table[Graphics3D[{EdgeForm[{Thin, Blue}],FaceForm[{Pink, Opacity[0.6]}], DualPolyhedron[f[1]], f[1]},Boxed -> False], {f, {Dodecahedron, Icosahedron}}]
Out[]:
1.2頂点・辺・面の個数
1.2.1頂点・辺・面の個数の表
「Mathematicaで作成した正多面体の表」で作成した物を載せた。関数Platonicを使うと簡単に正多面体の諸元が求まる。Mathematicaの表作りする為のスクリプトは全て記述したが、出力は最後の結果の表だけを記述した。
In[]:
m=Table[PolyhedronData["Platonic",{"Name","VertexCount","EdgeCount","FaceCount"}]]
TableOfValues1=Prepend[m,{"Name","頂点数VertexCount","辺の数EdgeCount","面の数FaceCount"}]
Grid[TableOfValues1]
TableOfValues2=MapThread[Prepend,{TableOfValues1,{"和名","正四面体","正六面体","正八面体","正十二面体","正二十面体"}}]
Grid[TableOfValues2,Frame->All]
Out[1]:
正多面体の頂点・辺・面の個数の表を観察すると、同じ数になっている所がある。これは偶然だろうか、それとも何か幾何学的な理由があるのだろうか？正多面体と素数の表はMathematicaで描く正多面体と素数の事始めⅡに記述した。
1.2.2正多面の間の対応
（1）f（Cu）=v（Oc）=6、f（Oc）=v（Cu）=8となっている。これは、立方体の面の中心を隣同士結ぶと正八面体ができ、正八面体の面の中心を隣同士結ぶと正六面体ができる事に由来している。
（2）f（Do）=v（Ic） =12、f（Ic）=v（Do）=20となっている。これは、正十二面体の面の中心を隣同士結ぶと正二十面体ができ、正二十面体の面の中心を隣同士結ぶと正十二面体ができる事に由来している。
（3）f（Te）=v（Te) =4となっている。これは、正四面体の面の中心を隣同士結ぶと再び正四面体ができる事に由来している。
（4）f（Te）=v（Oc）=6となっている。これは、正四面体の辺の中点を結んで正八面体を作る事ができる事に由来している。
（5）f（Cu）=v（Te）=6となっている。これは、立方体の各面に対角線を１つずつ引いて、正四面体を作る事ができる事に対応している。１つの面の対角線を決めると、他の面の対角線は自動的に決まる。
（6）f（Do）=e（Cu）=12となっている。これは、正十二面体の各面に対角線を１つずつ引いて、立方体を作る事ができる事に対応している。1つの面の対角線を決めると、他の面の対角線は自動的に決まる。
1.2.3正多面体の外接球面
正多面体Rに対し、全ての頂点を通る球面Sが存在する。これを外接球面と呼ぶ。外接球面Sの中心から、辺の中点と面の中心をSへ射影する。即ち、中心から辺の中点あるいは面の中心に引いた半直線と、Sの交点を取る。以下、辺の中点・面の中心と云ったら、S上に射影した点を指す事もある。
こうして、Rの頂点の他に、辺の中点と面の中心が外接球面S上にできる。この内、頂点の集合、辺の中点の集合、面の中心の集合を、それぞれRs0 、Rs1、Rs2で表し、Rs0∪Rs1∪Rs2と置く。有限集合Xの元の個数（基数）を|X|で表すと、
|Rs0|=v（R）、|Rs1|=e（R）、|Rs2 |=f（R）
である。
上で述べた正多面体の間の関係は、点の集合Rs の間の関係と見る事もできる。
（1）立方体と正八面体は、集合 Rsが同じである。即ち、Cus=Ocsと見る事ができる。但し、頂点と面の中心が入れ替わっていて、辺の中点同士は一致している。即ち、Cus0=Ocs2 Cus1=Ocs1 Cus2=Ocs0
と見る事ができる。
（2）正十二面体と正二十面体は Rsが同じである。即ち、Dos=Icsと見る事ができる。但し、頂点と面の中心が入れ替わっていて、辺の中点同士は一致している。即ち、
Dos0=Ics2、Dos1=Ics1、Dos2=Ics0
と見る事ができる。
（3）従って、正多面体は５つあるが、対応する外接球面上の点の集合は、Tes、Ocs、Icsの３つである。
（4）Tes0∪Tes2=Ocs2 、Tes1=Ocs0と見なす事ができる。この場合、正四面体の頂点に対応する正八面体の面同士は隣り合わず、正四面体の面に対応する正八面体の面同士は隣り合わない。
（5）Ocs0⊂Ics1、Ocs2 ⊂Ics2と見なす事ができる。故に、Tes ⊂Icsと見なす事ができる。
a.Mathematicaで正四面体の外接球、内接球を纏めて描く。
一辺の長さを1とした。
(*正四面体の外接球 Circumsphere*)
(*正四面体の内接球 Insphere*)
In[]:
Print["外接半径:", \[ScriptCapitalR]1 = Circumsphere[Tetrahedron[]]]
Print["外接半径:", N[%]]
Print["内接半径:", \[ScriptCapitalR]2 = Insphere[Tetrahedron[]]]
Print["内接半径:", N[%]]
Graphics3D[{EdgeForm[{Thin, Blue}], FaceForm[{Pink, Opacity[0.2]}],Tetrahedron[], Circumsphere[Tetrahedron[]], Tetrahedron[],Insphere[Tetrahedron[]] }, Boxed -> False]
Out[]:
外接半径:Sphere[{0,0,0},Sqrt[3/2]/2]
外接半径:Sphere[{0.,0.,0.},0.612372]
内接半径:Sphere[{0,0,0},1/(2Sqrt[6])]
内接半径:Sphere[{0.,0.,0.},0.204124]
b.Mathematicaで正六面体の外接球、内接球を纏めて描く
一辺の長さを1とした。
(*正六面体の外接球 Circumsphere*)
(*正六面体の内接球 Insphere*)
In[]:
Print["外接半径:", \[ScriptCapitalR]1 = Circumsphere[Cube[]]]
Print["外接半径:", N[%]]
Print["内接半径:", \[ScriptCapitalR]2 = Insphere[Cube[]] ]
Print["内接半径:", N[%]]
Graphics3D[{EdgeForm[{Thin, Blue}], FaceForm[{Pink, Opacity[0.2]}],Cube[], Circumsphere[Cube[]], Cube[], Insphere[Cube[]] },Boxed -> False]
Out[]:
外接半径:Sphere[{0,0,0},Sqrt[3]/2]
外接半径:Sphere[{0.,0.,0.},0.866025]
内接半径:Sphere[{0,0,0},1/2]
内接半径:Sphere[{0.,0.,0.},0.5]
c.Mathematicaで正八面体の外接球、内接球を纏めて描く。
一辺の長さを1とした。
(*正八面体の外接球 Circumsphere*)
(*正八面体の内接球 Insphere*)
In[]:
Print["外接半径:", \[ScriptCapitalR]1 = Circumsphere[Octahedron[]]]
Print["外接半径:", N[%]]
Print["内接半径:", \[ScriptCapitalR]2 = Insphere[Octahedron[]]]
Print["内接半径:", N[%]]
Graphics3D[{EdgeForm[{Thin, Blue}], FaceForm[{Pink, Opacity[0.2]}],Octahedron[], Circumsphere[Octahedron[]], Octahedron[],Insphere[Octahedron[]] }, Boxed -> False]
Out[]:
外接半径:Sphere[{0,0,0},Sqrt[5/8+Sqrt[5]/8]]
外接半径:Sphere[{0.,0.,0.},0.707107]
内接半径:Sphere[{0,0,0},1/Sqrt[6]]
内接半径:Sphere[{0.,0.,0.},0.408248]
続編：Mathematicaで描く正多面体と素数の事始めⅡ
