Pentakis Dodecahedron

Author

Eric W. Weisstein
January 5, 2024

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

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

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

Figure

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

Solid

PolyhedronData["PentakisDodecahedron","Orientations"]

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

Solid and Dual

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

Net

PolyhedronData["PentakisDodecahedron","Net"]

PolyhedronData["PentakisDodecahedron","Net","Colored"]

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

Properties

Initialization

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify//Timing

(c=PolyhedronCentroid[p])//Timing

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

MyCircumsphere[p]

ConvexHullOf

hullof=DeleteCases[Select[PolyhedronData[All],PolyhedronData[#,"ConvexHullName"]===pname&],pname]

GraphicsGrid[Partition[Graphics3D[{
{Green,Opacity[.8],PolyhedronData[#,"Polyhedron"]},
{Blue,Opacity[.2],PolyhedronData[#,"ConvexHull","Polyhedron"]}},Boxed->False,PlotLabel->Style[PolyhedronData[#,"Name"],Directive[14,Black,Italic,FontFamily->"Times"]]]&/@hullof,UpTo[3]],Dividers->All,ImageSize->200]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//RootReduce//Tally

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

Faces

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

PolyhedronFaceCounts[poly]

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]//RootReduce//Timing

MyInsphere[p]//RootReduce//Timing

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

((MomentOfInertia[p])/(Volume[p]))//RootReduce//Timing

PolyhedronInertiaTensor[p]//RootReduce//Timing

MeanCylindricalRadius

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

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

N[i]

MeanCylindricalSquareRadius

((NIntegrate[(x^2)+(y^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//FullSimplify

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

N[i]

MeanSphericalRadius

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

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

N[i]

MeanSphericalSquareRadius

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

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

N[i]

Midsphere

PolyhedronData[pname,"Midsphere"]

Midsphere[p]//RootReduce//Timing

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

RootReduce[%]

SurfaceArea[p]//RootReduce//Timing

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

VertexSubsetHulls

(h=VertexSubsetHulls[p,"Platonic"])//Timing

g=Function[poly,Graphics3D[{
{Gray,Opacity[.2],EdgeForm[Thick],PolyhedronData[p,"Faces"]},ConvexHull3D[N[PolyhedronData[p,"VertexCoordinates"]][[#]]]&/@poly},Boxed->False]]/@h[[All,2]]

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p,Method->"GaussLaw"]//FullSimplify

Perspective projections

Manipulate[PolyhedronProjectionGraph[PolyhedronData["PentakisDodecahedron","Polyhedron"],{a,b,c}],{a,-1,1},{b,-1,1},{c,-1,1}]

{-1/2,.11,1}

g=PolyhedronProjectionGraph[PolyhedronData["PentakisDodecahedron","Polyhedron"],{-1/2,.11,1},VertexLabels->"Name"]

{-1/2,0,1}

g=PolyhedronProjectionGraph[PolyhedronData["PentakisDodecahedron","Polyhedron"],{-1/2,0,1},VertexLabels->"Name"]

v=GraphEmbedding[g];

{1,(Sqrt[5-2 (Sqrt[5])]),-(1/2) (-1+(Sqrt[5])),-ArcCot[3 (Sqrt[1+(2/(Sqrt[5]))])]}

g=PolyhedronProjectionGraph[PolyhedronData["PentakisDodecahedron","Polyhedron"],{1,(Sqrt[5-2 (Sqrt[5])]),-(1/2) (-1+(Sqrt[5])),-ArcCot[3 (Sqrt[1+(2/(Sqrt[5]))])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[27]]-v[[18]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["PentakisDodecahedron","Polyhedron"],{1,y,-z},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[v[[4]]-v[[30]],y>0&&z>0]

Solve[Thread[Numerator[%]==0],{y,z}]//FullSimplify

N[%]

{1,(Sqrt[5-2 (Sqrt[5])]),-(1/11) (13-5 (Sqrt[5])),ArcTan[(Sqrt[30])]}

g=PolyhedronProjectionGraph[PolyhedronData["PentakisDodecahedron","Polyhedron"],{1,(Sqrt[5-2 (Sqrt[5])]),-(1/11) (13-5 (Sqrt[5])),ArcTan[(Sqrt[30])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[6]]-v[[3]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["PentakisDodecahedron","Polyhedron"],{1,y,-z},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[v[[4]]-v[[20]],y>0&&z>0]

Solve[Thread[Numerator[%]==0],{y,z}]//FullSimplify

N[%]

{1,(Sqrt[5-2 (Sqrt[5])]),-2+(Sqrt[5]),-ArcTan[(Sqrt[15])]}

g=PolyhedronProjectionGraph[PolyhedronData["PentakisDodecahedron","Polyhedron"],{1,(Sqrt[5-2 (Sqrt[5])]),-2+(Sqrt[5]),-ArcTan[(Sqrt[15])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[3]]-v[[6]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["PentakisDodecahedron","Polyhedron"],{1,y,z},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[v[[20]]-v[[26]],y>0&&z>0]

Solve[Thread[Numerator[%]==0],{y,z}]//FullSimplify

N[%]

{0,1,0,-ArcTan[(1/2) (-1+(Sqrt[5]))]}

PolyhedronProjectionGraph[PolyhedronData["PentakisDodecahedron","Polyhedron"],{0,1,0,-ArcTan[(1/2) (-1+(Sqrt[5]))]},VertexLabels->"Name"]

g=PolyhedronProjectionGraph[PolyhedronData["PentakisDodecahedron","Polyhedron"],{0,1,0},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[19]]-v[[24]])//FullSimplify

Construction

PentakisDodecahedronExact=Dual[Polyhedron[TruncatedIcosahedron],Method->Semiregular];

Show[Graphics3D[PentakisDodecahedronExact],Boxed->False]

Net construction

PolyhedronData["PentakisDodecahedron","EdgeLengths"]

({one,a}=SortBy[PolyhedronEdgeLengths[PolyhedronData["PentakisDodecahedron","Polyhedron"]]//RootReduce//Union,N]//Quiet)//Timing

{a}//N

PolyhedronData["PentakisDodecahedron","FaceCountRules"]

Graphics3D[{poly=PolyhedronData["PentakisDodecahedron","Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,v=PolyhedronData["PentakisDodecahedron","VertexCoordinates"]]}]

Graphics3D[tri=Polygon[v[[{9,12,3}]]]]

SortBy[ArcCos[ToAlgebraicRoot/@Cos[PolygonAngle[tri]]]//Quiet//FullSimplify,N]

N[%]

{α,β}=Union@%%

{α,β}={ArcCos[(1/12) (9-(Sqrt[5]))],ArcCos[(1/36) (-7+9 (Sqrt[5]))]};

Rotate[PolyhedronData["PentakisDodecahedron","Net"],.55]

Graphics[{FaceForm[LightYellow,Red],EdgeForm[Black],Polygon[v=PolyhedronData["PentakisDodecahedron","NetCoordinates"],PolyhedronData["PentakisDodecahedron","NetFaceIndices"]],MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

EuclideanDistance@@@{v[[{31,28}]],v[[{32,28}]],v[[{31,32}]]}

Graphics[{FaceForm[LightYellow,Red],EdgeForm[Black],Polygon[v,Take[f,5]],MapIndexed[Text[#2[[1]],#,Background->White]&,Take[v,7]]}]

v=Join[{{0,0}},Table[Through[{Cos,Sin}[β/2+i β]],{i,-3,2}]]//N[#,10000]&;
v=Join[v,SimilarityTransform[v,{{7,6},{2,3}},Range[7]]];
v=Join[v,SimilarityTransform[v,{{3,2},{12,13}},Range[7]]];
v=Join[v,SimilarityTransform[v,{{3,2},{11,17}},Range[7]]];
v=Join[v,SimilarityTransform[v,{{3,2},{10,24}},Range[7]]];
v=Join[v,SimilarityTransform[v,{{3,2},{9,31}},Range[7]]];
f=Append[#,1]&/@Partition[Range[2,7],2,1];
f=Join@@Table[f+7i,{i,0,5}];
Graphics[{FaceForm[LightYellow,Red],EdgeForm[Black],Polygon[v,f],MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

v=Join[v,SimilarityTransform[v,{{39,40},{5,4}},Range[42]]];
f=Join[f,f+42];

Graphics[{FaceForm[LightYellow,Red],EdgeForm[Black],Polygon[v,f],MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

60Area[Polygon[v,{{1,6,7}}]]//N

PolyhedronData["PentakisDodecahedron","SurfaceArea"]//N

Total[Area[Polygon[v,#]]&/@f]//N

rot=RotationMatrix[{v[[46]]-v[[47]],{0,1}}]

rot=IdentityMatrix[2];

v2=(rot.(#-v[[47]]))&/@v;

Graphics[{FaceForm[LightYellow,Red],EdgeForm[Black],Polygon[v2,f]},Axes->True]

vexact=Map[ToAlgebraicRoot[#,WorkingPrecision->1000]&,v2,{2}];//Timing

bug(426316): Area[Polygon[v, f]] returns wrong result

ToAlgebraicRoot@Area[Polygon[vexact,f]]//FullSimplify

ToAlgebraicRoot@Total[Area[Polygon[vexact,#]]&/@f]//FullSimplify

PolyhedronData["PentakisDodecahedron","SurfaceArea"]

vfinal=Union[vexact];

ffinal=Sort[vexact[[#]]&/@f/.Thread[vfinal->Range[Length[vfinal]]]]

vfinal//FullSimplify

Graphics[{FaceForm[LightYellow,Red],EdgeForm[Black],Polygon[vfinal,ffinal]},Axes->True]

ToAlgebraicRoot@Total[Area[Polygon[vfinal,#]]&/@ffinal]//FullSimplify