I recently added a stupidly useful function to the WFR, SignedPermutations. At the end of the function, and here, you can see how all 18 classic polyhedra can be constructed as 1-liners.
Let’s look at one of them. The icosidodecahedron can be constructed from two vectors:
In[]:=
icosidodecahedron=Join@@[#,"Even"]&/@{0,0,ϕ},{1,ϕ,}2;
2
ϕ
In[]:=
ϕ=1+
1
2
5
;ConvexHullMesh[icosidodecahedron,ImageSize->Tiny]Out[]=
Let’s pull the polygons out of that. First, lets make sure that the vertices are in the same order:
In[]:=
ConvexHullRegion[icosidodecahedron][[1]]==icosidodecahedron
Out[]=
True
We can thus pull the polygons right out of ConvexHullRegion.
In[]:=
Graphics3D[Polygon[icosidodecahedron[[#]]]&/@ConvexHullRegion[icosidodecahedron][[2]]]
Out[]=
The data in PolyhedronData is all good, but it’s not the simplest presentation:
In[]:=
Union[Sort/@RootReduce[Abs[PolyhedronData["Icosidodecahedron","VertexCoordinates"]]]]
Out[]=
0,0,(1+,,0,(3+,0,,,,,,(1+,,(1+,,(3+,
1
2
5
),0,1
2
1
4
5
),1
2
1
4
5
),1
4
5
),1
4
5
),Whether the simplest presentation is useful is debatable, but there it is.
In[]:=
Union[Sort/@RootReduce[Abs[icosidodecahedron]]]
Out[]=
0,0,(1+,(1+(3+
1
2
5
),1
2
1
4
5
),1
4
5
)I also took at a look at the icosians in the function:
In[]:=
ϕ=RootReduce[GoldenRatio];vecs=Join@@(ResourceFunction["SignedPermutations"][#,"Even"]&/@{{2,0,0,0},{1,1,1,1},{0,1,ϕ^-1,ϕ}}/2);icosians=ResourceFunction["Quaternion"]@@#&/@RootReduce[vecs];
The quaternions can be used for rotations. For point , it’s , with NonCommutativeMultiply (**) after the point has been turned into a quaternion. Rest[List@@] then gives the rotated point.
{a,b,c}
r=q**{0,a,b,c}**
q
r
In[]:=
triangle=ResourceFunction["Quaternion"]@@Prepend[#,0]&/@0,
(3-ϕ)/5
,(2+ϕ)/5
,{1,1/ϕ,ϕ}2,{1,1,1}3
;rot=Table[Rest/@(List@@((icosians[[k]]**#)**Conjugate[icosians[[k]]])&/@triangle),{k,1,120}];Graphics3D[{Polygon/@rot},SphericalRegion->True]Out[]=
That’s half of the Disdyakis Triacontahedron. Quaternions are great for 3D rotations, not so good for reflections. Also, each triangle is put into position by 2 of the icosian quaternions, so there’s some clean-up that can be done.
I’ve written the following many times in combination with Permutations:
In[]:=
Tuples[{-1,1},{3}]
Out[]=
{{-1,-1,-1},{-1,-1,1},{-1,1,-1},{-1,1,1},{1,-1,-1},{1,-1,1},{1,1,-1},{1,1,1}}
I’ve probably written the SignedPermutations function a hundred times, so it’s nice to finally cross it off. And now, that neat example:
Create vertex sets for all 5 Platonic solids and 13 Archimedean solids with unit edges:
In[]:=
ϕ=1+;ξ=;tetrahedron=Select[{1,1,1}],EvenQ[Count[Sign[#],-1]]&Sqrt[8];cube=[{1,1,1}/2];octahedron=[{0,0,1}]Sqrt[2];icosahedron=[{0,1,ϕ},"Cyclic"]2;dodecahedron=Join@@[#,"Cyclic"]&/@{{1,1,1},{0,ϕ,1/ϕ}}(2/ϕ);cuboctahedron=[{0,1,1}]Sqrt[2];icosidodecahedron=Join@@[#,"Even"]&/@{0,0,ϕ},{1,ϕ,}2;rhombicuboctahedron=[{1,1,1+Sqrt[2]},"Even"]2;rhombicosidodecahedron=Join@@[#,"Even"]&/@{{1,1,},{,ϕ,2ϕ},{2+ϕ,0,}}2;truncatedcube=[{Sqrt[2]-1,1,1}](Sqrt[2]-1)2;truncatedoctahedron=[{0,1,2}]Sqrt[2];truncatedtetrahedron=Select[{1,1,3}],EvenQ[Count[Sign[#],-1]]&Sqrt[8];truncatedcuboctahedron=[{1,1+Sqrt[2],1+2Sqrt[2]}]2;truncateddodecahedron=Join@@[#,"Even"]&/@{{0,1/ϕ,2+ϕ},{1/ϕ,ϕ,2ϕ},{ϕ,2,ϕ+1}}(2ϕ-2);truncatedicosahedron=Join@@[#,"Even"]&/@{{0,1,3ϕ},{1,2+ϕ,2ϕ},{ϕ,2,2ϕ+1}}2;truncatedicosidodecahedron=Join@@[#,"Even"]&/@{1/ϕ,1/ϕ,3+ϕ},{2/ϕ,ϕ,1+2ϕ},1ϕ,,3ϕ-1,{2ϕ-1,2,2+ϕ},{ϕ,3,2ϕ}(2ϕ-2);snubcube=JoinSelect[{1,1/t,t},"Even"],EvenQ[Count[Sign[#],1]]&,Select[{1,1/t,t},"Odd"],OddQ[Count[Sign[#],1]]&Sqrt[2+4t-2t^2];snubdodecahedron=JoinSelectJoin@@[#,"Even"]&/@,OddQ[Count[Sign[#],-1]]&,SelectJoin@@[#,"Even"]&/@,EvenQ[Count[Sign[#],-1]]&2;poly={tetrahedron,cube,octahedron,icosahedron,dodecahedron,cuboctahedron,icosidodecahedron,rhombicuboctahedron,rhombicosidodecahedron,truncatedcube,truncatedoctahedron,truncatedtetrahedron,truncatedcuboctahedron,truncateddodecahedron,truncatedicosahedron,truncatedicosidodecahedron,snubcube,snubdodecahedron};
1
2
5
;t=2
ϕ
3
ϕ
2
ϕ
2
ϕ
2
ϕ
In[]:=
Grid[Partition[Graphics3D[Sphere[#,1/2],ImageSize->Tiny,Boxed->False]&/@poly,6]]
Out[]=
 |  |  |  |  |  |
 |  |  |  |  |  |
 |  |  |  |  |  |
Show the polyhedra:
In[]:=
Grid[Partition[ConvexHullMesh[N[#],ImageSize->Tiny]&/@poly,6]]
Out[]=
 |  |  |  |  |  |
 |  |  |  |  |  |
 |  |  |  |  |  |