Rhombic Icosahedron

Author

Eric W. Weisstein
May 15, 2021

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

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

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

Solid

PolyhedronData["RhombicIcosahedron","Orientations"]

Show[PolyhedronData["RhombicIcosahedron"],Axes->True,AxesOrigin->{0,0,0}]

Net

PolyhedronData["RhombicIcosahedron","Net"]

PolyhedronData["RhombicIcosahedron","Net","Colored"]

Properties

<<MathWorld`PolyhedronOperations`

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

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

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Convex

ConvexPolyhedronQ[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//FullSimplify//Tally//Timing

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

Faces

FullSimplify[Norm/@Subtract@@@Transpose[Partition[Polyhedron[RhombicIcosahedron][[1,1]],2]]]

FullSimplify[Divide@@%]

FunctionExpand[GoldenRatio]

rhomb=RhombicTriacontahedronExact[[1]];

RootReduce//@rhomb

v=FullSimplify[ToRadicals/@%8][[1]]

s=FullSimplify[Sqrt[#.#]&[v[[1]]-v[[2]]]]

b=FullSimplify[Sqrt[#.#]&[v[[1]]-v[[3]]]]

a=FullSimplify[Sqrt[#.#]&[v[[2]]-v[[4]]]]

planerhomb={{a,0},{0,b},{-a,0},{0,-b}};
Show[Graphics[{{GrayLevel[.8],Polygon[planerhomb]},Line[Append[planerhomb,planerhomb[[1]]]]}],AspectRatio->Automatic]

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]

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

N[i]

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

N[i]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

(sphere=Midsphere[p])//Timing

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

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

Perspective projections

Manipulate[PolyhedronProjectionGraph[PolyhedronData["Cuboctahedron","Polyhedron"],{a,b,c}],{a,-1,1},{b,-1,1},{c,-1,1}]

XXX

PolyhedronProjectionGraph[PolyhedronData["DuererSolid","Polyhedron"],]

Construction as a zonohedron

Diagonals of the 5-antiprism

e=KSubsets[PolyhedronVertices[Polyhedron[Antiprism[5]]],2];
n=RootReduce/@Norm/@(Subtract@@@e);

Length[diags=Select[e,RootReduce@Norm[Subtract@@#]==Max[n]&]]

Show[Graphics3D[{
Line/@diags,
Red,PointSize[.05],Point[{0,0,0}]
}
],Boxed->False]

v=ToRadicals[FullSimplify[-Subtract@@@diags]]

Show[Graphics3D[Zonohedron[v]],Boxed->False]

Exact construction

<<MiscPolyhedra`

(*rotate 1/10 of a turn and flip z*)invertedPoly[l_List]:=Polygon[Append[{{Cos[Pi/5],Sin[Pi/5]},{-Sin[Pi/5],Cos[Pi/5]}}.Take[#,2],-Last[#]]&/@l]

(*shift down 1/2 edge length*)shiftedPoly[l_List]:=Polygon[Append[Take[#,2],Last[#]-Sqrt[5/2(5+Sqrt[5])]/8]&/@l]

RhombicIcosahedronExact:=Module[{ri=Polyhedron[RhombicTriacontahedron],cap},cap=ri[[{7,8,9,10,4,17,19,20,25,26}]]/.Polygon:>shiftedPoly;
{cap,cap/.Polygon:>invertedPoly}]

Show[Graphics3D[poly=Orient[RhombicIcosahedronExact]],Boxed->False]

<<Simplify`
Off[N::"meprec"];

poly2=Map[ToExact,Flatten[poly],{3}];
(v=PolyhedronVertices[poly2])//InputForm
First/@poly2/.Thread[v->Range[Length[v]]]

Net Construction

Weisstein (Feb 2019) exact version from Izador Hafner Demonstration

v=Union[Flatten[[[1,All,1]],1]];

Length[v]

sub=Subsets[Range[42],{2}];

i=Select[sub,EuclideanDistance@@v[[#]]==1&]

GraphicsComplex[v,Line[i]]//Graphics

exact=RootApproximant[v,2,Method->{"DegreeCost"->2}]

exact={{(1/25) (-108-4 (Sqrt[5])),(1/25) (31-32 (Sqrt[5]))},{(1/25) (-132+8 (Sqrt[5])),(1/25) (24-16 (Sqrt[5]))},{(1/25) (-108-2 (Sqrt[5])),(1/25) (31-21 (Sqrt[5]))},{(1/25) (-132+10 (Sqrt[5])),(1/25) (24-5 (Sqrt[5]))},{(1/25) (-88-4 (Sqrt[5])),(1/25) (16-32 (Sqrt[5]))},{(1/25) (-88-2 (Sqrt[5])),(1/25) (16-21 (Sqrt[5]))},{(1/25) (-88-2 (Sqrt[5])),(1/25) (-9-21 (Sqrt[5]))},{(1/25) (-108+8 (Sqrt[5])),(1/25) (31-16 (Sqrt[5]))},{(1/25) (-108+10 (Sqrt[5])),(1/25) (31-5 (Sqrt[5]))},{(1/125) (-440+12 (Sqrt[5])),(1/125) (80+16 (Sqrt[5]))},{(1/25) (-68-2 (Sqrt[5])),(1/25) (-24-21 (Sqrt[5]))},{(1/25) (-88+8 (Sqrt[5])),(1/25) (16-16 (Sqrt[5]))},{(1/25) (-88+8 (Sqrt[5])),(1/25) (-9-16 (Sqrt[5]))},{(1/25) (-88+10 (Sqrt[5])),(1/25) (16-5 (Sqrt[5]))},{(1/125) (-320+12 (Sqrt[5])),(1/125) (115+16 (Sqrt[5]))},{(1/25) (-68+8 (Sqrt[5])),(1/25) (-24-16 (Sqrt[5]))},{(1/25) (-88+18 (Sqrt[5])),(1/25) (16-21 (Sqrt[5]))},{(1/25) (-88+18 (Sqrt[5])),(1/25) (-9-21 (Sqrt[5]))},{(1/25) (-64+8 (Sqrt[5])),(1/25) (23-16 (Sqrt[5]))},{(1/25) (-64+10 (Sqrt[5])),(1/25) (23-5 (Sqrt[5]))},{(1/25) (-44+8 (Sqrt[5])),(1/25) (8-16 (Sqrt[5]))},{(1/25) (-44+10 (Sqrt[5])),(1/25) (8-5 (Sqrt[5]))},{(1/25) (-24+8 (Sqrt[5])),(1/25) (-7-16 (Sqrt[5]))},{-(2/(5 (Sqrt[5]))),-(21/(5 (Sqrt[5])))},{(1/25) (-24+10 (Sqrt[5])),(1/25) (-7-5 (Sqrt[5]))},{0,0},{0,1},{(1/25) (20-2 (Sqrt[5])),(1/25) (-15-21 (Sqrt[5]))},{(8/(5 (Sqrt[5]))),-(16/(5 (Sqrt[5])))},{(4/5),(8/5)},{(2/(Sqrt[5])),-(1/(Sqrt[5]))},{(2/(Sqrt[5])),(1/5) (5-(Sqrt[5]))},{(1/25) (20+8 (Sqrt[5])),(1/25) (-15-16 (Sqrt[5]))},{(1/5) (4+2 (Sqrt[5])),(1/5) (-3-(Sqrt[5]))},{(1/5) (4+2 (Sqrt[5])),(1/5) (8-(Sqrt[5]))},{(1/5) (4+2 (Sqrt[5])),(1/5) (-8-(Sqrt[5]))},{(4/(Sqrt[5])),0},{(4/(Sqrt[5])),1},{(1/5) (4+4 (Sqrt[5])),-(3/5)},{(1/5) (4+4 (Sqrt[5])),-(8/5)},{(6/(Sqrt[5])),-(1/(Sqrt[5]))},{(6/(Sqrt[5])),(1/5) (5-(Sqrt[5]))}};

Graphics[GraphicsComplex[exact,Line[i]],Axes->True]

FullSimplify[EuclideanDistance@@@(exact[[#]]&/@i)]//Union

g=System`Graph[Range[42],UndirectedEdge@@@i,VertexCoordinates->exact]

faces=System`FindCycle[g,{4},All][[All,All,1]]

Graphics[{FaceForm[LightYellow],EdgeForm[Black],GraphicsComplex[exact,Polygon[faces]]}]

Oriented2DQ[p_]:=Chop[N[Total[Det/@Partition[p,2,1,1]],20]]>0

orientations=Oriented2DQ/@(v[[#]]&/@faces)

newfaces=If[#,#2,Reverse[#2]]&@@@Transpose[{orientations,faces}]

Oriented2DQ/@(v[[#]]&/@newfaces)

Graphics[{FaceForm[LightYellow],EdgeForm[Black],GraphicsComplex[exact,Polygon[newfaces]]}]

EuclideanDistance@@@Flatten[Partition[#,2,1,1]&/@Flatten[Normal[GraphicsComplex[exact,Polygon[newfaces]]]][[All,1]],1]//FullSimplify//Union

Flatten[PolygonAngle/@Normal[GraphicsComplex[exact,Polygon[newfaces]]][[1]]]//FullSimplify//Union

Izador Hafner Demonstration

GraphicsRow[{,,,}]

Vertex subset hulls

p="RhombicIcosahedron";

Platonic

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

PolyhedronData

Graphics3D[{FaceForm[Blue,Red],Orient@FullSimplify[Polyhedron[RhombicIcosahedron]]}]

PolyhedronDataString[Orient@FullSimplify[Polyhedron[RhombicIcosahedron]],
"StandardName"->"RhombicIcosahedron",
"Information"->"RhombicIcosahedron",
"Name"->"rhombic icosahedron",
"Classes"->{"Convex","Zonohedron"},
Debug->True,
TimeConstraint->600
]