LoginSignup
3
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

@ikiuo

正多面体のデータ（厳密値）

Last updated at Posted at 2021-07-04

「正多面体のデータを作る」を Mathematica のデータにしてみました。

データは

  • 頂点の一つは (0,0,1)
  • 半径１の球に内接

の条件で作られています。

以下、Mathematica 用のコードと頂点データです。

正四面体
正四面体
RegularTetrahedronVertexData = Module[
  {
    r2 = Sqrt[2],
    r3 = Sqrt[3],
    x1, x2, y1, z1
  },
  x1 = (2*r2)/3;
  x2 = r2/3;
  y1 = r2/r3;
  z1 = 1/3;
  {
    {   0,   0,   1 },
    {  x1,   0, -z1 },
    { -x2, +y1, -z1 },
    { -x2, -y1, -z1 }
  }
]
RegularTetrahedronVertexIndex = {
  { 1, 2, 3 },
  { 1, 3, 4 },
  { 1, 4, 2 },
  { 2, 4, 3 }
}
RegularTetrahedron = Polyhedron[RegularTetrahedronVertexData, RegularTetrahedronVertexIndex]
Graphics3D[%]

頂点データと三角形の対応

x y z
1 $0$ $0$ $1$ ● ● ●
2 $\frac{2\sqrt{2}}{3}$ $0$ $-\frac{1}{3}$ ● ● ●
3 $-\frac{\sqrt{2}}{3}$ $\sqrt{\frac{2}{3}}$ $-\frac{1}{3}$ ● ● ●
4 $-\frac{\sqrt{2}}{3}$ $-\sqrt{\frac{2}{3}}$ $-\frac{1}{3}$ ● ● ●

縦が頂点番号で、縦方向の「●」が三角形で、横方向の「●」は接する面になる。

正六面体
正六面体
RegularHexahedronVertexData = Module[
  {
    r2 = Sqrt[2],
    r3 = Sqrt[3],
    x1, x2, y1,
    z1 = 1/3
  },
  x1 = (2*r2)/3;
  x2 = r2/3;
  y1 = r2/r3;
  {
    {   0,   0,   1 },
    {  x1,   0,  z1 },
    { -x2,  y1,  z1 },
    { -x2, -y1,  z1 },
    {  x2, -y1, -z1 },
    {  x2,  y1, -z1 },
    { -x1,   0, -z1 },
    {   0,   0,  -1 }
  }
]
RegularHexahedronVertexIndex = {
  { 1, 2, 6, 3 },
  { 1, 3, 7, 4 },
  { 1, 4, 5, 2 },
  { 2, 5, 8, 6 },
  { 3, 6, 8, 7 },
  { 4, 7, 8, 5 }
}
RegularHexahedron = Polyhedron[RegularHexahedronVertexData, RegularHexahedronVertexIndex]
Graphics3D[%]

頂点データと四角形の対応

x y z
1 $0$ $0$ $1$ ● ● ●
2 $\frac{2\sqrt{2}}{3}$ $0$ $\frac{1}{3}$ ● ●
3 $-\frac{\sqrt{2}}{3}$ $\sqrt{\frac{2}{3}}$ $\frac{1}{3}$ ● ● ●
4 $-\frac{\sqrt{2}}{3}$ $-\sqrt{\frac{2}{3}}$ $\frac{1}{3}$ ● ● ●
5 $\frac{\sqrt{2}}{3}$ $-\sqrt{\frac{2}{3}}$ $-\frac{1}{3}$ ● ● ●
6 $\frac{\sqrt{2}}{3}$ $\sqrt{\frac{2}{3}}$ $-\frac{1}{3}$ ● ● ●
7 $-\frac{2\sqrt{2}}{3}$ $0$ $-\frac{1}{3}$ ● ● ●
8 $0$ $0$ $-1$ ● ● ●

縦が頂点番号で、縦方向の「●」が四角形で、横方向の「●」は接する面になる。

