Deltoidal Hexecontahedron

Author

Eric W. Weisstein
January 5, 2024

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

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

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

Figure

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

Graphics

Solid

PolyhedronData["DeltoidalHexecontahedron","Orientations"]

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

Solid and Dual

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

Net

PolyhedronData["DeltoidalHexecontahedron","Net"]

PolyhedronData["DeltoidalHexecontahedron","Net","Colored"]

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

Properties

Centroid

PolyhedronData["DeltoidalHexecontahedron","Centroid"]

RegionCentroid[PolyhedronData["DeltoidalHexecontahedron","Polyhedron"]]//RootReduce

PolyhedronCentroid[PolyhedronData["DeltoidalHexecontahedron","Polyhedron"]]//RootReduce

Circumradius

PolyhedronData["DeltoidalHexecontahedron","Circumradius"]

Circumsphere[PolyhedronData["DeltoidalHexecontahedron","Polyhedron"]]

MyCircumsphere[PolyhedronData["DeltoidalHexecontahedron","Polyhedron"]]

DihedralAngles

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

{4,4,{3}}

Show[Graphics3D[p=poly[[{52,88}]]],Boxed->False]

FullSimplify[π-DihedralAngle@@p]

RootReduce[π-ArcCos[4 (Sqrt[(2/(3 (5+(Sqrt[5]))))]) Root[209+964 #1-1952 ((#1)^2)-7360 ((#1)^3)+1536 ((#1)^4)+9216 ((#1)^5)+4096 ((#1)^6)&,4]]]

InputForm[%]

N[%]180/Pi

{4,4,{4}}

Show[Graphics3D[p=poly[[{62,68}]]],Boxed->False]

FullSimplify[π-DihedralAngle@@p]

InputForm[%]

N[%]180/Pi

{4,4,{5}}

Show[Graphics3D[p=poly[[{16,57}]]],Boxed->False]

FullSimplify[π-DihedralAngle@@p]

InputForm[%]

N[%]180/Pi

EdgeLengths

PolyhedronData["DeltoidalHexecontahedron","EdgeLengths"]

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

Faces

PolyhedronFaces[poly]//Length

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

Inequalities

And@@PolyhedronInequalities[Polyhedron[poly],{#1,#2,#3}]//InputForm

InertiaTensor

PolyhedronData["DeltoidalHexecontahedron","InertiaTensor"]

((MomentOfInertia[PolyhedronData["DeltoidalHexecontahedron","Polyhedron"]])/(Volume[PolyhedronData["DeltoidalHexecontahedron","Polyhedron"]]))//RootReduce//Timing

PolyhedronInertiaTensor[PolyhedronData["DeltoidalHexecontahedron","Polyhedron"]]//Timing

Inradius

PolyhedronData["DeltoidalHexecontahedron","Inradius"]

Insphere[PolyhedronData["DeltoidalHexecontahedron","Polyhedron"]]//RootReduce//Timing

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

MeanCylindricalRadius

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

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

N[%]

MeanCylindricalSquareRadius

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

FullSimplify[i]

MeanSphericalRadius

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

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

MeanSphericalSquareRadius

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

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

FullSimplify[%]

Midradius

PolyhedronData["DeltoidalHexecontahedron","Midradius"]

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

SurfaceArea

PolyhedronData["DeltoidalHexecontahedron","SurfaceArea"]

RootReduce[%]

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

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

VertexSubsetHulls

(h=VertexSubsetHulls[PolyhedronData["DeltoidalHexecontahedron","Polyhedron"],"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]]

h[[All,2]]

Graphics3D[Function[f,ConvexHull3D[N[v][[#]]]&/@f]/@h[[All,2]],Boxed->False]

Volume

PolyhedronData["DeltoidalHexecontahedron","Volume"]

Volume[PolyhedronData["DeltoidalHexecontahedron","Polyhedron"]]//FullSimplify

PolyhedronVolume[PolyhedronData["DeltoidalHexecontahedron","Polyhedron"],Method->"GaussLaw"]//FullSimplify

Perspective projections

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

{1,0,1}

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

{0,(1/11) (7+(Sqrt[5])),1}

{0,.57,.68}/.68

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

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

v=GraphEmbedding[g];

FullSimplify[v[[7]]-v[[12]],z>0]

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

N[%]

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

FunctionExpand@GoldenRatio-1//FullSimplify

{.005,.425,.685}/.685

g=PolyhedronProjectionGraph[PolyhedronData["DeltoidalHexecontahedron","Polyhedron"],{0,FunctionExpand@GoldenRatio-1,1},VertexLabels->"Name"]

{-(5/6) (-3+(Sqrt[5])),(1/6) (-11+7 (Sqrt[5])),1,-ArcCot[(Sqrt[(1/202) (331+50 (Sqrt[5]))])]}

{.35,.425,.535}/.535

g=PolyhedronProjectionGraph[PolyhedronData["DeltoidalHexecontahedron","Polyhedron"],{-(5/6) (-3+(Sqrt[5])),(1/6) (-11+7 (Sqrt[5])),1,-ArcCot[(Sqrt[(1/202) (331+50 (Sqrt[5]))])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[60]]-v[[42]])//FullSimplify

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

v=GraphEmbedding[g];

eqn=FullSimplify[v[[60]]-v[[43]],x>0&&y>0]

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

N[%]

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

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

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

v=GraphEmbedding[g];

FullSimplify[v[[29]]-v[[56]],z>0]

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

{0,1,0}

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

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

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

v=GraphEmbedding[g];

ArcTan@@(v[[42]]-v[[50]])//FullSimplify

Exact construction

(Subscript[C, 4])

Off[N::"meprec"]

Timing[dual=Dual[Polyhedron[SmallRhombicosidodecahedron]];]

<<Utilities`Simplify`

Timing[poly=Map[ToExact,dual,{3}];]

(v=PolyhedronVertices[poly])//InputForm
First/@poly/.Thread[v->Range[Length[v]]]

(Subscript[C, 3])

Graphics3D[{Polyhedron[DeltoidalHexecontahedron],MapIndexed[Text[#2[[1]],#1]&,v=PolyhedronVertices[DeltoidalHexecontahedron]]}]//Show

Normalize[v_]:=v/Sqrt[v.v]

θ=FullSimplify[ArcCos[Dot@@(Normalize/@{v[[2]],v[[10]]})]]

Show[Graphics3D[poly=(Polyhedron[DeltoidalHexecontahedron]/.Polygon[x_]:>Polygon[RotationMatrixX[θ].#&/@x]),ViewPoint->5{0,0,1}]]

(First[Position[PolyhedronFaces[DeltoidalHexecontahedron],#]]&/@Range[Length[PolyhedronVertices[DeltoidalHexecontahedron]]])

Range[Length[PolyhedronVertices[DeltoidalHexecontahedron]]]

FullSimplify[RootReduce[poly[[1,#[[1]],1,#[[2]]]]&/@(First[Position[PolyhedronFaces[DeltoidalHexecontahedron],#]]&/@Range[Length[PolyhedronVertices[DeltoidalHexecontahedron]]])]]//InputForm

Net construction

<<MathWorld`Polyhedra`

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

a//N

PolyhedronData["EquilateralChamferedIcosahedron","FaceCountRules"]

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

Graphics3D[kite=Polygon[v[[{6,40,8,44}]]]]

R=EuclideanDistance@@v[[{6,8}]]//FullSimplify

h=EuclideanDistance@@v[[{40,44}]]//FullSimplify

N[{R,h}]

ArcCos[ToAlgebraicRoot/@Cos[PolygonAngle[kite]]]//FullSimplify//Quiet

N[%]

N[{α,β,γ}={ArcCos[(1/40) (-5+9 (Sqrt[5]))],ArcCos[(1/2)-(1/(Sqrt[5]))],ArcCos[(1/20) (-5-2 (Sqrt[5]))]}]

PolyhedronData["DeltoidalHexecontahedron","Net"]

<<MathWorld`Polyhedra`

v=Join[{{0,0}},a Table[Through[{Cos,Sin}[i α]],{i,0,5}],R Table[Through[{Cos,Sin}[i α+α/2]],{i,0,4}]]//N[#,10000]&;
v=DeleteDuplicates[Map[Identity,Join[v,SimilarityTransform[v,{{4,10},{3,8}},Range[12]]],{2}],(Norm[#-#2]<.0001&)];
v=DeleteDuplicates[Map[Identity,Join[v,SimilarityTransform[v,{{3,8},{15,20}},Range[12]]],{2}],(Norm[#-#2]<.0001&)];
v=DeleteDuplicates[Map[Identity,Join[v,SimilarityTransform[v,{{3,8},{14,19}},Range[12]]],{2}],(Norm[#-#2]<.0001&)];
v=DeleteDuplicates[Map[Identity,Join[v,SimilarityTransform[v,{{15,19},{17,22}},{8,16,21,17,22,18,14,19,15,20,3,13}]],{2}],(Norm[#-#2]<.0001&)];
v=DeleteDuplicates[Map[Identity,Join[v,SimilarityTransform[v,{{8,3},{21,16}},Range[12]]],{2}],(Norm[#-#2]<.0001&)];
v=DeleteDuplicates[Map[Identity,Join[v,SimilarityTransform[v,{{40,36},{45,44}},Range[62]]],{2}],(Norm[#-#2]<.0001&)];
f={{1,2,8,3},{1,3,9,4},{1,4,10,5},{1,5,11,6},{1,6,12,7},{8,16,13,3},{16,21,17,13},{13,17,22,18},{13,15,20,3},{13,14,19,15},{23,24,20,15},{23,15,29,25},{23,25,30,26},{23,26,31,27},{23,27,32,28},{19,14,33,34},{33,14,39,35},{33,35,40,36},{33,36,41,37},{33,37,42,38},{52,17,50,51},{52,49,22,17},{51,43,44,52},{52,44,45,46},{52,46,47,48},{53,16,59,55},{53,55,60,56},{53,56,61,57},{53,57,62,58},{21,16,53,54},{95,97,45,44},{95,44,101,98},{95,98,102,99},{95,76,100,97},{76,95,96,81},{75,79,84,80},{75,76,81,77},{75,77,82,65},{75,65,70,78},{75,78,83,79},{85,77,91,87},{85,87,92,88},{85,88,93,89},{85,89,94,90},{85,86,82,77},{112,109,84,79},{112,79,110,111},{112,111,103,104},{112,104,105,106},{112,106,107,108},{113,114,83,78},{113,78,119,115},{113,115,120,116},{113,116,121,117},{113,117,122,118},{63,64,70,65},{63,65,71,66},{63,66,72,67},{63,67,73,68},{63,68,74,69}};
Graphics[{FaceForm[LightYellow,Red],EdgeForm[Black],Polygon[v,f],MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

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

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

rot=RotationMatrix[{v[[45]]-v[[44]],{0,1}}];

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

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

vexact=Map[ToAlgebraicRoot,v2,{2}];//Timing

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

PolyhedronData["DeltoidalHexecontahedron","SurfaceArea"]

Sort@f

FullSimplify@vexact