Metagyrate Diminished Rhombicosidodecahedron

Author

Eric W. Weisstein
September 8, 2023

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

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

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

Graphic

PolyhedronData

PolyhedronData["MetagyrateDiminishedRhombicosidodecahedron"]

PolyhedronData["MetagyrateDiminishedRhombicosidodecahedron","VertexCoordinates"]

PolyhedronData (V12.1)

PolyhedronData["MetagyrateDiminishedRhombicosidodecahedron"]

PolyhedronData["MetagyrateDiminishedRhombicosidodecahedron","VertexCoordinates"]

Netlib

PolyhedronName[JohnsonSolid[78]]

Show[Graphics3D[Polyhedron[JohnsonSolid[78]]],Boxed->False]

Net

PolyhedronData

PolyhedronData["MetagyrateDiminishedRhombicosidodecahedron","Net"]

Netlib

Show[Graphics[Net[JohnsonSolid[78]]],AspectRatio->Automatic]

Skeleton graph

PolyhedronData["MetagyrateDiminishedRhombicosidodecahedron","Skeleton"]

Construction

Construct by rotating the top pentagon about the central axes

PolyhedronData/@{"DiminishedRhombicosidodecahedron","MetagyrateDiminishedRhombicosidodecahedron"}

SmallRhombicosidodecahedronFaceIndices=PolyhedronData["DiminishedRhombicosidodecahedron","FaceIndices"]

v=PolyhedronData["DiminishedRhombicosidodecahedron","VertexCoordinates"]

ClosedLine[l_]:={Thick,Line[Append[l,l[[1]]]]}

pentagonindices={43};

pentagons=f[[pentagonindices]]