正八面体
正八面体
RegularOctahedronVertexData = {
  {  0,  0,  1 },
  {  1,  0,  0 },
  {  0,  1,  0 },
  { -1,  0,  0 },
  {  0, -1,  0 },
  {  0,  0, -1 }
}
RegularOctahedronVertexIndex = {
  { 1, 2, 3 },
  { 1, 3, 4 },
  { 1, 4, 5 },
  { 1, 5, 2 },
  { 2, 5, 6 },
  { 2, 6, 3 },
  { 3, 6, 4 },
  { 4, 6, 5 }
}
RegularOctahedron = Polyhedron[RegularOctahedronVertexData, RegularOctahedronVertexIndex]
Graphics3D[%]

頂点データ

x y z
1 $0$ $0$ $1$ ● ● ● ●
2 $1$ $0$ $0$ ● ● ● ●
3 $0$ $1$ $0$ ● ● ● ●
4 $-1$ $0$ $0$ ● ● ● ●
5 $0$ $-1$ $0$ ● ● ● ●
6 $0$ $0$ $-1$ ● ● ● ●

縦が頂点番号で、縦方向の「●」が三角形で、横方向の「●」は接する面になる。

正十二面体
正十二面体
RegularDodecahedronVertexData = Module[
  {
    r2 = Sqrt[2],
    r3 = Sqrt[3],
    r5 = Sqrt[5],
    x1, x2, x3, x4, x5,
    y1, y2, y3,
    z1, z2
  },
  x1 = 2/3;
  x2 = 1/3;
  x3 = r5/3;
  x4 = (3-r5)/6;
  x5 = (3+r5)/6;
  y1 = 1/r3;
  y2 = Sqrt[(3+r5)/6];
  y3 = Sqrt[(3-r5)/6];
  z1 = r5/3;
  z2 = 1/3;
  {
    {   0,   0,   1 },
    {  x1,   0,  z1 },
    { -x2,  y1,  z1 },
    { -x2, -y1,  z1 },
    {  x3,  y1,  z2 },
    {  x3, -y1,  z2 },
    {  x4,  y2,  z2 },
    {  x4, -y2,  z2 },
    { -x5,  y3,  z2 },
    { -x5, -y3,  z2 },
    {  x5, -y3, -z2 },
    {  x5,  y3, -z2 },
    { -x4, -y2, -z2 },
    { -x4,  y2, -z2 },
    { -x3, -y1, -z2 },
    { -x3,  y1, -z2 },
    {  x2, -y1, -z1 },
    {  x2,  y1, -z1 },
    { -x1,   0, -z1 },
    {   0,   0,  -1 }
  }
]
RegularDodecahedronVertexIndex = {
  {  1,  2,  5,  7,  3 },
  {  1,  3,  9, 10,  4 },
  {  1,  4,  8,  6,  2 },
  {  2,  6, 11, 12,  5 },
  {  3,  7, 14, 16,  9 },
  {  4, 10, 15, 13,  8 },
  {  5, 12, 18, 14,  7 },
  {  6,  8, 13, 17, 11 },
  {  9, 16, 19, 15, 10 },
  { 11, 17, 20, 18, 12 },
  { 13, 15, 19, 20, 17 },
  { 14, 18, 20, 19, 16 }
}
RegularDodecahedron = Polyhedron[RegularDodecahedronVertexData, RegularDodecahedronVertexIndex]
Graphics3D[%]

頂点データ

