Gyrate Rhombicosidodecahedron

Author

Eric W. Weisstein
April 17, 2020

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

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

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

To do

RegionFunction

Graphic

PolyhedronData["J72","StandardNames"]

PolyhedronData

PolyhedronData["GyrateRhombicosidodecahedron","Orientations"]

PolyhedronData["GyrateRhombicosidodecahedron"]

PolyhedronData["GyrateRhombicosidodecahedron","VertexCoordinates"]

PolyhedronData (V12.1; inexact)

Show[PolyhedronData["GyrateRhombicosidodecahedron"],Method->{"ShrinkWrap"->True}]

PolyhedronData[{"Johnson",72},"VertexCoordinates"]

Net

PolyhedronData["GyrateRhombicosidodecahedron","Net"]

PolyhedronData["GyrateRhombicosidodecahedron","Net","Colored"]

Properties

p=PolyhedronData[pname="GyrateRhombicosidodecahedron","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

PolyhedronCentroid[p]//FullSimplify//Quiet

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]//FullSimplify

sphere=MyCircumsphere[p]//FullSimplify

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

Convex

ConvexPolyhedronQ[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//FullSimplify//Tally

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

Faces

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

((MomentOfInertia[p,{0,0,0}])/(Volume[p]))//RootReduce//Timing

PolyhedronInertiaTensor[p]//Timing

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

(sphere=MyInsphere[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]

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

sphere=PolyhedronData[pname,"Midsphere"]

sphere=Midsphere[p,"Simplification"->FullSimplify,Debug->True]

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

Oriented

Graphics3D[{FaceForm[Green,Red],p}]

RegionFunction

PolyhedronData["GyrateRhombicosidodecahedron","RegionFunction"]

bounds=RegionBounds[ImplicitRegion[N[PolyhedronData["GyrateRhombicosidodecahedron","RegionFunction"]][x,y,z],{x,y,z}]]

ranges=Flatten/@Transpose[{{x,y,z},bounds}]

RegionPlot3D[Evaluate[N[PolyhedronData["GyrateRhombicosidodecahedron","RegionFunction"]][x,y,z]],Evaluate[Sequence@@ranges],BoxRatios->Automatic,PlotPoints->40]

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

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

ineq2

SkeletonCoordinates

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

e=PolyhedronData["GyrateRhombicosidodecahedron","EdgeIndices"]

g=Graph[Range[vc],UndirectedEdge@@@e]

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

PolyhedronData[#,"Net"]&/@{"SmallRhombicosidodecahedron","GyrateRhombicosidodecahedron"}

PolyhedronData/@{"SmallRhombicosidodecahedron","GyrateRhombicosidodecahedron"}

PolyhedronData["SmallRhombicosidodecahedron","Orientations"]

Obtain GyrateRhombicosidodecahedron by rotating one of the cupolas.

Graphics3D[{
MapIndexed[Text[#2[[1]],#,Background->White]&,PolyhedronData["SmallRhombicosidodecahedron","VertexCoordinates"]],
PolyhedronData["SmallRhombicosidodecahedron","GraphicsComplex"]
}]

toppentagon={36,21,38,3,1};

topcupola={23,27,31,33,29,25,11,15,13,9};

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

Graphics3D[{
MapIndexed[Text[#2[[1]],#,Background->White]&,PolyhedronData["SmallRhombicosidodecahedron","VertexCoordinates"]],
PolyhedronData["SmallRhombicosidodecahedron","GraphicsComplex"],Thick,Line[v[[Append[topcupola,topcupola[[1]]]]]]}]

v2=ReplacePart[v,(#->(RotationMatrix[π/5,{0,0,1}].v[[#]]))&/@toppentagon]//FullSimplify

faceindices=PolyhedronData["SmallRhombicosidodecahedron","FaceIndices"];

oldf=Select[faceindices,!(Length[Intersection[#,topcupola]]==2&&Length[Intersection[#,toppentagon]]>0)&]

oldf={{37,28,24},{40,8,7},{35,5,6},{39,26,30},{10,14,2},{12,4,16},{54,45,41},{55,42,46},{58,19,20},{53,18,17},{56,43,47},{57,48,44},{34,32,22},{59,51,49},{60,50,52},{10,2,37,24},{37,22,32,28},{8,40,30,26},{25,29,40,7},{35,27,23,5},{6,24,28,35},{39,30,34,22},{12,26,39,4},{55,14,10,42},{41,9,13,54},{57,44,12,16},{15,11,43,56},{45,54,59,49},{50,60,55,46},{48,58,20,44},{43,19,58,47},{53,17,41,45},{46,42,18,53},{59,56,47,51},{52,48,57,60},{31,32,34,33},{17,18,6,5},{14,16,4,2},{7,8,20,19},{51,52,50,49},{3,1,36,21,38},{22,37,2,4,39},{29,33,34,30,40},{27,35,28,32,31},{42,10,24,6,18},{41,17,5,23,9},{20,8,26,12,44},{11,25,7,19,43},{56,59,54,13,15},{57,16,14,55,60},{58,48,52,51,47},{49,50,46,53,45}};

newf=Select[faceindices,Length[Intersection[#,topcupola]]==2&&Length[Intersection[#,toppentagon]]>0&]/.Thread[topcupola->RotateLeft[topcupola]]

newf={{36,27,31},{38,25,11},{23,1,9},{15,13,3},{29,21,33},{31,33,21,36},{27,36,1,23},{3,38,11,15},{21,29,25,38},{1,3,13,9}};

faceindices=Join[oldf,newf]

Graphics3D[p=Polyhedron[v2,faceindices]]

v2