Disdyakis Dodecahedron

Author

Eric W. Weisstein
January 5, 2024

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

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

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

Figure

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

Solid

PolyhedronData["DisdyakisDodecahedron","Orientations"]

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

Solid and Dual

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

Net

PolyhedronData["DisdyakisDodecahedron","Net"]

PolyhedronData["DisdyakisDodecahedron","Net","Colored"]

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

Faces

Properties

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

Centroid

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p]//FullSimplify

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

MyCircumsphere[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//FullSimplify//Tally

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

Edge 1

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

d1=FullSimplify[π-DihedralAngle@@p]

N[%]180/Pi

Edge 2

Show[Graphics3D[p=poly[[{4,12}]]],Boxed->False]

d2=FullSimplify[π-DihedralAngle@@p]

N[%]180/Pi

Edge 3

Show[Graphics3D[p=poly[[{18,12}]]],Boxed->False]

d3=FullSimplify[π-DihedralAngle@@p]

N[%]180/Pi

Summary

Equal@@{d1,d2,d3}

InputForm[d1]

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

Faces

Inequalities

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

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

PolyhedronFaceCounts[poly]

Insphere

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]//RootReduce//FullSimplify//Timing

MyInsphere[p]//RootReduce//Timing

Graphics3D[{{Opacity[.5],Yellow,p},Red,sphere}]

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

sphere=PolyhedronData[pname,"Midsphere"]

sphere=Midsphere[p];//Timing

Graphics3D[{Opacity[.5],Red,p,Yellow,sphere},Boxed->False]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

RootReduce[%]

SurfaceArea[p]//FullSimplify//Timing

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

VertexSubsetHulls

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

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

Perspective projections

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

{1,(1/7) (10+(Sqrt[2])),1,ArcTan[(2/(Sqrt[2+((Sqrt[2])/5)]))]}

{.165,.27,.165}/.165

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

v=GraphEmbedding[g];

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

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

v=GraphEmbedding[g];

FullSimplify[v[[9]]-v[[25]],z>0]

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

N[%]

{2, 1, 1}

{.875,.43,.43}/.875

PolyhedronProjectionGraph[PolyhedronData["DisdyakisDodecahedron","Polyhedron"],{2,1,1},VertexLabels->"Name"]

{1,(1/41) (17-(Sqrt[2])),0}

PolyhedronProjectionGraph[PolyhedronData["DisdyakisDodecahedron","Polyhedron"],{1,(1/41) (17-(Sqrt[2])),0},VertexLabels->"Name"]

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

v=GraphEmbedding[g];

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

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

N[%]

{(14/(26+3 (Sqrt[2]))),1,1}

PolyhedronProjectionGraph[PolyhedronData["DisdyakisDodecahedron","Polyhedron"],{(14/(26+3 (Sqrt[2]))),1,1},VertexLabels->"Name"]

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

v=GraphEmbedding[g];

FullSimplify[v[[2]]-v[[7]],x>0]

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

N[%]

{0, 1, 0}

PolyhedronProjectionGraph[PolyhedronData["DisdyakisDodecahedron","Polyhedron"],{0,1,0}]

{1, 0, 1}

PolyhedronProjectionGraph[PolyhedronData["DisdyakisDodecahedron","Polyhedron"],{1,0,1}]

{1, 1, 1}

PolyhedronProjectionGraph[PolyhedronData["DisdyakisDodecahedron","Polyhedron"],{1,1,1}]

Exact Construction

DisdyakisDodecahedronExact:=OrientCentered[Dual[Polyhedron[GreatRhombicuboctahedron],Method->Semiregular]]

Net construction

{a,b,c}=PolyhedronData["DisdyakisDodecahedron","EdgeLengths"]

N[%]

v=PolyhedronData["DisdyakisDodecahedron","VertexCoordinates"];

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

{α,β,γ}=SortBy[ArcCos[ToAlgebraicRoot/@Cos[PolygonAngle[Polygon[v[[{4,12,26}]]]]]]//Quiet,N]

N[%]

v={{0,0},{0,-b}};
v=Join[v,{c/b RotationMatrix[-α].v[[2]],RotationMatrix[-2α].v[[2]]}];
v=Join[v,Table[v[[3]]+RotationMatrix[β i].(v[[4]]-v[[3]]){c,1,c,1}[[i]],{i,4}]];
v=Join[v,Table[v[[5]]+RotationMatrix[-i α].(v[[6]]-v[[5]]){c/b,1,c/b,1,c/b,1}[[i]],{i,6}]];
v=Join[v,Table[v[[13]]+RotationMatrix[i β].(v[[14]]-v[[13]]){c,1}[[i]],{i,2}]];
v=Join[v,Table[v[[13]]+RotationMatrix[-i β].(v[[12]]-v[[13]]){c,1}[[i]],{i,2}]];
v=Join[v,Table[v[[11]]+RotationMatrix[i β].(v[[12]]-v[[11]]){c,1}[[i]],{i,2}]];
v=Join[v,Table[v[[11]]+RotationMatrix[-i β].(v[[10]]-v[[11]]){c,1}[[i]],{i,2}]];
v=Join[v,Table[v[[9]]+RotationMatrix[i β].(v[[10]]-v[[9]]){c,1}[[i]],{i,2}]];
v=Join[v,Table[v[[9]]+RotationMatrix[-i β].(v[[6]]-v[[9]]){c,1}[[i]],{i,2}]];
v=Join[v,{-#,#2}&@@@Drop[v,2]];
faces={{1,3,2},{1,4,3},{4,5,3},{3,5,6},{3,6,7},{3,7,8},{5,9,6},{5,10,9},{5,11,10},{5,12,11},{5,13,12},{5,14,13},{14,15,13},{13,15,16},{13,18,17},{13,17,12},{12,19,11},{11,19,20},{11,22,21},{11,21,10},{10,23,9},{9,23,24},{9,26,25},{6,9,25}};
faces=Join[faces,{{1,2,27},{28,1,27}},Reverse/@Drop[faces,2]+24];
Graphics[{FaceForm[LightYellow],EdgeForm[Black],poly=Polygon[v,faces],MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

PolyhedronData["DisdyakisDodecahedron","SurfaceArea"]

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

faces=Sort[faces]

v1=FullSimplify@Map[ToAlgebraicRoot,v,{2}]

Total[Area[Polygon[v1,#]]&/@faces]//ToAlgebraicRoot//FullSimplify

net=GraphicsComplex[v1,Polygon[faces]];

SortBy[SimplifyNumericallyDistinct[NetEdgeLengths[net]//Quiet,"Simplification"->FullSimplify]//Union,N]

%=={a,b,c}