Disdyakis Triacontahedron

Author

Eric W. Weisstein
January 5, 2024

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

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

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

Figure

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

Graphics

Solid

PolyhedronData["DisdyakisTriacontahedron","Orientations"]

Show[PolyhedronData["DisdyakisTriacontahedron"],Boxed->False]

Solid and Dual

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

Net

PolyhedronData["DisdyakisTriacontahedron","Net"]

PolyhedronData["DisdyakisTriacontahedron","Net","Colored"]

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

Properties

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

Centroid

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p]//RootReduce//Timing

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

MyCircumsphere[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//RootReduce//Tally

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

Edge 1

Show[Graphics3D[p=poly[[{24,30}]]],Boxed->False]

d1=FullSimplify[π-DihedralAngle@@p]

N[%]180/Pi

Edge 2

Show[Graphics3D[p=poly[[{24,96}]]],Boxed->False]

d2=FullSimplify[π-DihedralAngle@@p]

N[%]180/Pi

Edge 3

Show[Graphics3D[p=poly[[{78,96}]]],Boxed->False]

d3=FullSimplify[π-DihedralAngle@@p]

N[%]180/Pi

Summary

Equal@@{d1,d2,d3}

InputForm[d1]

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]//FullSimplify

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

Faces

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

PolyhedronFaceCounts[poly]

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

MyInsphere[p]//RootReduce//Timing

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

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

PolyhedronInertiaTensor[p]//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"]))//FullSimplify)//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"]))//FullSimplify)//Timing

N[i]

Midsphere

PolyhedronData[pname,"Midsphere"]

Midsphere[p]//FullSimplify//Timing

Net

PolyhedronData[pname,"Net"]

v=PolyhedronData[pname,"NetCoordinates"];
f=PolyhedronData[pname,"NetFaceIndices"];

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

Total[Area[Polygon[v,f]]]//RootReduce//FullSimplify

N[%]

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

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

RootReduce[%]

SurfaceArea[p]//FullSimplify//Timing

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

VertexSubsetHull

p="DisdyakisTriacontahedron";
v=PolyhedronData[p,"VertexCoordinates"];

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