x y z
1 $0$ $0$ $1$ ● ● ●
2 $\frac{2}{3}$ $0$ $\frac{\sqrt{5}}{3}$ ● ● ●
3 $-\frac{1}{3}$ $ \frac{1}{\sqrt{3}}$ $\frac{\sqrt{5}}{3}$ ● ● ●
4 $-\frac{1}{3}$ $-\frac{1}{\sqrt{3}}$ $\frac{\sqrt{5}}{3}$ ● ● ●
5 $\frac{\sqrt{5}}{3}$ $ \frac{1}{\sqrt{3}}$ $\frac{1}{3}$ ● ● ●
6 $\frac{\sqrt{5}}{3}$ $-\frac{1}{\sqrt{3}}$ $\frac{1}{3}$ ● ● ●
7 $ \frac{1}{6}\left(3-\sqrt{5}\right)$ $ \sqrt{\frac{1}{6}\left(3+\sqrt{5}\right)}$ $\frac{1}{3}$ ● ● ●
8 $ \frac{1}{6}\left(3-\sqrt{5}\right)$ $-\sqrt{\frac{1}{6}\left(3+\sqrt{5}\right)}$ $\frac{1}{3}$ ● ● ●
9 $-\frac{1}{6}\left(3+\sqrt{5}\right)$ $ \sqrt{\frac{1}{6}\left(3-\sqrt{5}\right)}$ $\frac{1}{3}$ ● ● ●
10 $-\frac{1}{6}\left(3+\sqrt{5}\right)$ $-\sqrt{\frac{1}{6}\left(3-\sqrt{5}\right)}$ $\frac{1}{3}$ ● ● ●
11 $ \frac{1}{6}\left(3+\sqrt{5}\right)$ $-\sqrt{\frac{1}{6}\left(3-\sqrt{5}\right)}$ $-\frac{1}{3}$ ● ● ●
12 $ \frac{1}{6}\left(3+\sqrt{5}\right)$ $ \sqrt{\frac{1}{6}\left(3-\sqrt{5}\right)}$ $-\frac{1}{3}$ ● ● ●
13 $-\frac{1}{6}\left(3-\sqrt{5}\right)$ $-\sqrt{\frac{1}{6}\left(3+\sqrt{5}\right)}$ $-\frac{1}{3}$ ● ● ●
14 $-\frac{1}{6}\left(3-\sqrt{5}\right)$ $ \sqrt{\frac{1}{6}\left(3+\sqrt{5}\right)}$ $-\frac{1}{3}$ ● ● ●
15 $-\frac{\sqrt{5}}{3}$ $-\frac{1}{\sqrt{3}}$ $-\frac{1}{3}$ ● ● ●
16 $-\frac{\sqrt{5}}{3}$ $ \frac{1}{\sqrt{3}}$ $-\frac{1}{3}$ ● ● ●
17 $ \frac{1}{3}$ $-\frac{1}{\sqrt{3}}$ $-\frac{\sqrt{5}}{3}$ ● ● ●
18 $ \frac{1}{3}$ $ \frac{1}{\sqrt{3}}$ $-\frac{\sqrt{5}}{3}$ ● ● ●
19 $-\frac{2}{3}$ $0$ $-\frac{\sqrt{5}}{3}$ ● ● ●
20 $0$ $0$ $-1$ ● ● ●

縦が頂点番号で、縦方向の「●」が五角形で、横方向の「●」は接する面になる。

正二十面体
正二十面体
RegularIcosahedronVertexData = Module[
  {
    r2 = Sqrt[2],
    r3 = Sqrt[3],
    r5 = Sqrt[5],
    x1, x2, x3,
    y1, y2,
    z1
  },
  x1 = 2/r5;
  x2 = (5-r5)/10;
  x3 = (5+r5)/10;
  y1 = Sqrt[(5+r5)/10];
  y2 = Sqrt[(5-r5)/10];
  z1 = 1/r5;
  {
    {   0,   0,   1 },
    {  x1,   0,  z1 },
    {  x2,  y1,  z1 },
    {  x2, -y1,  z1 },
    { -x3,  y2,  z1 },
    { -x3, -y2,  z1 },
    {  x3, -y2, -z1 },
    {  x3,  y2, -z1 },
    { -x2, -y1, -z1 },
    { -x2,  y1, -z1 },
    { -x1,   0, -z1 },
    {   0,   0,  -1 }
  }
]
RegularIcosahedronVertexIndex = {
   {  1,  2,  3 },
   {  1,  3,  5 },
   {  1,  5,  6 },
   {  1,  6,  4 },
   {  1,  4,  2 },
   {  2,  4,  7 },
   {  2,  7,  8 },
   {  2,  8,  3 },
   {  3,  8, 10 },
   {  3, 10,  5 },
   {  4,  6,  9 },
   {  4,  9,  7 },
   {  5, 10, 11 },
   {  5, 11,  6 },
   {  6, 11,  9 },
   {  7,  9, 12 },
   {  7, 12,  8 },
   {  8, 12, 10 },
   {  9, 11, 12 },
   { 10, 12, 11 }
}
RegularIcosahedron = Polyhedron[RegularIcosahedronVertexData, RegularIcosahedronVertexIndex]
Graphics3D[%]

