It’s Pi day, so I should do something with that. Something I found awhile ago but never drew much attention to is this:
In[]:=
N
7
7
9
4
Out[]=
3.14157
In[]:=
wallissponge=Select[Tuples[Select[Tuples[Range[0,6],{3}],Sign[{3,5,7}-#]=={1,1,1}&],{3}],Max[MapIndexed[Count[#1-#2[[1]],0]&,Transpose[#]]]<2&];Graphics3D[{EdgeForm[None],Cuboid/@((5×7#[[1]]+7#[[2]]+#[[3]]&/@#)&/@wallissponge)},Boxed->False,ImageSize->300]
Out[]=
So, new question. What’s the most spherical isohedron, or fair die? These are polyhedra where all faces are the same.
First, lets build the Disdyakis Triacontahedron from scratch using icosian quaternions, a set of unit quaternions on . Start with (2,0,0,0) and (1,1,1,1), then apply plus/minus, permutations, halving and dot products with () to get the 24 unit quaternions that define the 24-cell. Add (0,1,𝜑,1/𝜑) for the 120-cell. That gives the icosians.
-1====ijk
2
i
2
j
2
k
1,i,j,k
Apply to get the D120 where is triangle ((0,1/𝜑,0,𝜑), (0,0,1,𝜑), (0,0,0,5 𝜑/(𝜑 + 3))). In these, 𝜑 is the golden ratio and is the conjugate of .
(qt)
q
t
q
q
In[]:=
quads={{2,0,0,0},{1,1,1,1},{0,1,1/ϕ,ϕ}}/2/.ϕ->(1+Sqrt[5])/2;cell120=Flatten[ResourceFunction["SignedPermutations"][#,"Even"]&/@quads,1];icosians=SortBy[ResourceFunction["Quaternion"]@@#&/@cell120,Sort[{#,Conjugate[#]}]&];tri=ResourceFunction["Quaternion"]@@#&/@{{0,1/ϕ,0,ϕ},{0,0,1,ϕ},{0,0,0,5ϕ/(ϕ+3)}}/.ϕ->(1+Sqrt[5])/2;all=Table[RootReduce[If[OddQ[g],1,-1]Table[#[[k]],{k,2,4}]]&/@Simplify[((icosians[[g]]**tri)**Conjugate[icosians[[g]]])],{g,1,120}];Graphics3D[{Polygon[#]&/@all},SphericalRegion->True,Boxed->False]
Out[]=
For something similar, see the Neat Examples in the function SignedPermutations. I should follow that up with all the isohedra.
So, the d120 is the most spherical, right? That’s what I thought. Let’s define “most spherical” as the ratio between the insphere and the circumsphere. The closer that ratio is to 1, the more spherical the object is. It turns out the Deltoidal Hexacontahedron is more spherical.
In[]:=
iso=SortBy[{#,PolyhedronData[#,"FaceCount"],PolyhedronData[#,"Inradius"],Max[RootReduce[Norm/@PolyhedronData[#,"VertexCoordinates"]]]}&/@PolyhedronData["Isohedron"],#[[2]]&];winners=Take[SortBy[Append[#,N[#[[3]]/#[[4]]]]&/@iso,-Last[#]&],12];Text@Grid[Prepend[winners,{"shape","faces","inner radius","circumradius","ratio"}]]
Out[]=
shape | faces | inner radius | circumradius | ratio |
DeltoidalHexecontahedron | 60 | 0.924594 | ||
PentagonalHexecontahedron | 60 | 0.918861 | ||
PentakisDodecahedron | 60 | 0.914958 | ||
DisdyakisTriacontahedron | 120 | 3477 964 7707 964 5 | 0.904944 | |
DeltoidalIcositetrahedron | 24 | 39 34 47 34 2 | 0.862856 | |
RhombicTriacontahedron | 30 | 1+ 2 5 | 1 2 5 ) | 0.850651 |
PentagonalIcositetrahedron | 24 | 0.85034 | ||
TriakisIcosahedron | 60 | 477 488 199 5 488 | 0.838505 | |
DisdyakisDodecahedron | 48 | 1 2 3 97 2 | 0.825943 | |
Dodecahedron | 12 | 1 20 250+110 5 | 0.794654 | |
Icosahedron | 20 | 1 12 3 +15 | 0.794654 | |
TetrakisHexahedron | 24 | 2 5 | 2 3 | 0.774597 |
Here are the top four shapes:
In[]:=
Row[PolyhedronData[First[#]]&/@Take[winners,4]]
However, we can tweak vertices by normalizing them.
In[]:=
normed=RootReduce[#/Norm[#]]&/@({{1/ϕ,0,ϕ},{0,1,ϕ},{0,0,5ϕ/(ϕ+3)}}/.ϕ->(1+Sqrt[5])/2);
Once normalized, all of these vertices have a distance of 1 from the origin.
In[]:=
RootReduce[Norm[#]]&/@normed
Out[]=
{1,1,1}
How far is this triangle from the origin? We can calculate the Hessian plane that goes through the points. The last value is the distance from the origin, while the first three components are the normal vector.
In[]:=
plane=RootReduce[ResourceFunction["HessianPlane"][normed]]
Out[]=
,,,
This last value of .94714 is higher than the 0.924594 of the deltoidal, so this object is more spherical.
In[]:=
N[Last[plane]]
Out[]=
0.94714
So lets build it. If you spin this around, you’ll see that it appears to be very close to the deltoidal d60.
In[]:=
tri=ResourceFunction["Quaternion"]@@Prepend[#,0]&/@normed;all=Table[RootReduce[If[OddQ[g],1,-1]Table[#[[k]],{k,2,4}]]&/@Simplify[((icosians[[g]]**tri)**Conjugate[icosians[[g]]])],{g,1,120}];Graphics3D[{Polygon[#]&/@all},SphericalRegion->True,Boxed->False]
How close is it? We can take the volume of the tetrahedron produced by two of the triangles. The closer to 0 it is, the flatter it is.
That’s really flat. It’s not human perceivable.
Adding the edges of the Icosidodecahedron gives a figure with 6+15 = 21 polygon approximated great circles.
Here are those 21 great circles as actual circles.
Happy Pi Day!