Truncated Icosahedron

Author

Eric W. Weisstein
January 5, 2024

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

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

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

Figure

With[{pname="TruncatedIcosahedron"},
GraphicsRow[{
Graphics3D[{Opacity[.8],PolyhedronData[pname,"Polyhedron"]},Boxed->False],
Graphics3D[{PolyhedronData[pname,"Lines"]},Boxed->False],
PolyhedronData[pname,"Net"]
},ImageSize->700]]

Solid

PolyhedronData["TruncatedIcosahedron","Orientations"]

Show[PolyhedronData[{"TruncatedIcosahedron",#}],Boxed->False]&/@PolyhedronData["TruncatedIcosahedron","Orientations"]

Solid and Dual

GraphicsRow[PolyhedronData["TruncatedIcosahedron",#]&/@{"Graphics3D","Dual","DualCompound"}]

UniformPolyhedron

uniform=UniformPolyhedron[stdname="TruncatedIcosahedron"]

PolyhedronFaceTally[uniform]

indices=UniformPolyhedronIndex[stdname]

UniformPolyhedron/@{
stdname,
Lookup[indices,"Wenninger"],
Sequence@@(List@@@Normal[indices]/."Maeder"->"Uniform")
}

SameQ@@%

Graphics3D/@(polys=Polygon[uniform[[1]],#]&/@uniform[[2]])

Graphics3D[#,Boxed->False]&/@{uniform,polys}

Bulatov

BulatovUniformName[UniformPolyhedronIndex[stdname,"Kaleido"]]

BulatovUniformGraphics3D[UniformPolyhedronIndex[stdname,"Kaleido"],Boxed->False]

bulatov=BulatovUniformPolyhedron[UniformPolyhedronIndex[stdname,"Kaleido"]]

Graphics3D/@(polys=Polygon[bulatov[[1]],#]&/@bulatov[[2]])

PolyhedronFaceTally[bulatov]

Graphics3D[#,Boxed->False]&/@{bulatov,polys}

Maeder

MaederUniformName[UniformPolyhedronIndex[stdname,"Maeder"]]

wythoff=MaederWythoffSymbol[UniformPolyhedronIndex[stdname,"Maeder"]]

With[{n=UniformPolyhedronIndex[stdname,"Maeder"]},Import["https://www.mathconsult.ch/static/unipoly/"<>If[n<10,"0",""]<>ToString[n]<>".html","Images"]][[1]]

maeder=MaederUniformPolyhedron[UniformPolyhedronIndex[stdname,"Maeder"]]

Graphics3D/@(polys=Polygon[maeder[[1]],#]&/@maeder[[2]])

PolyhedronFaceTally[maeder]

Graphics3D[#,Boxed->False]&/@{maeder,polys}

Net

PolyhedronData["TruncatedIcosahedron","Net"]

PolyhedronData["TruncatedIcosahedron","Net","Colored"]

NetPrintout[PolyhedronData["TruncatedIcosahedron","Polyhedron"],"TruncatedIcosahedron.pdf"]

Properties

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname="TruncatedIcosahedron","Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData["TruncatedIcosahedron","Centroid"]

RegionCentroid[PolyhedronData["TruncatedIcosahedron","Polyhedron"]]//RootReduce//Timing

Circumradius

PolyhedronData["TruncatedIcosahedron","Circumradius"]

RootReduce[%]

Circumsphere[PolyhedronData["TruncatedIcosahedron","Polyhedron"]]//RootReduce//Timing

MyCircumsphere[PolyhedronData["TruncatedIcosahedron","Polyhedron"]]//RootReduce//Timing

DihedralAngles

Show[Graphics3D[{poly,
MapIndexed[Text[#2[[1]],#1]&,Centroid/@poly//N]
}],Boxed->False]

{5,6}

Show[Graphics3D[p=poly[[{6,13}]]],Boxed->False]

π-RootReduce/@(DihedralAngle@@p)

InputForm[%]

N[%]180/Pi

{6,6}

Show[Graphics3D[p=poly[[{13,17}]]],Boxed->False]

RootReduce[π-DihedralAngle@@p]

InputForm[%]

N[%]180/Pi

Dual

pname

dname=PolyhedronData[pname,"Dual","Name"]

PolyhedronData[pname,"Dual","Scale"]

midrs={PolyhedronData[pname,"Midradius"],PolyhedronData[dname,"Midradius"]}

Divide@@midrs//FullSimplify

GraphicsRow[With[{
s={Yellow,PolyhedronData[pname,"Midsphere"]},
style=Directive[Black,Italic,FontFamily->"Times",14]
},
{
Graphics3D[{s,Green,Opacity[.5],PolyhedronData[pname,"Polyhedron"]},Boxed->False,PlotLabel->TextCell[Style[PolyhedronData[pname,"Name"],style],PageWidth->200,TextAlignment->Center]],
Graphics3D[{s,Red,Opacity[.5],PolyhedronData[pname,"Dual","Polyhedron"]},Boxed->False,PlotLabel->Style[PolyhedronData[dname,"Name"],style]],
Graphics3D[{
{Green,Opacity[.5],PolyhedronData[pname,"Polyhedron"]},
{Red,Opacity[.5],PolyhedronData[pname,"Dual","Polyhedron"]},
s
},Boxed->False,PlotLabel->Style["compound with midsphere",style]],
Graphics3D[{
PolyhedronData[pname,"Polyhedron"],
PolyhedronData[pname,"Dual","Polyhedron"]
},Boxed->False,PlotLabel->Style["compound",style]]
}],Alignment->Top,ImageSize->800]

Faces

PolyhedronFaceList[poly]

Show[GraphicsArray[partition[PolyhedronFaces[poly],5]]]

Pentagonal Faces

pent1=v[[{18,8,15,9,17}]];
pent2=v[[{14,5,19,20,4}]];

Show[Graphics3D[{
Polygon[pent1],LabelVertices[pent1]
}],Boxed->False]

Show[Graphics3D[{
Polygon[pent2],LabelVertices[pent2]
}],Boxed->False]

a=FullSimplify[Centroid[pent1]][[1]]

b=FullSimplify[Centroid[pent2]][[1]]

Together//@FullSimplify[Sqrt[(a-b).(a-b)]]

Hexagonal Faces

hex1=v[[{13,26,28,2,5,14}]];
hex2=v[[{11,8,15,16,31,29}]];

Show[Graphics3D[Polygon[hex1]],Boxed->False]

Show[Graphics3D[Polygon[hex2]],Boxed->False]

a=Centroid[hex1][[1]]//FullSimplify

b=Centroid[hex2][[1]]//FullSimplify

Together//@FullSimplify[Sqrt[(a-b).(a-b)]]

EdgeLengths

PolyhedronData["TruncatedIcosahedron","EdgeLengths"]

PolyhedronData["TruncatedIcosahedron","Lines"]/.Line[l_]:>EuclideanDistance@@l//FullSimplify//Union

Inradius

PolyhedronData["TruncatedIcosahedron","Inradius"]

Insphere[PolyhedronData["TruncatedIcosahedron","Polyhedron"]]

MyInsphere[PolyhedronData["TruncatedIcosahedron","Polyhedron"]]//RootReduce//Timing

InertiaTensor

PolyhedronData["TruncatedIcosahedron","InertiaTensor"]

(i=((MomentOfInertia[p,{0,0,0}])/(PolyhedronData[pname,"Volume"])))//Timing

Map[RootApproximant[N[#,1000],8]&,i,{2}]//Quiet//FullSimplify

N[%28-i,10^4]//Quiet

PolyhedronInertiaTensor[p]//Timing

MeanCylindricalRadius

NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈PolyhedronData["TruncatedIcosahedron","Polyhedron"]]/PolyhedronData["TruncatedIcosahedron","Volume"]

Integrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈PolyhedronData["TruncatedIcosahedron","Polyhedron"]]/PolyhedronData["TruncatedIcosahedron","Volume"]//Timing

N[%]

MeanCylindricalSquareRadius

(i=((Integrate[(x^2)+(y^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"])))//Timing

N[i]

r=RootApproximant[N[i,1000],64]//FullSimplify

N[r-i,5000]//Quiet

MeanSphericalRadius

NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈PolyhedronData["TruncatedIcosahedron","Polyhedron"]]/PolyhedronData["TruncatedIcosahedron","Volume"]

Integrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈PolyhedronData["TruncatedIcosahedron","Polyhedron"]]/PolyhedronData["TruncatedIcosahedron","Volume"]//Timing

CylindricalDecomposition[PolyhedronData["TruncatedIcosahedron","RegionFunction"][x,y,z],{x,y,z}]

MeanSphericalSquareRadius

i=((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈PolyhedronData["TruncatedIcosahedron","Polyhedron"]])/(PolyhedronData["TruncatedIcosahedron","Volume"]))

N[i]

r=RootApproximant[N[i,1000],64]//Quiet

N[r-i,5000]

Midradius

PolyhedronData["TruncatedIcosahedron","Midradius"]

Midsphere[PolyhedronData["TruncatedIcosahedron","Polyhedron"]]//RootReduce//Timing

Surface Area

PolyhedronData["TruncatedIcosahedron","SurfaceArea"]

RootReduce[%]

SurfaceArea[PolyhedronData["TruncatedIcosahedron","Polyhedron"]]//RootReduce//Timing

Total[Area/@PolyhedronData["TruncatedIcosahedron","Polygons"]]//RootReduce//Timing

Volume

PolyhedronData["TruncatedIcosahedron","Volume"]

Volume[PolyhedronData["TruncatedIcosahedron","Polyhedron"]]//FullSimplify//Timing

PolyhedronVolume[PolyhedronData["TruncatedIcosahedron","Polyhedron"],Method->"GaussLaw"]//RootReduce//Timing

Projections

projs={{1,(Sqrt[5-2 (Sqrt[5])]),-2,π/2-ArcTan[(1/2)+(3/(2 (Sqrt[5])))]},{(1/5) (Sqrt[25-2 (Sqrt[5])]),1,-(Sqrt[(2/(5 (5+(Sqrt[5]))))]),π/2-ArcTan[(NumericalApproximation[Root, (RowDefault["-0.433", FEExpressionsNumericalApproximationElider]), Root[361-1946 ((#1)^2)+109 ((#1)^4)&,2], ])]} ,{1,0,1},{1,1,0},{(Sqrt[109-(242/(Sqrt[5]))]),1,(NumericalApproximation[Root, (RowDefault["0.248", FEExpressionsNumericalApproximationElider]), Root[16-260 ((#1)^2)+5 ((#1)^4)&,3], ]),ArcCot[(Sqrt[(1/62) (817+303 (Sqrt[5]))])]},{(1/4) (3-(Sqrt[5])+(Sqrt[10-2 (Sqrt[5])])),(1/4) (3-(Sqrt[5])+(Sqrt[10-2 (Sqrt[5])])),1,π-ArcTan[(NumericalApproximation[Root, (RowDefault["0.343", FEExpressionsNumericalApproximationElider]), Root[656-12976 ((#1)^2)+68136 ((#1)^4)-44676 ((#1)^6)+1681 ((#1)^8)&,6], ])]},{1,0,-(3/22) (-7+(Sqrt[5]))},{1/2,(1/2) (Sqrt[5+2 (Sqrt[5])]),1,π/2-ArcTan[(1/2)-(3/(2 (Sqrt[5])))]},{1,(Sqrt[85-38 (Sqrt[5])]),-2+(Sqrt[5]),π-ArcTan[(NumericalApproximation[Root, (RowDefault["-0.368", FEExpressionsNumericalApproximationElider]), Root[25-190 ((#1)^2)+41 ((#1)^4)&,2], ])]},{1,(1/11) (Sqrt[185-82 (Sqrt[5])]),-(2/11) (-4+(Sqrt[5])),ArcTan[(Sqrt[2-((2 (Sqrt[5]))/3)])]},{(1/11) (Sqrt[229-(382/(Sqrt[5]))]),1,(2/11) (Sqrt[34-(62/(Sqrt[5]))]),ArcTan[(5/2)+((7 (Sqrt[5]))/6)]},{2-((Sqrt[5])/2),(1/2) (Sqrt[5-2 (Sqrt[5])]),1,ArcCot[2 (Sqrt[1+(2/(Sqrt[5]))])]},{1,(Sqrt[85-38 (Sqrt[5])]),3-(Sqrt[5]),ArcCot[(3/(Sqrt[2]))]},{(1/2) (-1+(Sqrt[5])),(NumericalApproximation[Root, (RowDefault["-0.449", FEExpressionsNumericalApproximationElider]), Root[5-25 ((#1)^2)+((#1)^4)&,2], ]),1},{0,0,1}};

PolyhedronProjectionGraph[PolyhedronData["TruncatedIcosahedron","Polyhedron"],#]&/@projs

i=0;
gs=Monitor[(emb=PolyhedronProjectionGraph[
PolyhedronData["TruncatedIcosahedron","Polyhedron"],
++i;proj=#,
"Simplification"->FullSimplify])&/@projs,Column[{proj,emb,Row[{i,"/",Length[projs]}],ProgressIndicator[i,{1,Length[projs]}]}]];//Timing

GraphData["TruncatedIcosahedralGraph","Graph","Perspective"]

Vertex subset hulls

Platonic

(h=VertexSubsetHulls[PolyhedronData["TruncatedIcosahedron","Polyhedron"],"Platonic","Skip"->{}])//Timing

Construction

TruncatedIcosahedron:=MiscPolyhedra`UniformPolyhedron[25]

TruncatedIcosahedronExact:=TruncatedIcosahedronExact=Module[{Trunc={},Triangles={{1,2,6},{1,2,3},{1,3,4},{1,4,5},{1,5,6},{12,11,10},{12,10,9},{12,9,8},{12,8,7},{12,7,11},{2,7,3},{3,7,8},{3,8,4},{4,8,9},{4,9,5},{5,9,10},{5,10,6},{6,10,11},{6,11,2},{2,11,7}},i,j,k,Verts,V,Paul,Hex={},Hexes={},Convex={},Ew,minl,a=Sqrt[(5-Sqrt[5])/2],b=Sqrt[(2(5-Sqrt[5]))/5],c=Sqrt[(5-Sqrt[5])/10],d=Sqrt[(5-2Sqrt[5])/5],e=Sqrt[(5+Sqrt[5])/10],f=(-1+Sqrt[5])/2},Do[Verts[j]={};
Do[If[MemberQ[Triangles[[i]],j],Verts[j]=Union[Verts[j],Complement[Triangles[[i]],{j}]]],{i,Length[Triangles]}];
Trunc=Union[Trunc,{Thread[V[Table[j,{k,Length[Verts[j]]}],Verts[j]]]}],{j,12}];
Hexes={};
Do[Paul=Triangles[[j]];
Hex={};
Do[If[i==Length[Paul],k=1,k=i+1];
Hex=Join[Hex,{V[Paul[[i]],Paul[[k]]]},{V[Paul[[k]],Paul[[i]]]}],{i,Length[Paul]}];
AppendTo[Hexes,Hex],{j,Length[Triangles]}];
V[i_,j_]:=V[j]+2V[i];
V[1]={0,0,a};
V[2]={b,0,c};
V[3]={d,1,c};
V[4]={-e,f,c};
V[5]={-e,-f,c};
V[6]={d,-1,c};
V[7]={e,f,-c};
V[8]={-d,1,-c};
V[9]={-b,0,-c};
V[10]={-d,-1,-c};
V[11]={e,-f,-c};
V[12]={0,0,-a};
Do[(*Sort polygon vertices to get convex polygons!*)Ew=Trunc[[k]];
minl=9999.;
Do[(*Find minimum vertex-vertex distance*)Do[r2=(Ew[[i]]-Ew[[j]]).(Ew[[i]]-Ew[[j]]);
If[r2<minl,minl=r2],{j,i+1,Length[Ew]}],{i,Length[Ew]-1}];
j=1;
While[j≤Length[Ew]-1,(*If any distances are bigger than the min,shuffle order to make convex*)If[Abs[(Ew[[j]]-Ew[[j+1]]).(Ew[[j]]-Ew[[j+1]])-minl]>.1,Ew=Append[Ew,Ew[[j+1]]];
Ew=Delete[Ew,j+1],(*Else*)j++;]];
AppendTo[Convex,Ew],{k,Length[Trunc]}];
OrientCentered[Flatten[{Polygon/@(Convex/(Sqrt[5]-1)),Polygon/@(Hexes/(Sqrt[5]-1))},1]]]