Platonic Solid

Author

Eric W. Weisstein
December 13, 2018

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polyhedra/PlatonicSolid.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/PlatonicSolid.html.

©2018 Wolfram Research, Inc. except for portions noted otherwise

Solids

GraphicsRow[Graphics3D[#,Boxed->False,Method->{"ShrinkWrap"->True}]&/@PolyhedronData["Platonic","GraphicsComplex"]]

GraphicsRow[Graphics3D[Tooltip[PolyhedronData[#,"GraphicsComplex"],#],Boxed->False,Method->{"ShrinkWrap"->True}]&/@PolyhedronData["Platonic"]]

Nets

Row[PolyhedronData["Platonic","Net"]]

Row[Tooltip[PolyhedronData[#,"Net"],#]&/@PolyhedronData["Platonic"]]

Tables

Faces, Edges, Vertices

TextGrid[PolyhedronData["Platonic",{"Name","F","E","V"}],Dividers->All,Alignment->{{Left,{Decimal}}}]

SurfaceArea, Volume

TextGrid[PolyhedronData["Platonic",{"Name","SurfaceArea","Volume"}],Dividers->All,Alignment->{{Left,{Center}}}]//TraditionalForm

Inradius, Midradius, Circumradius

TextGrid[PolyhedronData["Platonic",{"Name","Inradius","Midradius","Circumradius"}],Dividers->All,Alignment->{{Left,{Center}}}]//TraditionalForm

Dihedral Angles

TextGrid[{PolyhedronData[#,"Name"],ang=PolyhedronData[#,"DihedralAngles"][[1]],N[ang]/Degree}&/@PolyhedronData["Platonic"],Dividers->All,Alignment->{{Left,Center,Decimal}}]//TraditionalForm

Central Angles

CentralAngle[p_]:=Module[{a=ArcCos[Unit[p[[1,1,1]]].Unit[p[[1,1,2]]]]},
{a,N[a]/Degree}
]

TableForm[
Join[{#},FullSimplify[CentralAngle[ToExpression[#<>"Exact"]]]/.ArcSec[x_]:>ArcCos[1/x]]&/@platonics
]

Radius relations

duals=Table[Map[ToExact,Dual[Flatten[Polyhedron[Platonic[n]]]],{3}],{n,5}];//Timing

TableForm[dualradii=Table[
ToExact/@Through[{Inradius,Midradius,Circumradius}[duals[[n]]]],
{n,5}],TableHeadings->{Table[PlatonicName[n]<>" dual",{n,5}],{(Subscript[r, d]),(Subscript[ρ, d]),(Subscript[R, d])}}]//TraditionalForm

ρ=(Subscript[ρ, d])

Equal@@@Transpose[Map[#[[2]]&,{radii,dualradii},{2}]]

Map[#[[2]]&,{radii,dualradii},{2}]//TableForm//TraditionalForm

R (Subscript[r, d])=(ρ^2)

FullSimplify[Times@@Drop[#,-1]-Last[#]^2&/@Transpose[{Last/@radii,First/@dualradii,#[[2]]&/@radii}]]

R=(1/2) ((Sqrt[(a^2)+(Subscript[r, d]^2)])+(Subscript[r, d]))

FullSimplify[#[[1,3]]-(#[[2,1]]+Sqrt[#[[2,1]]^2+1])/2&/@Transpose[{radii,dualradii}]]

R=(Sqrt[((a^2)/4)+(ρ^2)])

FullSimplify[#[[1,3]]-Sqrt[1/4+#[[1,2]]^2]&/@Transpose[{radii,dualradii}]]

(Subscript[r, d])=((ρ^2)/(Sqrt[((a^2)/4)+(ρ^2)]))

FullSimplify[#[[2,1]]-#[[1,2]]^2/Sqrt[1/4+#[[1,2]]^2]&/@Transpose[{radii,dualradii}]]

(Subscript[r, d])=(((R^2)-((a^2)/4))/R)

FullSimplify[#[[2,1]]-(#[[1,3]]^2-1/4)/#[[1,3]]&/@Transpose[{radii,dualradii}]]

ρ=(1/2) (Sqrt[2]) (Sqrt[(Subscript[r, d]^2)+(Sqrt[(a^2)+(Subscript[r, d]^2)]) (Subscript[r, d])])

FullSimplify[#[[1,2]]-Sqrt[#[[2,1]]^2+Sqrt[1+#[[2,1]]^2]#[[2,1]]]Sqrt[2]/2&/@Transpose[{radii,dualradii}]]

Rectification

Show[GraphicsArray[
RectifiedPair/@{TetrahedronExact,CubeExact,OctahedronExact,DodecahedronExact,IcosahedronExact}
]]

Wenninger Plots

Show[GraphicsArray[{
DualEmbeddedPlot[TetrahedronExact//N,{Sqrt[6]/12,(Sqrt[6]/12)/(Sqrt[6]/4)}],
DualEmbeddedPlot[CubeExact//N,{1/2,(1/2)/(Sqrt[3]/2)}],
DualEmbeddedPlot[OctahedronExact//N,{Sqrt[6]/6,(Sqrt[6]/6)/(Sqrt[2]/2)}],
DualEmbeddedPlot[DodecahedronExact//N,{1/20Sqrt[250+110Sqrt[5]],(1/20Sqrt[250+110Sqrt[5]])/((Sqrt[15]+Sqrt[3])/4)}],
DualEmbeddedPlot[IcosahedronExact//N,{1/12(3Sqrt[3]+Sqrt[15]),1/12(3Sqrt[3]+Sqrt[15])/(Sqrt[10+2Sqrt[5]]/4)}]
}]]