Graphics3D[{PolyhedronData["DiminishedRhombicosidodecahedron","GraphicsComplex"],MapIndexed[Text[#2[[1]],#]&,Mean[v[[#]]]&/@SmallRhombicosidodecahedronFaceIndices],
ClosedLine[v[[SmallRhombicosidodecahedronFaceIndices[[#]]]]]&/@pentagonindices
}]

fnew=Select[PolyhedronData["DiminishedRhombicosidodecahedron","FaceIndices"],MatchQ[Length[Intersection[Flatten[pentagons],#]],0|5]&]

rotaxes=Mean[v[[SmallRhombicosidodecahedronFaceIndices[[#]]]]]&/@pentagonindices//FullSimplify

Transpose[{rotaxes,pentagonindices}]

rotpents=(Function[vv,RotationMatrix[π/5,#].vv]/@v[[SmallRhombicosidodecahedronFaceIndices[[#2]]]])&@@@Transpose[{rotaxes,pentagonindices}]//FullSimplify

vnew=ReplacePart[v,Rule@@@Flatten[Thread/@Transpose[{pentagons,rotpents}],1]]

RotationMatrix[π/2,{0,0,1}].#&/@{{-(1/2),-(1/2) (Sqrt[1+(2/(Sqrt[5]))]),(Sqrt[(9/4)+(9/(2 (Sqrt[5])))])},{(1/2) (1+(Sqrt[5])),0,-(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/4) (-1-(Sqrt[5])),(1/4) (Sqrt[2-(2/(Sqrt[5]))]),(Sqrt[(9/4)+(9/(2 (Sqrt[5])))])},{(1/4) (3+(Sqrt[5])),(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))]),-(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/4) (1+(Sqrt[5])),-(Sqrt[(61/40)+(131/(40 (Sqrt[5])))]),(1/10) (Sqrt[85+22 (Sqrt[5])])},{(1/4) (3+(Sqrt[5])),-(1/4) (Sqrt[26+(58/(Sqrt[5]))]),-(1/2) (Sqrt[1-(2/(Sqrt[5]))])},{-(1/2),(Sqrt[(9/4)+(9/(2 (Sqrt[5])))]),(Sqrt[(1/4)+(1/(2 (Sqrt[5])))])},{0,(Sqrt[(5/2)+(11/(2 (Sqrt[5])))]),-(1/2) (Sqrt[1-(2/(Sqrt[5]))])},{(1/4) (-1-(Sqrt[5])),-(1/20) (Sqrt[610+262 (Sqrt[5])]),(1/10) (Sqrt[85+22 (Sqrt[5])])},{(1/4) (3+(Sqrt[5])),-(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))]),-(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/4) (-3-(Sqrt[5])),(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))]),(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/2),(1/2) (Sqrt[5+2 (Sqrt[5])]),-(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/4) (-3-(Sqrt[5])),-(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))]),(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/2) (-1-(Sqrt[5])),0,(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/2),-(7/10) (Sqrt[5+2 (Sqrt[5])]),(1/10) (Sqrt[5+2 (Sqrt[5])])},{(1/2),-(3/2) (Sqrt[1+(2/(Sqrt[5]))]),-(1/2) (Sqrt[1+(2/(Sqrt[5]))])},{(1/4) (-3-(Sqrt[5])),(Sqrt[(13/8)+(29/(8 (Sqrt[5])))]),(1/2) (Sqrt[1-(2/(Sqrt[5]))])},{(1/4) (-1-(Sqrt[5])),(Sqrt[(17/8)+(31/(8 (Sqrt[5])))]),-(1/2) (Sqrt[1+(2/(Sqrt[5]))])},{(1/4) (1+(Sqrt[5])),(NumericalApproximation[Root, (RowDefault["0.263", FEExpressionsNumericalApproximationElider]), Root[1-20 ((#1)^2)+80 ((#1)^4)&,3], ]),(Sqrt[(9/4)+(9/(2 (Sqrt[5])))])},{(1/2) (2+(Sqrt[5])),(Sqrt[(1/4)+(1/(2 (Sqrt[5])))]),-(1/2) (Sqrt[1-(2/(Sqrt[5]))])},{0,-(1/10) (Sqrt[130+38 (Sqrt[5])]),(1/10) (Sqrt[145+62 (Sqrt[5])])},{(1/4) (5+(Sqrt[5])),(NumericalApproximation[Root, (RowDefault["-1.11", FEExpressionsNumericalApproximationElider]), Root[1-100 ((#1)^2)+80 ((#1)^4)&,1], ]),-(1/2) (Sqrt[1+(2/(Sqrt[5]))])},{-(1/2),(1/2) (Sqrt[5+2 (Sqrt[5])]),(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/4) (1+(Sqrt[5])),(Sqrt[(17/8)+(31/(8 (Sqrt[5])))]),-(1/2) (Sqrt[1+(2/(Sqrt[5]))])},{(1/4) (3+(Sqrt[5])),-(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))]),(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/2) (2+(Sqrt[5])),-(1/2) (Sqrt[1+(2/(Sqrt[5]))]),(1/2) (Sqrt[1-(2/(Sqrt[5]))])},{(1/2),(1/2) (Sqrt[5+2 (Sqrt[5])]),(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/4) (3+(Sqrt[5])),(Sqrt[(13/8)+(29/(8 (Sqrt[5])))]),(1/2) (Sqrt[1-(2/(Sqrt[5]))])},{(1/2) (1+(Sqrt[5])),0,(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/2) (2+(Sqrt[5])),(1/2) (Sqrt[1-(2/(Sqrt[5]))]),(Sqrt[(1/4)+(1/(2 (Sqrt[5])))])},{(1/4) (3+(Sqrt[5])),(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))]),(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/4) (5+(Sqrt[5])),(Sqrt[(5/8)+(11/(8 (Sqrt[5])))]),(Sqrt[(1/4)+(1/(2 (Sqrt[5])))])},{(1/2) (1+(Sqrt[5])),-(Sqrt[1+(2/(Sqrt[5]))]),(Sqrt[(1/4)+(1/(2 (Sqrt[5])))])},{(1/2),-(1/2) (Sqrt[1+(2/(Sqrt[5]))]),(Sqrt[(9/4)+(9/(2 (Sqrt[5])))])},{(1/2) (2+(Sqrt[5])),-(1/2) (Sqrt[1-(2/(Sqrt[5]))]),-(1/2) (Sqrt[1+(2/(Sqrt[5]))])},{0,(Sqrt[(1/10) (5+(Sqrt[5]))]),(Sqrt[(9/4)+(9/(2 (Sqrt[5])))])},{(1/2) (1+(Sqrt[5])),(Sqrt[1+(2/(Sqrt[5]))]),-(1/2) (Sqrt[1+(2/(Sqrt[5]))])},{(1/2),(Sqrt[(9/4)+(9/(2 (Sqrt[5])))]),(Sqrt[(1/4)+(1/(2 (Sqrt[5])))])},{-(1/2),-(7/10) (Sqrt[5+2 (Sqrt[5])]),(1/10) (Sqrt[5+2 (Sqrt[5])])},{(1/2),-(1/2) (Sqrt[5+2 (Sqrt[5])]),-(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/4) (-5-(Sqrt[5])),(Sqrt[(5/8)+(11/(8 (Sqrt[5])))]),(Sqrt[(1/4)+(1/(2 (Sqrt[5])))])},{-(1/2),(1/2) (Sqrt[5+2 (Sqrt[5])]),-(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/(-3+(Sqrt[5]))),(NumericalApproximation[Root, (RowDefault["-1.80", FEExpressionsNumericalApproximationElider]), Root[1-260 ((#1)^2)+80 ((#1)^4)&,1], ]),-(1/2) (Sqrt[1-(2/(Sqrt[5]))])},{-(1/2),-(1/2) (Sqrt[5+2 (Sqrt[5])]),-(1/2) (Sqrt[5+2 (Sqrt[5])])},{-1-((Sqrt[5])/2),(Sqrt[(1/4)+(1/(2 (Sqrt[5])))]),-(1/2) (Sqrt[1-(2/(Sqrt[5]))])},{(1/4) (-3-(Sqrt[5])),(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))]),-(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/4) (-5-(Sqrt[5])),-(1/4) (Sqrt[10+(22/(Sqrt[5]))]),-(1/2) (Sqrt[1+(2/(Sqrt[5]))])},{(1/4) (-3-(Sqrt[5])),-(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))]),-(1/2) (Sqrt[5+2 (Sqrt[5])])},{-1-((Sqrt[5])/2),-(1/2) (Sqrt[1-(2/(Sqrt[5]))]),-(1/2) (Sqrt[1+(2/(Sqrt[5]))])},{(1/2) (-1-(Sqrt[5])),0,-(1/2) (Sqrt[5+2 (Sqrt[5])])},{-(1/2),-(3/2) (Sqrt[1+(2/(Sqrt[5]))]),-(1/2) (Sqrt[1+(2/(Sqrt[5]))])},{(1/2) (-1-(Sqrt[5])),-(Sqrt[1+(2/(Sqrt[5]))]),(Sqrt[(1/4)+(1/(2 (Sqrt[5])))])},{-1-((Sqrt[5])/2),(1/2) (Sqrt[1-(2/(Sqrt[5]))]),(Sqrt[(1/4)+(1/(2 (Sqrt[5])))])},{(1/2) (-1-(Sqrt[5])),(Sqrt[1+(2/(Sqrt[5]))]),-(1/2) (Sqrt[1+(2/(Sqrt[5]))])},{-1-((Sqrt[5])/2),-(1/2) (Sqrt[1+(2/(Sqrt[5]))]),(1/2) (Sqrt[1-(2/(Sqrt[5]))])}}//FullSimplify

Show[hull=ConvexHullRegion[vnew],Boxed->True]

SmallestRotation[l_]:=Sort[NestList[RotateRight,l,Length[l]-1]][[1]]

newf=Sort[SmallestRotation/@MeshCells[hull,2][[All,1]]]

p=Polyhedron[vnew,newf]

ConvexPolyhedronQ[p]

SimplePolyhedronQ[p]

Volume[p//N]

PolyhedronData["MetagyrateDiminishedRhombicosidodecahedron","Volume"]

Properties

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

AdjacentFaceIndices

AdjacentFaceIndices[p]

Centroid

Graphics3D[{AbsolutePointSize[10],
Point[{0,0,0}],{Blue,Point[PolyhedronData[pname,"Centroid"]]},Opacity[.2],PolyhedronData[pname,"GraphicsComplex"]}]

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify//Timing

PolyhedronCentroid[p]//FullSimplify//Timing

Convex

ConvexPolyhedronQ[p]

DehnInvariant

PolyhedronData[pname,"DehnInvariant"]

(dehn=DehnInvariant[p,Debug->True]//FullSimplify)//Timing

ToConwayBasis[dehn]

Complement[Select[PolyhedronData[All],PolyhedronData[#,"DehnInvariant"]==dehn&&PolyhedronData[#,"Volume"]==vol&],{pname}]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//FullSimplify//Tally

%==DihedralAngles[PolyhedronData["MetagyrateDiminishedRhombicosidodecahedron","Polyhedron"]//N]

(dih=SimplifyNumericallyDistinct[DihedralAngles[p],Debug->True,TimeConstraint->3600])//Timing

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

Faces

GeneralizedDiameter

PolyhedronData["MetagyrateDiminishedRhombicosidodecahedron","GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

MomentOfInertia[p//N,{0,0,0}]/vol//Chop//Timing

PolyhedronInertiaTensor[p//N,vol,Identity,Identity]//Chop//Timing

N[i1=MomentOfInertia[p]/vol]//Chop//Timing

N[i2=PolyhedronInertiaTensor[p,vol,Identity,Identity]]//Chop//Timing

N[i3=PolyhedronInertiaTensor[p,vol]]//Chop//Timing

ByteCount/@{i1,i2,i3}

i1

i3

N[%]

Insphere

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]

(sphere=MyInsphere[p])//Timing

MeanCylindricalRadius

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

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

N[i]

MeanSquareCylindricalRadius

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

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

N[i]

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

N[i-r,10^4]

MeanSphericalRadius

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

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

N[i]

MeanSquareSphericalRadius

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

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

N[i]

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

N[i-r,10^4]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

(sphere=Midsphere[p,"Simplification"->FullSimplify]//FullSimplify)//Timing

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

RegionFunction

reg=PolyhedronData["MetagyrateDiminishedRhombicosidodecahedron","RegionFunction"]

bounds=RegionBounds[ImplicitRegion[Evaluate[N[reg[x,y,z]]],{x,y,z}]]

ranges=Flatten/@Transpose[{{x,y,z},.1{-1,1}+#&/@bounds}]

RegionPlot3D[Evaluate[N[reg[x,y,z]]],Evaluate[Sequence@@ranges],BoxRatios->Automatic,PlotPoints->40]

ByteCount[ineq=PolyhedronInequalities[p,{#1,#2,#3}]]

ByteCount[ineq2=FullSimplify[ineq]]//Timing

ineq2

SimplePolyhedron

SimplePolyhedronQ[p]

SkeletonCoordinates

vc=PolyhedronData["MetagyrateDiminishedRhombicosidodecahedron","V"]

g=Graph[Range[vc],UndirectedEdge@@@PolyhedronData["MetagyrateDiminishedRhombicosidodecahedron","EdgeIndices"]]

r=RecognizeGraph[g]

GraphData[r,"Graph","All"]

ToCommonEdges[GraphData[r],g]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

RootReduce[%]

SurfaceArea[p]//RootReduce//Timing

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

VertexSubsetHulls

PolyhedronData[pname,"VertexSubsetHulls"]

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

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