Paragyrate Diminished Rhombicosidodecahedron

Author

Eric W. Weisstein
May 14, 2021

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

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

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

Graphic

PolyhedronData

PolyhedronData["ParagyrateDiminishedRhombicosidodecahedron","Orientations"]

PolyhedronData["ParagyrateDiminishedRhombicosidodecahedron"]

PolyhedronData["ParagyrateDiminishedRhombicosidodecahedron","VertexCoordinates"]

PolyhedronData (V12.1)

PolyhedronData["ParagyrateDiminishedRhombicosidodecahedron"]

PolyhedronData["ParagyrateDiminishedRhombicosidodecahedron","VertexCoordinates"]

Netlib

PolyhedronName[JohnsonSolid[77]]

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

Net

PolyhedronData

PolyhedronData["ParagyrateDiminishedRhombicosidodecahedron","Net"]

PolyhedronData["ParagyrateDiminishedRhombicosidodecahedron","Net","Colored"]

Netlib

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

Properties

<<MathWorld`PolyhedronOperations`

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

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//Quiet//Timing

PolyhedronCentroid[p]//FullSimplify//Quiet//Timing

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]//FullSimplify

(sphere=MyCircumsphere[p])//Timing

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

Convex

ConvexPolyhedronQ[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//FullSimplify//Tally

ByteCount[dih=SimplifyNumericallyDistinct[DihedralAngles[p],Debug->True]]//Timing

SortBy[dih,N]-Sort[dih0]//Chop//Union

dih

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

Faces

GeneralizedDiameter

PolyhedronData["ParagyrateDiminishedRhombicosidodecahedron","GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

InertiaTensor

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

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

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

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

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

ByteCount/@{i1,i2,i3}

i3

N[%]

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[p]

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])//Timing

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

RegionFunction

reg=PolyhedronData["ParagyrateDiminishedRhombicosidodecahedron","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["ParagyrateDiminishedRhombicosidodecahedron","V"]

g=Graph[Range[vc],UndirectedEdge@@@PolyhedronData["ParagyrateDiminishedRhombicosidodecahedron","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

Construction

Construct by rotating the top pentagon about the central axes

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

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

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

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

pentagonindices={41};

pentagons=f[[pentagonindices]]

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

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

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["ParagyrateDiminishedRhombicosidodecahedron","Volume"]