頂点データ

x y z
1 $0$ $0$ $1$ ● ● ● ● ●
2 $\frac{2}{\sqrt{5}}$ $0$ $\frac{1}{\sqrt{5}}$ ● ● ● ● ●
3 $ \frac{1}{10}\left(5-\sqrt{5}\right)$ $ \sqrt{\frac{1}{10}\left(5+\sqrt{5}\right)}$ $\frac{1}{\sqrt{5}}$ ● ● ● ● ●
4 $ \frac{1}{10}\left(5-\sqrt{5}\right)$ $-\sqrt{\frac{1}{10}\left(5+\sqrt{5}\right)}$ $\frac{1}{\sqrt{5}}$ ● ● ● ● ●
5 $-\frac{1}{10}\left(5+\sqrt{5}\right)$ $ \sqrt{\frac{1}{10}\left(5-\sqrt{5}\right)}$ $\frac{1}{\sqrt{5}}$ ● ● ● ● ●
6 $-\frac{1}{10}\left(5+\sqrt{5}\right)$ $-\sqrt{\frac{1}{10}\left(5-\sqrt{5}\right)}$ $\frac{1}{\sqrt{5}}$ ● ● ● ● ●
7 $ \frac{1}{10}\left(5+\sqrt{5}\right)$ $-\sqrt{\frac{1}{10}\left(5-\sqrt{5}\right)}$ $-\frac{1}{\sqrt{5}}$ ● ● ● ● ●
8 $ \frac{1}{10}\left(5+\sqrt{5}\right)$ $ \sqrt{\frac{1}{10}\left(5-\sqrt{5}\right)}$ $-\frac{1}{\sqrt{5}}$ ● ● ● ● ●
9 $-\frac{1}{10}\left(5-\sqrt{5}\right)$ $-\sqrt{\frac{1}{10}\left(5+\sqrt{5}\right)}$ $-\frac{1}{\sqrt{5}}$ ● ● ● ● ●
10 $-\frac{1}{10}\left(5-\sqrt{5}\right)$ $ \sqrt{\frac{1}{10}\left(5+\sqrt{5}\right)}$ $-\frac{1}{\sqrt{5}}$ ● ● ● ● ●
11 $-\frac{2}{\sqrt{5}}$ $0$ $-\frac{1}{\sqrt{5}}$ ● ● ● ● ●
12 $0$ $0$ $-1$ ● ● ● ● ●

縦が頂点番号で、縦方向の「●」が三角形で、横方向の「●」は接する面になる。

Mathematica での生成プログラム

正多面体のデータを作る[改] (HTML+JavaScript版) の方法で計算します。

正十二面体と正二十面体の計算では時間がかかります。

