Diminished Rhombicosidodecahedron

Author

Eric W. Weisstein
September 7, 2023

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

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

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

Polyhedron

Polyhedron

PolyhedronData["DiminishedRhombicosidodecahedron","Orientations"]

PolyhedronData["DiminishedRhombicosidodecahedron"]

PolyhedronData["DiminishedRhombicosidodecahedron","VertexCoordinates"]

PolyhedronData (V12.1)

PolyhedronData["DiminishedRhombicosidodecahedron"]

PolyhedronData["DiminishedRhombicosidodecahedron","VertexCoordinates"]

Netlib

PolyhedronName[JohnsonSolid[76]]

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

Net

PolyhedrdonData

PolyhedronData["DiminishedRhombicosidodecahedron","Net"]

PolyhedronData["DiminishedRhombicosidodecahedron","Net","Colored"]

Nelib

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

Construction

PolyhedronData/@{{"SmallRhombicosidodecahedron","C5"},"DiminishedRhombicosidodecahedron"}

Construct from "C5" orientation of "SmallRhombicosidodecahedron" by removing bottom cupola

bot=PolyhedronData[{"SmallRhombicosidodecahedron","C5"},"VertexCoordinates"][[All,-1]]//Min

pent=Position[PolyhedronData[{"SmallRhombicosidodecahedron","C5"},"VertexCoordinates"][[All,-1]],bot]//Flatten

PolyhedronData[{"SmallRhombicosidodecahedron","C5"},"FaceIndices"]//Length

Position[PolyhedronData[{"SmallRhombicosidodecahedron","C5"},"FaceIndices"],_?(Intersection[#,pent]===pent&),1,Heads->False]

PolyhedronData[{"SmallRhombicosidodecahedron","C5"},"FaceIndices"]//Length

newf=Select[PolyhedronData[{"SmallRhombicosidodecahedron","C5"},"FaceIndices"],Intersection[#,pent]==={}&]

Length[%]

PolyhedronData["DiminishedRhombicosidodecahedron","FaceIndices"]//Length

PolyhedronData[{"SmallRhombicosidodecahedron","C5"},"V"]

v=Delete[PolyhedronData[{"SmallRhombicosidodecahedron","C5"},"VertexCoordinates"],List/@pent]

Length[v]

PolyhedronData["DiminishedRhombicosidodecahedron","V"]

faceindices=newf/.Thread[Delete[Range[60],List/@pent]->Range[55]]

Max[Flatten[%]]

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

faceindices2=Sort[SmallestRotation/@Append[faceindices,{40,44,48,50,46,42,12,4,2,10}]]

Graphics3D[{MapIndexed[Text[#2[[1]],#,Background->White]&,v],FaceForm[Green,Red],Polygon[v[[#]]]&/@faceindices2}]

p=Polyhedron[v,faceindices2]

SimplePolyhedronQ[p]

ConvexPolyhedronQ[p]

Properties

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

AdjacentFaceIndices

AdjacentFaceIndices[p]

Length[%]

Centroid

PolyhedronData["DiminishedRhombicosidodecahedron","Centroid"]

(xbar=PolyhedronCentroid[p,vol])//N//Timing

xbar//FullSimplify

N[%]

(xbar2=RegionCentroid[p])//N//Chop

ByteCount/@{xbar,xbar2}

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

sphere=MyCircumsphere[p]

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["DiminishedRhombicosidodecahedron","DihedralAngles"]

dih=DihedralAngles[p]

N[dih]

(dih2=SimplifyNumericallyDistinct[dih,Debug->True])//Timing

N[dih-dih2,20]//Chop

GeneralizedDiameter

PolyhedronData["DiminishedRhombicosidodecahedron","GeneralizedDiameter"]

N[%]

diam=GeneralizedDiameter[p]//FullSimplify

N[%]

InertiaTensor

PolyhedronData["DiminishedRhombicosidodecahedron","InertiaTensor"]

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

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

(i=PolyhedronInertiaTensor[p,vol])//N//Timing

ByteCount[i]

i

N[i]

Insphere

PolyhedronData[pname,"Insphere"]

FullSimplify[%]

Insphere[p]//FullSimplify

sphere=MyInsphere[p,"Simplification"->FullSimplify]

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

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]

MeanSquareCylindricalRadius

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

(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]

MeanSquareSphericalRadius

((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]

RegionFunction

reg=PolyhedronData["DiminishedRhombicosidodecahedron","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

SkeletonCoordinates

g=Graph[Range[Length[PolyhedronCoordinates[p]]],UndirectedEdge@@@PolyhedronData["DiminishedRhombicosidodecahedron","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