g=Function[poly,Graphics3D[{
{Gray,Opacity[.2],EdgeForm[Thickness[.001]],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["DisdyakisTriacontahedron","Polyhedron"],{a,b,c}],{a,-1,1},{b,-1,1},{c,-1,1}]

{(1/10) (-5+3 (Sqrt[5])),(1/10) (5-(Sqrt[5])),1,ArcTan[(NumericalApproximation[Root, (RowDefault["0.588", FEExpressionsNumericalApproximationElider]), Root[5-20 ((#1)^2)+16 ((#1)^4)&,3], ])]}

{.085,.13,.48}/.48

g=PolyhedronProjectionGraph[PolyhedronData["DisdyakisTriacontahedron","Polyhedron"],{(1/10) (-5+3 (Sqrt[5])),(1/10) (5-(Sqrt[5])),1,ArcTan[(NumericalApproximation[Root, (RowDefault["0.588", FEExpressionsNumericalApproximationElider]), Root[5-20 ((#1)^2)+16 ((#1)^4)&,3], ])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[5]]-v[[8]])//FullSimplify

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

v=GraphEmbedding[g];

Numerator[FullSimplify[v[[1]]-v[[51]],x>0&&y>0]]

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

N[%299]

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

{.4,.6,.235}/.6

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

v=GraphEmbedding[g];

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

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

v=GraphEmbedding[g];

FullSimplify[v[[50]]-v[[17]],x>0&&z>0]

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

N[%]

{(1/8) (9-(Sqrt[5])),1,0}

{.4,.48,0}/.48

g=PolyhedronProjectionGraph[PolyhedronData["DisdyakisTriacontahedron","Polyhedron"],{(1/8) (9-(Sqrt[5])),1,0},VertexLabels->"Name"]

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

v=GraphEmbedding[g];

FullSimplify[v[[62]]-v[[14]],x>0]

Solve[Thread[%==0],x]//FullSimplify

N[%]

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

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

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

v=GraphEmbedding[g];

FullSimplify[v[[24]]-v[[62]],z>0]

Solve[Thread[%==0],z]//FullSimplify

N[%]

{1,(1/278) (-19+129 (Sqrt[5])),(5/278) (-17+13 (Sqrt[5])),-ArcCot[(3/(Sqrt[1630-728 (Sqrt[5])]))]}

g=PolyhedronProjectionGraph[PolyhedronData["DisdyakisTriacontahedron","Polyhedron"],{1,.9,.225},VertexLabels->"Name"]

g=PolyhedronProjectionGraph[PolyhedronData["DisdyakisTriacontahedron","Polyhedron"],{1,(1/278) (-19+129 (Sqrt[5])),(5/278) (-17+13 (Sqrt[5])),-ArcCot[(3/(Sqrt[1630-728 (Sqrt[5])]))]},VertexLabels->"Name"]

v=GraphEmbedding[g];

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

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

v=GraphEmbedding[g];

eqn=Numerator[FullSimplify[v[[62]]-v[[17]],x>0&&y>0]]

Solve[Thread[eqn==0],{x,y}]//FullSimplify

N[%]

{1,1,0}

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

{1,1,1,-ArcCot[(Sqrt[3 (9+4 (Sqrt[5]))])]}

g=PolyhedronProjectionGraph[PolyhedronData["DisdyakisTriacontahedron","Polyhedron"],{1,1,1,-ArcCot[(Sqrt[3 (9+4 (Sqrt[5]))])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[15]]-v[[16]])//FullSimplify

Construction

DisdyakisTriacontahedronExact=OrientCentered[Dual[Polyhedron[GreatRhombicosidodecahedron],Method->Semiregular]];

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

Net construction

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

{a,b}//N

PolyhedronData["DisdyakisTriacontahedron","FaceCountRules"]

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

Graphics3D[tri=Polygon[v[[{48,7,33}]]]]

{α,β,γ}=SortBy[ArcCos[ToAlgebraicRoot/@Cos[PolygonAngle[tri]]]//Quiet//FullSimplify,N]

{α,β,γ}={ArcCos[(1/24) (9+5 (Sqrt[5]))],ArcCos[(3/4)-(1/(2 (Sqrt[5])))],ArcCos[(1/30) (5-2 (Sqrt[5]))]}

N[%]

Rotate[PolyhedronData["DisdyakisTriacontahedron","Net"],-.2]

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

v=Join[{{0,0}},a Table[Through[{Cos,Sin}[-2i α-Pi+2α]],{i,0,4}],b Table[Through[{Cos,Sin}[-2i α+3α-Pi]],{i,0,5}]]//N[#,10000]&;
v=Join[v,SimilarityTransform[v,{{12,6},{11,6}},Range[12]]];
v=Join[v,SimilarityTransform[v,{{11,6},{23,17}},Range[12]]];
v=Join[v,SimilarityTransform[v,{{6,11},{16,22}},Range[12]]];
v=Join[v,SimilarityTransform[v,{{11,6},{21,15}},Range[12]]];
v=Join[v,SimilarityTransform[v,{{11,6},{20,14}},Range[12]]];
v=Join[v,SimilarityTransform[v,{{3,8},{3,9}},Range[72]]];

f=Append[#,1]&/@Partition[{7,2,8,3,9,4,10,5,11,6,12},2,1];
f=Join@@Table[f+12i,{i,0,5}];
f=Join[f,f+72];

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

RootReduce[Area[Polygon[v,f]]]//N

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

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

rot=RotationMatrix[{v[[80]]-v[[75]],{0,1}}];

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

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

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

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

PolyhedronData["DisdyakisTriacontahedron","SurfaceArea"]

vfinal=Union[vexact];

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

vfinal//FullSimplify

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

Quit

v=PolyhedronData[pname,"NetCoordinates"];

f=PolyhedronData[pname,"NetFaceIndices"];

Graphics3D[{FaceForm[Green,Red],EdgeForm[Black],Polygon[Append[#,0]&/@v,f]},Axes->True]

Graphics[{PolyhedronData["DisdyakisTriacontahedron","Net"][[1]],MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

Sort[Reverse/@f]

v=PolyhedronData[pname="DisdyakisTriacontahedron","NetCoordinates"];

f=PolyhedronData[pname,"NetFaceIndices"];

Graphics3D[{FaceForm[Green,Red],EdgeForm[Black],Polygon[Append[#,0]&/@v,f]},Axes->True]