RegularPolyhedron
RegularPolyhedron[nNormal_] := Module[{$Assumptions = Reals,
   nVertex = nNormal + (2 + 6 Floor[Mod[nNormal + 3, 9]/4]) (1 - Mod[nNormal, 3]),
   nVertPerPoly = 3 + Floor[Mod[nNormal^4, 202]/64],
   nEdgePerVert = 3 + Floor[Mod[nNormal + 6, 9]/4],
   fSimplify, fIsNew, fAddNew, fPickup, fAxis, fUpdate, fMake, fPVLink, fPolygon,
   pCos, pSin, qCos, qSin, rCos, rSin, vertex, mRot, n1, n2, n3,
   normal, vCos, vMap},
  fSimplify = FullSimplify;
  fIsNew = Module[{vectors = #1, target = #2, fTest},
     fTest = fSimplify[# == target] &; (Length[Select[vectors, fTest]] == 0)] &;
  fAddNew = Module[{pList = #1, nList = #2, data},
     Do[data = nList[[i]]; If[fIsNew[pList, data], pList = Append[pList, data]], {i, Length[nList]}]; pList] &;
  fPickup = Module[{center = #2, value = #3, fTest},
     fTest = fSimplify[# . center == value] &; Select[#1, fTest]] &;
  fAxis = Module[{x, y, z}, x = #1; y = fSimplify[Cross[x, #2]/#3];
     z = fSimplify[Cross[x, y]]; {x, y, z}] &;
  fUpdate = Module[{center = #1[[#2]], vcos = #1[[1]] . #1[[2]], vnew = #3, aSin = #4},
     fAddNew[#1, Map[fSimplify[vnew . fAxis[center, #, aSin]] &, fPickup[#1, center, vcos]]]] &;
  fMake = Module[{elen = #1, aSin = #2, vectors, plen, nlen, vnew},
     vectors = #3;
     vnew = fSimplify[fAxis[vectors[[1]], vectors[[2]], aSin] . vectors[[3]]];
     plen = 1; nlen = Length[vectors];
     While[plen < nlen,
      Do[Print[{"Progress", i, Length[vectors], elen}];
       If[Length[vectors] >= elen, Break[]];
       vectors = fUpdate[vectors, i, vnew, aSin], {i, nlen}];
      plen = nlen + 1; nlen = Length[vectors]];
     FullSimplify[vectors]] &;
  fPVLink = Module[{vectors = fPickup[#1, #2, #3], v1, v2 = #2, v3},
     v1 = vectors[[1]]; v3 = vectors[[2]];
     If[fSimplify[#4 == Normalize[Cross[v2 - v1, v3 - v2]]], v2 -> v3, v2 -> v1]] &;
  fPolygon = Module[{vvecs = fPickup[#1, #2, #3], center = #2, vcos = #4, vmap, vp},
     vmap = Association[];
     Do[AssociateTo[vmap, fPVLink[vvecs, vvecs[[i]], vcos, center]], {i, Length[vvecs]}];
     vp = vvecs[[1]]; Table[#5[vp = vmap[vp]], {i, Length[vvecs]}]] &;
  pCos = fSimplify[2 Cos[Pi/nVertPerPoly]^2 Csc[Pi/nEdgePerVert]^2 - 1];
  pSin = fSimplify[Sqrt[1 - pCos^2]];
  rCos = Cos[2 Pi/nEdgePerVert]; rSin = Sin[2 Pi/nEdgePerVert];
  vertex = fMake[nVertex, pSin, {{0, 0, 1}, {pSin, 0, pCos}, {fSimplify[pSin rCos], fSimplify[pSin rSin], pCos}}];
  mRot = {{rCos, -rSin, 0}, {rSin, rCos, 0}, {0, 0, 1}};
  n1 = fSimplify[Normalize[Cross[vertex[[1]] - vertex[[3]], vertex[[2]] - vertex[[1]]]]];
  n2 = fSimplify[mRot . n1]; n3 = fSimplify[mRot . n2];
  qCos = fSimplify[n1 . n2]; qSin = fSimplify[Sqrt[1 - qCos^2]];
  normal = fMake[nNormal, qSin, {n1, n2, n3}];
  vCos = fSimplify[n1[[3]]];
  vMap = Association[]; Do[AssociateTo[vMap, vertex[[i]] -> i], {i, Length[vertex]}];
  Polyhedron[vertex, Table[fPolygon[vertex, normal[[i]], vCos, pCos, vMap], {i, Length[normal]}]]]

(*正四面体*)Graphics3D[RegularPolyhedron[4]]
(*正六面体*)Graphics3D[RegularPolyhedron[6]]
(*正八面体*)Graphics3D[RegularPolyhedron[8]]
(*正十二面体*)Graphics3D[RegularPolyhedron[12]]
(*正二十面体*)Graphics3D[RegularPolyhedron[20]]
3
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
3
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?