Great Rhombicosidodecahedron

Author

Eric W. Weisstein
January 5, 2024

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

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

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

Figure

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

Polyhedron

PolyhedronData["GreatRhombicosidodecahedron","Orientations"]

Show[PolyhedronData["GreatRhombicosidodecahedron"],Boxed->False,ImageSize->Small]

Solid and Dual

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

UniformPolyhedron

uniform=UniformPolyhedron[stdname="GreatRhombicosidodecahedron"]

PolyhedronFaceTally[uniform]

indices=UniformPolyhedronIndex[stdname]

UniformPolyhedron/@{
stdname,
Lookup[indices,"Wenninger"],
Sequence@@(List@@@Normal[indices]/."Maeder"->"Uniform")
}

SameQ@@%

Graphics3D/@(polys=Polygon[uniform[[1]],#]&/@uniform[[2]])

Graphics3D[#,Boxed->False]&/@{uniform,polys}

Bulatov

BulatovUniformName[UniformPolyhedronIndex[stdname,"Kaleido"]]

BulatovUniformGraphics3D[UniformPolyhedronIndex[stdname,"Kaleido"],Boxed->False]

bulatov=BulatovUniformPolyhedron[UniformPolyhedronIndex[stdname,"Kaleido"]]

Graphics3D/@(polys=Polygon[bulatov[[1]],#]&/@bulatov[[2]])

PolyhedronFaceTally[bulatov]

Graphics3D[#,Boxed->False]&/@{bulatov,polys}

Maeder

MaederUniformName[UniformPolyhedronIndex[stdname,"Maeder"]]

wythoff=MaederWythoffSymbol[UniformPolyhedronIndex[stdname,"Maeder"]]

With[{n=UniformPolyhedronIndex[stdname,"Maeder"]},Import["https://www.mathconsult.ch/static/unipoly/"<>If[n<10,"0",""]<>ToString[n]<>".html","Images"]][[1]]

maeder=MaederUniformPolyhedron[UniformPolyhedronIndex[stdname,"Maeder"]]

Graphics3D/@(polys=Polygon[maeder[[1]],#]&/@maeder[[2]])

PolyhedronFaceTally[maeder]

Graphics3D[#,Boxed->False]&/@{maeder,polys}

Net

PolyhedronData["GreatRhombicosidodecahedron","Net"]

PolyhedronData["GreatRhombicosidodecahedron","Net","Colored"]

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

Properties

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p]/FullSimplify

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]//FullSimplify//Timing

MyCircumsphere[p]//FullSimplify//Timing

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//FullSimplify//Tally

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

{4,6}

Show[Graphics3D[{poly[[{17,3}]]}],Boxed->False]

FullSimplify[π-DihedralAngle@@poly[[{17,3}]]]

N[%]180/Pi

{4,10}

Show[Graphics3D[{poly[[{17,12}]]}],Boxed->False]

FullSimplify[π-DihedralAngle@@poly[[{17,12}]]]

N[%]180/Pi

{6,10}

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

FullSimplify[π-DihedralAngle@@p]

InputForm[%]

N[%]180/Pi

Dual

pname

dname=PolyhedronData[pname,"Dual","Name"]

PolyhedronData[pname,"Dual","Scale"]

midrs={PolyhedronData[pname,"Midradius"],PolyhedronData[dname,"Midradius"]}

Divide@@midrs//FullSimplify

GraphicsRow[With[{
s={Yellow,PolyhedronData[pname,"Midsphere"]},
style=Directive[Black,Italic,FontFamily->"Times",14]
},
{
Graphics3D[{s,Green,Opacity[.5],PolyhedronData[pname,"Polyhedron"]},Boxed->False,PlotLabel->TextCell[Style[PolyhedronData[pname,"Name"],style],PageWidth->200,TextAlignment->Center]],
Graphics3D[{s,Red,Opacity[.5],PolyhedronData[pname,"Dual","Polyhedron"]},Boxed->False,PlotLabel->Style[PolyhedronData[dname,"Name"],style]],
Graphics3D[{
{Green,Opacity[.5],PolyhedronData[pname,"Polyhedron"]},
{Red,Opacity[.5],PolyhedronData[pname,"Dual","Polyhedron"]},
s
},Boxed->False,PlotLabel->Style["compound with midsphere",style]],
Graphics3D[{
PolyhedronData[pname,"Polyhedron"],
PolyhedronData[pname,"Dual","Polyhedron"]
},Boxed->False,PlotLabel->Style["compound",style]]
}],Alignment->Top,ImageSize->800]

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

Faces

PolyhedronFaceList[poly]

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

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

MyInsphere[p]//Timing

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

((MomentOfInertia[p])/(Volume[p]))//RootReduce//Timing

PolyhedronInertiaTensor[p]//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

Integrate over polyhedron

((NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/vol)

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

N[i]

Divergence theorem

(rxy=MeanCylindricalRadius[p,"Simplification"->FullSimplify,Debug->True])//Timing

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

PolyhedronData[pname,"MeanSphericalRadius"]

Integrate over polyhedron

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

PolyhedronData[pname,"Midsphere"]

Midsphere[p]//FullSimplify//Timing

NotationRules

PolyhedronData[pname,"NotationRules"]

Orientations

PolyhedronData[pname,"Orientations"]

PolyhedronData[pname,"DefaultOrientation"]

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

Polygons

PolyhedronData[pname,"FaceCount"]

Graphics3D/@PolyhedronData[pname,"Polygons"]

Show[%]

Polyhedra

PolyhedronData[pname,"Polyhedra"]

Graphics3D[%]

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

Collect[#,{x,y,z},RootReduce]&/@PolyhedronInequalities[p,{x,y,z}]

FullSimplify[%]

SimplePolyhedron

PolyhedronData[pname,"Simple"]

SimplePolyhedronQ[p]

Skeleton

PolyhedronData[pname,"Skeleton"]

gn=PolyhedronData[pname,"Skeleton","Name"]

emb=GraphData[gn,"PolyhedralEmbeddings"]

GraphData[gn,"Graph",{"3D","All"}]

g=PolyhedronGraph[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

RootReduce[%]

SurfaceArea[p]//RootReduce//Timing

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

VertexSubsetHulls

subsethulls=PolyhedronData[pname,"VertexSubsetHulls"]

v=PolyhedronData[pname,"Vertices"];

Rule[#,Length[#2]]&@@@subsethulls

Rule[#,Graphics3D[Function[f,ConvexHullRegion[v[[f]]]]/@#2]]&@@@subsethulls

subsethulls2=Flatten[Function[{pn,l},Rule[pn,#]&/@l]@@@subsethulls]

Rule[#,Graphics3D[{{Opacity[.3],{Green,p}},Blue,ConvexHullRegion[v[[#2]]]}]]&@@@subsethulls2

Convex hull

Graphics3D[convexhullreg=ConvexHullRegion[v=PolyhedronData[pname,"Vertices"]]]

v=PolyhedronCoordinates[convexhullreg]

Flatten[(convexhullreg[[2]]/.i_Integer:>v[[i]])/.Thread[PolyhedronData[pname,"Vertices"]->Range[PolyhedronData[pname,"V"]]]]//Union

%===Range@Length@v

PolyhedronData[pname,"ConvexHull","Name"]

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

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

Perspective projections

Manipulate[PolyhedronProjectionGraph[p,{a,b,c}],{a,-1,1},{b,-1,1},{c,-1,1}]

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

{-.185,-.395,.765}/.765

g=PolyhedronProjectionGraph[p,{-(3/10) (-3+(Sqrt[5])),(1/10) (3+(Sqrt[5])),1,-ArcTan[(Sqrt[(2/3) (5-2 (Sqrt[5]))])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[41]]-v[[98]])//FullSimplify

g=PolyhedronProjectionGraph[p,{x,y,1}]

v=GraphEmbedding[g];

eqn=FullSimplify[v[[11]]-v[[32]],x>0&&y>0]

Solve[Thread[eqn==0],{x,y}]//FullSimplify

N[%]

{0,8,3}

g=PolyhedronProjectionGraph[p,{0,8,3},VertexLabels->"Name"]

v=GraphEmbedding[g];

v[[{52,45}]]

{0,1,7-3 (Sqrt[5])}

{0,.245,.07}/.245

PolyhedronProjectionGraph[p,{0,1,7-3 (Sqrt[5])},VertexLabels->"Name"]

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

v=GraphEmbedding[g];

FullSimplify[v[[100]]-v[[93]],z>0]

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

{0,3+2 (Sqrt[5]),1}

{0,.495,.06}/.495

PolyhedronProjectionGraph[p,{0,3+2 (Sqrt[5]),1},VertexLabels->"Name"]

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

v=GraphEmbedding[g];

eqn=FullSimplify[v[[9]]-v[[14]],z>0]

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

N[%]

{0,1,(1/2) (-1+(Sqrt[5]))}

{0,.5,.315}/.5

PolyhedronProjectionGraph[p,{0,1,(1/2) (-1+(Sqrt[5]))},VertexLabels->"Name"]

g=PolyhedronProjectionGraph[p,{0,1,z}]

v=GraphEmbedding[g];

FullSimplify[v[[11]]-v[[14]],z>0]

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

{1,1,1,-ArcCot[(Sqrt[3 (9+4 (Sqrt[5]))])]}

g=PolyhedronProjectionGraph[p,{1,1,1,-ArcCot[(Sqrt[3 (9+4 (Sqrt[5]))])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[69]]-v[[45]])//FullSimplify

{0,0,1}

PolyhedronProjectionGraph[p,{0,0,1}]

{1,1,0}

PolyhedronProjectionGraph[p,{1,1,0}]

Construction

GreatRhombicosidodecahedron:=MiscPolyhedra`UniformPolyhedron[28]

GreatRhombicosidodecahedronExact:=Zonohedron[{{1,GoldenRatio,GoldenRatio-1},{1,-GoldenRatio,GoldenRatio-1},{1,-GoldenRatio,1-GoldenRatio},{1,GoldenRatio,1-GoldenRatio},{GoldenRatio,1-GoldenRatio,1},{GoldenRatio,1-GoldenRatio,-1},{GoldenRatio,GoldenRatio-1,-1},{GoldenRatio,GoldenRatio-1,1},{GoldenRatio-1,1,GoldenRatio},{GoldenRatio-1,-1,-GoldenRatio},{GoldenRatio-1,1,-GoldenRatio},{GoldenRatio-1,-1,GoldenRatio},{2,0,0},{0,2,0},{0,0,2}}/2]/.Polygon[l_List]:>Polygon[-{1/2+2GoldenRatio,1/2,1/2}+#&/@l]