Rhombic Triacontahedron

Author

Eric W. Weisstein
November 16, 2024

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

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

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

Figure

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

Solid

Orientations

PolyhedronData["RhombicTriacontahedron","DefaultOrientation"]

PolyhedronData["RhombicTriacontahedron","Orientations"]

PolyhedronData[{"RhombicTriacontahedron",#}]&/@%

Solid and Dual

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

Polyhedron construction set

http://www.polydron.co.uk/polydron/polydron-40-rhombus.html

Net

Weisstein (?)

PolyhedronData["RhombicTriacontahedron","Net"]

PolyhedronData["RhombicTriacontahedron","Net","Colored"]

NetPrintout[PolyhedronData["RhombicTriacontahedron","Polyhdedron"],ToString[poly]<>".pdf"]

Izador Hafner Demonstration

GraphicsRow[{,,,}]

Properties: generic orientation

Initialization

pname="RhombicTriacontahedron";

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

CompoundInterior

intname=PolyhedronData[pname,"CompoundInterior"]

PolyhedronData[pname,"CompoundInterior","Scale"]

PolyhedronData[pname,"CompoundInterior","RotationMatrix"]

Concave

PolyhedronData[pname,"Concave"]

EdgeCount

PolyhedronData[pname,"EdgeCount"]

FaceCount

PolyhedronData[pname,"FaceCount"]

Net

PolyhedronData[pname,"Net"]

Total[Area/@Flatten[PolyhedronData[pname,"Net","Polygon"]]]//ToAlgebraicRoot//Timing

PolyhedronData[pname,"SurfaceArea"]

poly3d=PolyhedronData[pname,"Net","Polygons"]/.Polygon[v_]:>Polygon[Append[#,0]&/@v]

Total[Area/@Flatten[poly3d]]//RootReduce//FullSimplify

Graphics3D[{FaceForm[Green,Red],poly3d},Axes->True,AxesLabel->{"x","y","z"}]

NotationRules

PolyhedronData[pname,"NotationRules"]

Orientations

PolyhedronData[pname,"Orientations"]

PolyhedronData[pname,"DefaultOrientation"]

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

Skeleton

PolyhedronData[pname,"Skeleton"]

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

GraphData[gn]

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

g=PolyhedronGraph[p]

StableFaces

PolyhedronData[pname,"StableFaces","List"]

PolyhedronData[pname,"StableFaces","Count"]

Graphics3D[Transpose[{{Red,Opacity[.2]},PolyhedronData[pname,{"StableFaces","UnstableFaces"}]}],Boxed->False,BoxRatios->1]

Uniform

PolyhedronData[pname,"Uniform"]

UnstableFaces

PolyhedronData[pname,"UnstableFaces","List"]

PolyhedronData[pname,"UnstableFaces","Count"]

VertexCount

PolyhedronData[pname,"VertexCount"]

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Properties: {"RhombicTriacontahedron", "C2"}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"RhombicTriacontahedron","C2"},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

AdjacentFaceIndices

adj1=PolyhedronData[pname,"AdjacentFaceIndices"]

adj2=AdjacentFaceIndices[p]

adj1===adj2

Centroid

PolyhedronData[pname,"Centroid"]

Graphics3D[{AbsolutePointSize[10],
Point[{0,0,0}],{Blue,Point[PolyhedronData[pname,"Centroid"]]},Opacity[.2],PolyhedronData[pname,"GraphicsComplex"]}]

RegionCentroid[p]//RootReduce

PolyhedronCentroid[p]//RootReduce//Quiet

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

MyCircumsphere[N[p,50]]

%/.x_?InexactNumberQ:>FullSimplify@RootApproximant[x]

(sphere=MyCircumsphere[p])//Timing

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

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]//Timing

ConvexHull

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

PolyhedronData[pname,"ConvexHull","Scale"]

PolyhedronData[pname,"ConvexHull","RotationMatrix"]

Graphics3D[convexhull=PolyhedronData[pname,"ConvexHull","Polyhedron"]]

Counts[SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhull]]]

Keys[%]//N

{
Graphics3D[{Red,Opacity[.5],p}],
Graphics3D[{Blue,Opacity[.5],convexhull}]
}

Show[%,RenderingOptions->{"3DRenderingMethod"->"BSPTree"}]

Construct using ConvexHullRegion

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

v=PolyhedronCoordinates[convexhullreg]

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

Find scale

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhullreg]]//Tally//FullSimplify

((Max[Norm/@p[[1]]])/(Max[Norm/@PolyhedronData[convexhullname,"Polyhedron"][[1]]]))//FullSimplify//Quiet

Find rotation matrix

Graphics3D[{FaceForm[Green,Red],basesolid=PolyhedronData[convexhullname,"Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,basev=basesolid[[1]]]}]

rot=RotationMatrix[{Mean[basev[[{11,12}]]],{0,0,1}}]//FullSimplify

{Graphics3D[{Polyhedron[newv=rot.#&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ArcTan@@(Most@Mean[newv[[{7,29}]]])//FullSimplify

rot2=RotationMatrix[Pi/2+2Pi/5,{0,0,1}].rot//FullSimplify

{Graphics3D[{Polyhedron[(rot2.#)&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ConvexHullOf

hullof=DeleteCases[Select[PolyhedronData[All],PolyhedronData[#,"ConvexHullName"]===pname&],pname]

GraphicsGrid[Partition[Graphics3D[{
{Green,Opacity[.7],PolyhedronData[#,"Polyhedron"]},
{Blue,Opacity[.2],PolyhedronData[#,"ConvexHull","Polyhedron"]}},Boxed->False,PlotLabel->Style[PolyhedronData[#,"Name"],Directive[14,Black,Italic,FontFamily->"Times"]]]&/@hullof,UpTo[3]],Dividers->All,ImageSize->800]

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

(dih1=PolyhedronData[pname,"DihedralAngles"])//Tally

(dih2=SimplifyNumericallyDistinct[DihedralAngles[p]])//Tally

dih1===dih2

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

Tally[lens=SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p],"Simplification"->RootReduce]//FullSimplify]//Timing

PolyhedronData[pname,"EdgeLengths"]

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

(distinctlens=Mean/@Split[Sort[lens],Abs[#1-#2]<1.*^-10&])//N//Quiet

v=p[[1]];

colors=With[{n=Length[distinctlens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[distinctlens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[p],Boxed->False]//Quiet

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

Hull

hullname=PolyhedronData[pname,"Hull","Name"]

PolyhedronData[pname,"Hull","Scale"]

((Max[Norm/@p[[1]]])/(Max[Norm/@PolyhedronData[hullname,"Polyhedron"][[1]]]))//FullSimplify//Quiet

PolyhedronData[pname,"Hull"]

Max[Norm/@PolyhedronData[pname,"Hull","Polyhedron"][[1]]]

Max[Norm/@p[[1]]]

{Graphics3D[{Opacity[.5],Red,p}],Graphics3D[{Opacity[.5],Blue,PolyhedronData[pname,"Hull"][[1]]}]}

Show[%]

Find rotation matrix

Graphics3D[{FaceForm[Green,Red],basesolid=PolyhedronData[hullname,"Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,basev=basesolid[[1]]]}]

rot=RotationMatrix[{Mean[basev[[{11,12}]]],{0,0,1}}]//FullSimplify

{Graphics3D[{Polyhedron[newv=rot.#&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ArcTan@@(Most@Mean[newv[[{7,29}]]])//FullSimplify

rot2=RotationMatrix[Pi/2+2Pi/5,{0,0,1}].rot//FullSimplify

{Graphics3D[{Polyhedron[(rot2.#)&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

HullOf

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===pname&]

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===hullname&]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i=((MomentOfInertia[p,{0,0,0}])/vol)//RootReduce//FullSimplify)//Timing

PolyhedronInertiaTensor[p]//Timing

Insphere

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]//FullSimplify

MyInsphere[N[p,50]]

%/.x_?InexactNumberQ:>FullSimplify@RootApproximant[x]

sphere=MyInsphere[p]

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

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

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

ClosestMeanCylindricalRadius[%]

Integrate over polyhedron

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

N[rxy]

Divergence theorem

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

N[rxy]

LogSimplify[rxy]//FullSimplify

CAD

cad=CylindricalDecomposition[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z},"Function"]

((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxy=((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

CAD over  1/8

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&x>0&&y>0&&z>0]

Show[Graphics3D[{Opacity[.2],p}],RegionPlot3D[ImplicitRegion[reg,{x,y,z}],PlotPoints->50]]

((Volume[ImplicitRegion[reg,{x,y,z}]])/vol)//FullSimplify

cad=CylindricalDecomposition[reg,{x,y,z},"Function"]

8((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxy=8((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxy,20]

ByteCount[rxylog=LogSimplify[rxy,Debug->True]]//Timing

ByteCount[rxycollect=Collect[TrigToExp[rxylog],Log[_]]//RootReduce]//Timing

FullSimplify[rxycollect]//Timing

Boole Integrate doing z integral first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}==CoordinateBounds[p]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)]),{z,zmin,zmax}])//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}])//Timing

MeanInteriorLineSegmentLength

lbar=PolyhedronData[pname,"MeanInteriorLineSegmentLength"]

N[%]

GlobalAdaptive numerical integration

ineq=PolyhedronData[pname,"RegionFunction"]

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=RegionBounds[ImplicitRegion[ineq[x,y,z],{x,y,z}]]

(1/(vol^2)) NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax}]

(1/(vol^2)) NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax},
Method->{"GlobalAdaptive","MaxErrorIncreases"->1*^4}]//Timing

Integration

ineq=PolyhedronData[pname,"RegionFunction"]

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=RegionBounds[ImplicitRegion[ineq[x,y,z],{x,y,z}]]

cad=CylindricalDecomposition[ineq[x1,y1,z1]&&ineq[x2,y2,z2],{x1,y1,z1,x2,y2,z2},"Function"]

(1/(vol^2)) Integrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[cad],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax}]

Monte Carlo

reg=PolyhedronData[pname,"Region"]

Length[lines=Partition[RandomPoint[N@reg,10^7],2]]//Timing

Graphics3D[{{Opacity[.2],EdgeForm[],BoundaryDiscretizeRegion[reg]},Red,Line/@Take[lines,UpTo@1000]},AspectRatio->Automatic]

lengths=Norm/@Subtract@@@lines;//Timing

Histogram[lengths,{.01}]

Mean[lengths]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

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

ClosestMeanSphericalRadius[%]

Integrate over polyhedron

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

N[rxyz]

Divergence theorem

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

N[rxyz]

LogSimplify[rxyz]//FullSimplify

CAD

cad=CylindricalDecomposition[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z},"Function"]

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxyz=((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxyz,20]

rxysimp1=ResourceFunction["LogSimplify"][rxy]//FullSimplify

CAD over  1/XX

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&x>0&&y>0&&z>0]

Show[Graphics3D[{Opacity[.2],p}],RegionPlot3D[ImplicitRegion[reg,{x,y,z}],PlotPoints->50]]

((Volume[ImplicitRegion[reg,{x,y,z}]])/vol)//FullSimplify

cad=CylindricalDecomposition[reg,{x,y,z},"Function"]

XX((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxyz=XX((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

ByteCount[rxyzlog=LogSimplify[rxyz,"ZeroTestNumericalPrecision"->10000,WorkingPrecision->10000,Debug->True]]//Timing

ByteCount[rxyzcollect=Collect[TrigToExp[rxyzlog],Log[_]]//RootReduce]//Timing

Boole Integrate doing z integral first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=CoordinateBounds[p]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)+(z^2)]),{z,zmin,zmax}])//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}])//Timing

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

N[%]

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

Integrate over Polyhedron

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

N[rxy2]

Divergence theorem

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

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

N[%]

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

Integrate over polyhedron

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

N[rxy2]

Integrate over region

reg=PolyhedronData[pname,"RegionFunction"][x,y,z]

(rxy=((Integrate[((x^2)+(y^2)+(z^2))Boole[reg],{x,y,z}∈FullRegion[3]])/vol))

Divergence theorem

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

Boole Integrate doing z integral first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}==CoordinateBounds[p]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq]((x^2)+(y^2)+(z^2)),{z,zmin,zmax}])//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}])//Timing

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

Midsphere[N[p,50]]

%/.x_?InexactNumberQ:>FullSimplify@RootApproximant[x]

(sphere=Midsphere[p])//Timing

...crash... (out of memory?)

(sphere=Midsphere[p,Method->"PointLineDistance"])//Timing

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

Polygons

PolyhedronData[pname,"FaceCount"]

PolyhedronFaceTally[p]

Graphics3D/@PolyhedronData[pname,"Polygons"]

Show[%]

Polyhedra

polyhedra=PolyhedronData[pname,"Polyhedra"]

Length[polyhedra]

Graphics3D[polyhedra]

Graphics3D[Table[{Hue[(i/(Length[polyhedra]))],polyhedra[[i]]},{i,Length[polyhedra]}]]

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

{RegionPlot3D[ImplicitRegion[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]],
Graphics3D[p]}

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

ineq=FullSimplify[%]

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

ineq/.{x->#,y->#2,z->#3}

SimplePolyhedron

PolyhedronData[pname,"Simple"]

SimplePolyhedronQ[p]//Timing

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]//ToAlgebraicRoot//FullSimplify//Timing

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

SurfaceArea[PolyhedronData[pname,"Region"]]//ToAlgebraicRoot//FullSimplify//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]//FullSimplify

Volume[PolyhedronData[pname,"Region"]]//FullSimplify

Volume[ImplicitRegion[Evaluate@PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]]//FullSimplify//Timing

Properties: {"RhombicTriacontahedron", "C3"}

p=PolyhedronData[pname={"RhombicTriacontahedron","C3"},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

AdjacentFaceIndices

AdjacentFaceIndices[p]

Centroid

PolyhedronData[{"RhombicTriacontahedron","C3"},"Centroid"]

RegionCentroid[p]//FullSimplify//Timing

PolyhedronCentroid[p,PolyhedronData[{"RhombicTriacontahedron","C3"},"Volume"]]//FullSimplify//Timing

Circumsphere

PolyhedronData[{"RhombicTriacontahedron","C3"},"Circumsphere"]

Circumsphere[p]//Quiet

MyCircumsphere[p//N]

MyCircumsphere[p]//Timing

Convex

PolyhedronData[{"RhombicTriacontahedron","C3"},"Convex"]

ConvexPolyhedronQ[p]

DihedralAngles

SimplifyNumericallyDistinct[DihedralAngles[p]]//Union

EdgeLengths

PolyhedronData[{"RhombicTriacontahedron","C3"},"Lines"]/.Line[l_]:>EuclideanDistance@@l//SimplifyNumericallyDistinct//Union

GeneralizedDiameter

PolyhedronData[{"RhombicTriacontahedron","C3"},"GeneralizedDiameter"]

N[%]

GeneralizedDiameter[p]//FullSimplify//Quiet

N[%]

InertiaTensor

PolyhedronData[{"RhombicTriacontahedron","C3"},"InertiaTensor"]//TraditionalForm

bug((HyperlinkTemplate[394054, https://bugs.wolfram.com/show?number=394054None, https://bugs.wolfram.com/show?number=394054, HyperlinkActionRecycled, HyperlinkActive, , ])): Speed up MomentOfInertia[RhombicTriacontahedron]

(i1=TimeConstrained[MomentOfInertia[p]/PolyhedronData[{"RhombicTriacontahedron","C3"},"Volume"],60]//FullSimplify)//Timing

(i1=TimeConstrained[MomentOfInertia[p]/PolyhedronData[{"RhombicTriacontahedron","C3"},"Volume"],300]//FullSimplify)//Timing

(i2=PolyhedronInertiaTensor[p,PolyhedronData[{"RhombicTriacontahedron","C3"},"Volume"]]//FullSimplify)//Timing

(i2=PolyhedronInertiaTensor[p,1]//FullSimplify)//Timing

i2//N//Chop

(i2=PolyhedronInertiaTensor[p,Method->"GaussLaw"]//FullSimplify)//Timing

MomentOfInertia[p//N]//Chop

Insphere

PolyhedronData[{"RhombicTriacontahedron","C3"},"Insphere"]

Insphere[p]//FullSimplify//Timing

MyInsphere[p,Debug->True]//FullSimplify//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]

MeanCylindricalSquareRadius

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

(((Integrate[(x^2)+(y^2),{x,y,z}∈PolyhedronData[{pname,#},"Polyhedron"]])/(PolyhedronData[pname,"Volume"])))&/@PolyhedronData[pname,"Orientations"]//FullSimplify

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

N[i]

MeanSphericalSquareRadius

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

(((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈PolyhedronData[{pname,#},"Polyhedron"]])/(PolyhedronData[pname,"Volume"])))&/@PolyhedronData[pname,"Orientations"]//FullSimplify

N[i]

Midsphere

PolyhedronData[{"RhombicTriacontahedron","C3"},"Midsphere"]

N[%]

Midsphere[p//N]

Midsphere[p,Method->"PointLineDistance",Debug->True]//FullSimplify//Timing

Midsphere[p,Method->"PointsTangentAndPerpendicular"]//FullSimplify//Timing

Orientations

PolyhedronData["RhombicTriacontahedron","Orientations"]

PolyhedronData["RhombicTriacontahedron","DefaultOrientation"]

RegionFunction

reg=PolyhedronData[{"RhombicTriacontahedron","C3"},"RegionFunction"][x,y,z]

bounds=Flatten/@Transpose[{{x,y,z},PolyhedronData[{"RhombicTriacontahedron","C3"},"CoordinateBounds"]}]

ranges={#1,#2-.01,#3+.1}&@@@bounds

RegionPlot3D[Evaluate[reg],Evaluate[Sequence@@ranges],PlotPoints->40]

Simple

SimplePolyhedronQ[p]

Skeleton

g=PolyhedronData[{"RhombicTriacontahedron","C3"},"Skeleton"]

r=RecognizeGraph[g]

GraphData[r,"Graph","All"]

SurfaceArea

PolyhedronData[{"RhombicTriacontahedron","C3"},"SurfaceArea"]

N[%]

bug((HyperlinkTemplate[394050, https://bugs.wolfram.com/show?number=394050None, https://bugs.wolfram.com/show?number=394050, HyperlinkActionRecycled, HyperlinkActive, , ])): SurfaceArea[RhombicTriacontahedron] could return in simpler form

SurfaceArea[p]//Timing

SurfaceArea[p]//RootReduce//Timing

Ran overnight:

SurfaceArea[p]//FullSimplify//Timing

PolyhedronSurfaceArea[p]//RootReduce//Timing

VertexSubsetHulls

Platonic

(h=VertexSubsetHulls[p,"Platonic"])//Timing

g=Function[poly,Graphics3D[{
{Gray,Opacity[.2],EdgeForm[Thick],PolyhedronData[p,"Faces"]},ConvexHull3D[N[PolyhedronData[p,"VertexCoordinates"]][[#]]]&/@poly},Boxed->False]]/@h[[All,2]]

GraphicsGrid[{g},Spacings->-100]

Cube

VertexSubsetsHulls["RhombicTriacontahedron","Cube"]//Timing

i2={{3,9,29,31},{3,17,20,23},{4,7,27,32},{4,15,20,24},{5,12,24,29},{5,14,23,27},{7,10,17,21},{9,10,15,22},{12,22,25,32},{14,21,25,31}};

i1=Select[Sort/@Flatten/@Subsets[i2,{2}],Sort[Norm/@Subtract@@@Subsets[N[v[[i=#]]],{2}]]== ((s[[6]])/(Sqrt[2]))lengths&]

g1=Graphics3D[{
{Gray,Opacity[.2],PolyhedronData[p,"Faces"]},
h1=ConvexHull3D[v[[#]]]&/@i1
},Boxed->False]

Dodecahedron

VertexSubsetsHulls["RhombicTriacontahedron","Dodecahedron"]//Timing

Icosahedron

VertexSubsetsHulls["RhombicTriacontahedron","Icosahedron"]//Timing

Octahedron

VertexSubsetsHulls["RhombicTriacontahedron","Octahedron"]//Timing

Tetrahedron

VertexSubsetsHulls["RhombicTriacontahedron","Tetrahedron"]//Timing

i2={{3,9,29,31},{3,17,20,23},{4,7,27,32},{4,15,20,24},{5,12,24,29},{5,14,23,27},{7,10,17,21},{9,10,15,22},{12,22,25,32},{14,21,25,31}};

g2=Graphics3D[{
{Gray,Opacity[.2],PolyhedronData[p,"Faces"]},
h2=ConvexHull3D[v[[#]]]&/@i2
},Boxed->False]

All

Graphics3D[{h1,h2}]

GraphicsGrid[{{g1,g2}},Spacings->-100]

Volume

PolyhedronData[{"RhombicTriacontahedron","C3"},"Volume"]

N[%]

Volume[p]//RootReduce//Timing

Volume[p]//FullSimplify//Timing

PolyhedronVolume[p,Method->"Pyramids"]//RootReduce//FullSimplify//Timing

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

Properties: {"RhombicTriacontahedron", "C5"} == "RhombicTriacontahedron"

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

AdjacentFaceIndices

AdjacentFaceIndices[p]

Centroid

PolyhedronData[{"RhombicTriacontahedron","C5"},"Centroid"]

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p,PolyhedronData[{"RhombicTriacontahedron","C5"},"Volume"]]

Circumsphere

PolyhedronData[{"RhombicTriacontahedron","C5"},"Circumsphere"]

Circumsphere[p]//Quiet

MyCircumsphere[p]

Convex

PolyhedronData[{"RhombicTriacontahedron","C5"},"Convex"]

ConvexPolyhedronQ[p]

ConvexHullOf

hullof=DeleteCases[Select[PolyhedronData[All],PolyhedronData[#,"ConvexHullName"]===pname&],pname]

GraphicsGrid[Partition[Graphics3D[{
{Green,Opacity[.7],PolyhedronData[#,"Polyhedron"]},
{Blue,Opacity[.2],PolyhedronData[#,"ConvexHull","Polyhedron"]}},Boxed->False,PlotLabel->Style[PolyhedronData[#,"Name"],Directive[14,Black,Italic,FontFamily->"Times"]]]&/@hullof,UpTo[3]],Dividers->All,ImageSize->400]

Diagonals

faces=PolyhedronFaces[poly]/.Thread[Range[Length[PolyhedronVertices[poly]]]->PolyhedronVertices[poly]];
f=Transpose[Partition[#,2]]&/@faces;
l=Sort[Union[RootReduce/@Norm/@(Subtract@@@Flatten[f,1])],Less]

short=Select[Flatten[f,1],RootReduce@Norm[Subtract@@#]==First[l]&];
long=Select[Flatten[f,1],RootReduce@Norm[Subtract@@#]==Last[l]&];

Show[GraphicsArray[Partition[Graphics3D[#,Boxed->False,ViewPoint->{0,2,0},PlotRange->2{{-1,1},{-1,1},{-1,1}}]&/@{
Polyhedron[poly],
{Polyhedron[poly],{Thickness[.015],Red,Line/@short}},
{Thickness[.015],Red,Line/@short},
Polyhedron[poly],
{Polyhedron[poly],{Thickness[.015],Blue,Line/@long}},
{Thickness[.015],Blue,Line/@long}
},3]
],GraphicsSpacing->{-.1,-.2},ImageSize->400
]

g2=Show[Graphics3D[{{Blue,Line/@long},{Red,Line/@short}}],
Boxed->False]

DihedralAngles

SimplifyNumericallyDistinct[DihedralAngles[p]]//Union

Show[Graphics3D[Polyhedron[ArchimedeanDual[4]][[{19,25}]]],Boxed->False]

FullSimplify[DihedralAngle@@(Polyhedron[ArchimedeanDual[4]][[{19,25}]])]

Show[Graphics3D[Polyhedron[ArchimedeanDual[4]][[{19,25,26}]]],Boxed->False]

FullSimplify[DihedralAngle@@(Polyhedron[ArchimedeanDual[4]][[{19,26}]])]

EdgeLengths

PolyhedronData[{"RhombicTriacontahedron","C5"},"Lines"]/.Line[l_]:>EuclideanDistance@@l//FullSimplify//Union

Faces

Show[GraphicsArray[partition[PolyhedronFaces[poly//N],10]]]

PolyhedronFaceCounts[poly]

face=Flatten[Normal[PolyhedronData["RhombicTriacontahedron","Faces"]]][[1,1]]

Graphics3D[{Polygon[face],MapIndexed[Text[#2[[1]],#,Background->White]&,face]},Boxed->False]

α=ArcCos[Dot@@Subtract@@@{face[[{4,3}]],face[[{2,3}]]}]//FullSimplify

N[α 180/Pi]

β=ArcCos[Dot@@Subtract@@@{face[[{3,2}]],face[[{1,2}]]}]//FullSimplify

N[β 180/Pi]

ArcCos[(1/(Sqrt[5]))]180/Pi//N

{x,y}=FullSimplify[{Cos[α/2],Sin[α/2]}]//FunctionExpand//FullSimplify//ToRadicals

InputForm[%]

h=(1/4) (Sqrt[(5/2) (5+(Sqrt[5]))]);
x=(5+Sqrt[5])/8;
y=Sqrt[5]/4;

Sqrt[x^2+y^2]//Simplify

FullSimplify[x/y]

r=(( (Sqrt[-((((a^2)-(b^2)+(c^2)-(d^2)))^2)+4 (p^2) (q^2)]))/(2(a+b+c+d)))/.{a->h,b->h,c->h,d->h,p->2x,q->2y}

Graphics[{{LightYellow,EdgeForm[Black],Polygon[{{0,0},{x,y},{2x,0},{x,-y}}]},
Text["α",{.1,0}],Text["β",{.85,-.45}],
Text[1,{.4,.32}]
},BaseStyle->14]

ArcCos[{x,y}.{x,-y}]//FullSimplify

GeneralizedDiameter

PolyhedronData[{"RhombicTriacontahedron","C5"},"GeneralizedDiameter"]

N[%]

GeneralizedDiameter[p]//FullSimplify//Quiet

N[%]

InertiaTensor

PolyhedronData[{"RhombicTriacontahedron","C5"},"InertiaTensor"]//TraditionalForm

i1=MomentOfInertia[p]/Volume[p]//RootReduce//FullSimplify//Timing

(i2=PolyhedronInertiaTensor[p])//Timing

Insphere

PolyhedronData[{"RhombicTriacontahedron","C5"},"Insphere"]

Insphere[p]//FullSimplify

MyInsphere[p]//FullSimplify

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

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

Integrate over polyhedron

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

N[rxy]

Divergence theorem [unevaluated]

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

N[rxy]

LogSimplify[rxy]//FullSimplify

CAD

cad=CylindricalDecomposition[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z},"Function"]

((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxy=((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

CAD over  1/20

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&0<y<Tan[Pi/5]x&&z>0]

((Volume[ImplicitRegion[reg,{x,y,z}]])/vol)//ToAlgebraicRoot

cad=CylindricalDecomposition[reg,{x,y,z},"Function"]

20((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxy=20((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxy]

LogSimplify[rxy]//FullSimplify

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

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

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

N[rxy2]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

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

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

N[i]

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

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

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

N[rxyz2]

Midsphere

PolyhedronData[{"RhombicTriacontahedron","C5"},"Midsphere"]

N[%]

Midsphere[p//N]

Midsphere[p,Method->"PointLineDistance"]//FullSimplify//Timing

Midsphere[p,Method->"PointsTangentAndPerpendicular"]//FullSimplify//Timing

RegionFunction

reg=PolyhedronData[{"RhombicTriacontahedron","C5"},"RegionFunction"][x,y,z]

bounds=Flatten/@Transpose[{{x,y,z},PolyhedronData[{"RhombicTriacontahedron","C5"},"CoordinateBounds"]}]

ranges={#1,#2-.01,#3+.1}&@@@bounds

RegionPlot3D[Evaluate[reg],Evaluate[Sequence@@ranges],PlotPoints->40]

Simple

SimplePolyhedronQ[p]

Skeleton

g=PolyhedronData[{"RhombicTriacontahedron","C5"},"Skeleton"]

r=RecognizeGraph[g]

GraphData[r,"Graph","All"]

SurfaceArea

PolyhedronData[{"RhombicTriacontahedron","C5"},"SurfaceArea"]

N[%]

SurfaceArea[p]//RootReduce//Timing

SurfaceArea[p]//N

PolyhedronSurfaceArea[p]//RootReduce//Timing

VertexSubsetHulls

Platonic

(h=VertexSubsetHulls[p="RhombicTriacontahedron","Platonic","Icosahedra"->True])//Timing

g=Function[poly,Graphics3D[{
{Gray,Opacity[.2],EdgeForm[Thick],PolyhedronData[p,"Faces"]},ConvexHull3D[N[PolyhedronData[p,"VertexCoordinates"]][[#]]]&/@poly},Boxed->False]]/@h[[All,2]]

GraphicsGrid[{g},Spacings->-100]

Cube

VertexSubsetsHulls["RhombicTriacontahedron","Cube"]//Timing

i2={{3,9,29,31},{3,17,20,23},{4,7,27,32},{4,15,20,24},{5,12,24,29},{5,14,23,27},{7,10,17,21},{9,10,15,22},{12,22,25,32},{14,21,25,31}};

i1=Select[Sort/@Flatten/@Subsets[i2,{2}],Sort[Norm/@Subtract@@@Subsets[N[v[[i=#]]],{2}]]== ((s[[6]])/(Sqrt[2]))lengths&]

g1=Graphics3D[{
{Gray,Opacity[.2],PolyhedronData[p,"Faces"]},
h1=ConvexHull3D[v[[#]]]&/@i1
},Boxed->False]

Dodecahedron

VertexSubsetsHulls["RhombicTriacontahedron","Dodecahedron"]//Timing

Icosahedron

VertexSubsetsHulls["RhombicTriacontahedron","Icosahedron"]//Timing

Octahedron

VertexSubsetsHulls["RhombicTriacontahedron","Octahedron"]//Timing

Tetrahedron

VertexSubsetsHulls["RhombicTriacontahedron","Tetrahedron"]//Timing

i2={{3,9,29,31},{3,17,20,23},{4,7,27,32},{4,15,20,24},{5,12,24,29},{5,14,23,27},{7,10,17,21},{9,10,15,22},{12,22,25,32},{14,21,25,31}};

g2=Graphics3D[{
{Gray,Opacity[.2],PolyhedronData[p,"Faces"]},
h2=ConvexHull3D[v[[#]]]&/@i2
},Boxed->False]

All

Graphics3D[{h1,h2}]

GraphicsGrid[{{g1,g2}},Spacings->-100]

Volume

PolyhedronData[{"RhombicTriacontahedron","C5"},"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p,Method->"Pyramids"]//RootReduce//FullSimplify

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

Perspective projections

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

Face centroids

PolyhedronProjectionGraph[PolyhedronData["RhombicTriacontahedron","Polyhedron"],#,VertexLabels->"Name"]&/@N[PolyhedronData["RhombicTriacontahedron","Polygons"]/.Polygon[l_]:>Mean[l]]

Vertices

PolyhedronProjectionGraph[PolyhedronData["RhombicTriacontahedron","Polyhedron"],#,VertexLabels->"Name"]&/@N[PolyhedronData["RhombicTriacontahedron","VertexCoordinates"]]

{1,0,2}

g=PolyhedronProjectionGraph[PolyhedronData["RhombicTriacontahedron","Polyhedron"],{1,0,2},VertexLabels->"Name"]

g=PolyhedronProjectionGraph[PolyhedronData["RhombicTriacontahedron","Polyhedron"],{x,0,1},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[v[[10,1]]-v[[4,1]],x>0]

Solve[%==0,x]//FullSimplify

{1,(Sqrt[5-2 (Sqrt[5])]),(1/4) (3-(Sqrt[5])),-ArcTan[(Sqrt[5 (9-2 (Sqrt[5]))])]}

g=PolyhedronProjectionGraph[PolyhedronData["RhombicTriacontahedron","Polyhedron"],{1,(Sqrt[5-2 (Sqrt[5])]),(1/4) (3-(Sqrt[5])),-ArcTan[(Sqrt[5 (9-2 (Sqrt[5]))])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[6]]-v[[16]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["RhombicTriacontahedron","Polyhedron"],{1,x,y},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[v[[8]]-v[[27]],x>0&&y>0]

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

N[%]

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

g=PolyhedronProjectionGraph[PolyhedronData["RhombicTriacontahedron","Polyhedron"],{-1,(Sqrt[5-2 (Sqrt[5])]),-2+(Sqrt[5]),-ArcTan[(1/11) (Sqrt[3]) (-4+(Sqrt[5]))]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[1]]-v[[18]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["RhombicTriacontahedron","Polyhedron"],{-1,x,y},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[v[[7]]-v[[29]],x>0&&y>0]

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

N[%]

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

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

v=GraphEmbedding[g];

ArcTan@@(v[[4]]-v[[5]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["RhombicTriacontahedron","Polyhedron"],{1,y,-z},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[v[[11]]-v[[26]],y>0&&z>0]

Solve[Thread[Numerator[%]==0],{y,z}]//FullSimplify

N[%]

{1,(Sqrt[5-2 (Sqrt[5])]),(1/2) (-1+(Sqrt[5])),-ArcTan[(NumericalApproximation[Root, (RowDefault["-1.18", FEExpressionsNumericalApproximationElider]), Root[5-5 ((#1)^2)+((#1)^4)&,2], ])]}

g=PolyhedronProjectionGraph[PolyhedronData["RhombicTriacontahedron","Polyhedron"],{1,(Sqrt[5-2 (Sqrt[5])]),(1/2) (-1+(Sqrt[5])),-ArcTan[(NumericalApproximation[Root, (RowDefault["-1.18", FEExpressionsNumericalApproximationElider]), Root[5-5 ((#1)^2)+((#1)^4)&,2], ])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[17]]-v[[12]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["RhombicTriacontahedron","Polyhedron"],{1,y,z},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[v[[8]]-v[[28]],y>0&&z>0]

Solve[Thread[Numerator[%]==0],{y,z}]//FullSimplify

N[%]

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

g=PolyhedronProjectionGraph[PolyhedronData["RhombicTriacontahedron","Polyhedron"],{(3/4) (-1+(Sqrt[5])),(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))]),1,-ArcTan[(Sqrt[2]) (-2+(Sqrt[5]))]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[3]]-v[[15]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["RhombicTriacontahedron","Polyhedron"],{x,y,1},VertexLabels->"Name"]

v=GraphEmbedding[g];

FullSimplify[v[[10]]-v[[17]],x>0&&y>0]

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

N[%]

{1,0,1}

g=PolyhedronProjectionGraph[PolyhedronData["RhombicTriacontahedron","Polyhedron"],{1,0,1},VertexLabels->"Name"]

Arranged about a Rhombic Hexecontahedron

<<PolyhedronOperations`
<<Graphics`Shapes`
<<Platonic`

rt[x_]:=Polyhedron[RhombicTriacontahedron]/.Polygon[z_]:>Polygon[x+#&/@z]

<<Graphics`Colors`

Show[GraphicsArray[{
Graphics3D[
{Wireframe[Polyhedron[RhombicHexecontahedron]/.Polygon[x_]:>Polygon[x/GoldenRatio]],
rt[{1,1,-1}2.89#]&/@PolyhedronVertices[Icosahedron][[{1}]]
},Boxed->False,ViewPoint->{0,2,0},PlotRange->Table[{-4.5,4.5},{3}]],
Graphics3D[{Wireframe[Polyhedron[RhombicHexecontahedron]/.Polygon[x_]:>Polygon[x/GoldenRatio]],
rt[{1,1,-1}2.89#]&/@PolyhedronVertices[Icosahedron]
},Boxed->False,ViewPoint->{0,2,0},PlotRange->Table[{-4.5,4.5},{3}]]
}],
GraphicsSpacing->-.2]

Show[GraphicsArray[{
Graphics3D[{
Polyhedron[RhombicHexecontahedron]/.Polygon[x_]:>Polygon[x/GoldenRatio],
Wireframe[rt[{1,1,-1}2.89#]&/@Select[PolyhedronVertices[Icosahedron],Last[#]>0&]]
},Boxed->False,ViewPoint->{0,0,1000}
],
Graphics3D[{
Polyhedron[RhombicHexecontahedron]/.Polygon[x_]:>Polygon[x/GoldenRatio],
Wireframe[rt[{1,1,-1}2.89#]&/@PolyhedronVertices[Icosahedron]]
},Boxed->False,ViewPoint->{0,0,1000}
]
}]]

LiveGraphics3D

<<LiveGraphics3D`

WriteLiveAnimationForm["rhomtr12.m",Table[Show[Graphics3D[{
{SurfaceColor[Red],Polyhedron[RhombicHexecontahedron]/.Polygon[x_]:>Polygon[x/GoldenRatio]},
rt[{1,1,-1}2(1+1/Sqrt[5])#]&/@Take[PolyhedronVertices[Icosahedron],n]
}],Boxed->False,PlotRange->Table[{-4.5,4.5},{3}]],
{n,12}],AnimationDisplayTime->1
]

Construction

{"RhombicTriacontahedron", "C2"}

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

Graphics3D[{PolyhedronData["RhombicTriacontahedron","Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

f=PolyhedronData["RhombicTriacontahedron","Faces","Coordinates"][[1]]

(mat=FullSimplify@Map[ToAlgebraicRoot,RotationMatrix[{Mean[f],{0,0,1}}],{2}])//Timing

v2=mat.#&/@PolyhedronData["RhombicTriacontahedron","VertexCoordinates"]

Graphics3D[{p2=Polyhedron[v2,PolyhedronData["RhombicTriacontahedron","Faces","List"]],MapIndexed[Text[#2[[1]],#,Background->White]&,v2]}]

q=ArcTan@@Most[v2[[{12,16,15,11}]][[2]]]//FullSimplify

v3=FullSimplify[RotationMatrix[ArcTan[(1/2) (1+(Sqrt[5]))],{0,0,1}].#&/@v2]

Graphics3D[{p3=Polyhedron[v3,PolyhedronData["RhombicTriacontahedron","Faces","List"]],MapIndexed[Text[#2[[1]],#,Background->White]&,v2]}]

{"RhombicTriacontahedron", "C3"}

With[{poly="RhombicTriacontahedron"},Graphics3D[{MapIndexed[Text[#2[[1]],#,Background->White]&,PolyhedronData[poly,"Vertices"]],PolyhedronData[poly,"Polyhedron"]}]]

v=PolyhedronData["RhombicTriacontahedron","Vertices"];

m=RotationMatrix[{v[[3]],{0,0,1}}]//FullSimplify

v2=RootReduce[m.#&/@v]

Graphics3D[{MapIndexed[Text[#2[[1]],#,Background->White]&,v2],p2=Polyhedron[v2,PolyhedronData["RhombicTriacontahedron","FaceIndices"]]}]

ArcTan@@(Most[Subtract@@v2[[{3,11}]]]//FullSimplify)//FullSimplify

v3=((RotationMatrix[4π/15+π/2-π/30,{0,0,1}].#&/@v2/.{c_Cos:>RootReduce[c],s_Sin:>RootReduce[s]})//RootReduce//ToRadicals//FullSimplify)/.r_Root:>ToRadicals[r]

Graphics3D[{MapIndexed[Text[#2[[1]],#,Background->White]&,v3],p3=Polyhedron[v3,PolyhedronData["RhombicTriacontahedron","FaceIndices"]]},AxesLabel->{"x","y","z"},Axes->True]

ArcTan@@(Subtract@@(Most/@p3[[1]][[{11,3}]]))//FullSimplify

PolyhedronInequalities[PolyhedronData[{"RhombicTriacontahedron","C3"},"Polyhedron"],{#1,#2,#3}]//FullSimplify

{"RhombicTriacontahedron", "C5"}

OrientCentered[Dual[Icosidodecahedron,Method->Semiregular]]

Net Construction

<<ExtraPackages`UnfoldPolytope`

UnfoldPolytope[Flatten[Normal[PolyhedronData["RhombicTriacontahedron","Faces"]]]]

PolyhedronData["RhombicTriacontahedron","NetImage"]

α=ArcCos[1/Sqrt[5]];
β=ArcCos[-1/Sqrt[5]];

x

piece={Polygon[p],Polygon[{{0,0},{x,-y},{(1/5) (Sqrt[2 (5+(Sqrt[5]))]),-(2/5) (Sqrt[2 (5+(Sqrt[5]))])},{-(1/10) (Sqrt[50-22 (Sqrt[5])]),Root[1-125 ((#1)^2)+125 ((#1)^4)&,1]}}],
Polygon[{1,-1}#&/@{{0,0},{x,-y},{(1/5) (Sqrt[2 (5+(Sqrt[5]))]),-(2/5) (Sqrt[2 (5+(Sqrt[5]))])},{-(1/10) (Sqrt[50-22 (Sqrt[5])]),Root[1-125 ((#1)^2)+125 ((#1)^4)&,1]}}]};

piece

p={{0,0},{x,y},{2x,0},{x,-y}};

{(Sqrt[(1/10) (5+(Sqrt[5]))]),(Sqrt[(1/10) (5-(Sqrt[5]))])}//N

Subtract@@@Subsets[Union[Flatten[piece[[All,1]],1]],{2}]//N

Subtract@@@Subsets[Union[Flatten[bigpiece[0][[All,1]],1]],{2}]//N

(Subtract@@@Subsets[Union[Flatten[bigpiece[0][[All,1]],1]],{2}])[[-1]]//FullSimplify

(Subtract@@@Subsets[Union[Flatten[piece[[All,1]],1]],{2}])[[-2]]

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

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

Polygon[x_]:>Polygon[#+{.94,-1.53}&/@x]

bigpiece=.

bigpiece=Flatten[{piece,piece/.Polygon[x_]:>Polygon[#+{(Sqrt[(2/5) (5+(Sqrt[5]))])-(1/5) (Sqrt[2 (5+(Sqrt[5]))]),-(2/5) (Sqrt[2 (5+(Sqrt[5]))])}&/@x]}]//FullSimplify

bigpiece[n_]:={Polygon[{{0,0},{(Sqrt[(1/10) (5+(Sqrt[5]))]),Root[1-5 ((#1)^2)+5 ((#1)^4)&,3]},{(Sqrt[2+(2/(Sqrt[5]))]),0},{(Sqrt[(1/10) (5+(Sqrt[5]))]),Root[1-5 ((#1)^2)+5 ((#1)^4)&,2]}}],Polygon[{{0,0},{(Sqrt[(1/10) (5+(Sqrt[5]))]),Root[1-5 ((#1)^2)+5 ((#1)^4)&,2]},{(1/5) (Sqrt[2 (5+(Sqrt[5]))]),-(2/5) (Sqrt[2 (5+(Sqrt[5]))])},{-(1/10) (Sqrt[50-22 (Sqrt[5])]),Root[1-125 ((#1)^2)+125 ((#1)^4)&,1]}}],Polygon[{{0,0},{(Sqrt[(1/10) (5+(Sqrt[5]))]),Root[1-5 ((#1)^2)+5 ((#1)^4)&,3]},{(1/5) (Sqrt[2 (5+(Sqrt[5]))]),(2/5) (Sqrt[2 (5+(Sqrt[5]))])},{-(1/10) (Sqrt[50-22 (Sqrt[5])]),(Sqrt[(1/2)+(11/(10 (Sqrt[5])))])}}],Polygon[{{(2/5) (Sqrt[10-2 (Sqrt[5])]),-(2/5) (Sqrt[2 (5+(Sqrt[5]))])},{(1/5) (Sqrt[(1/2) (185-11 (Sqrt[5]))]),(1/5) Root[5-25 ((#1)^2)+((#1)^4)&,1]},{(1/5) (Sqrt[2 (85+(Sqrt[5]))]),-(2/5) (Sqrt[2 (5+(Sqrt[5]))])},{(1/5) (Sqrt[(1/2) (185-11 (Sqrt[5]))]),-(1/5) (Sqrt[(1/2) (185+11 (Sqrt[5]))])}}],Polygon[{{(2/5) (Sqrt[10-2 (Sqrt[5])]),-(2/5) (Sqrt[2 (5+(Sqrt[5]))])},{(1/5) (Sqrt[(1/2) (185-11 (Sqrt[5]))]),-(1/5) (Sqrt[(1/2) (185+11 (Sqrt[5]))])},{(Sqrt[2+(2/(Sqrt[5]))]),-(4/5) (Sqrt[2 (5+(Sqrt[5]))])},{(Sqrt[(1/10) (5+(Sqrt[5]))]),Root[841-925 ((#1)^2)+125 ((#1)^4)&,1]}}],Polygon[{{(2/5) (Sqrt[10-2 (Sqrt[5])]),-(2/5) (Sqrt[2 (5+(Sqrt[5]))])},{(1/5) (Sqrt[(1/2) (185-11 (Sqrt[5]))]),(1/5) Root[5-25 ((#1)^2)+((#1)^4)&,1]},{(Sqrt[2+(2/(Sqrt[5]))]),0},{(Sqrt[(1/10) (5+(Sqrt[5]))]),Root[1-5 ((#1)^2)+5 ((#1)^4)&,2]}}]}/.Polygon[v_]:>Polygon[{(4/5) (Sqrt[10-2 (Sqrt[5])])n,0}+#&/@v]

Graphics[{LightYellow,EdgeForm[Black],g=Flatten[bigpiece/@Range[0,4]]}]

gc=NetFromPolygon[FullSimplify[g]]

Graphics[{{LightYellow,EdgeForm[Black],gc},MapIndexed[Text[#2[[1]],#,Background->White]&,SortBy[gc[[1]],N]]}]

MapIndexed[Text[#2[[1]],#],Background->White]&,gc[[1]]]

PolyhedronData["RhombicTriacontahedron","NetCoordinates"]//N

PolyhedronData["RhombicTriacontahedron","NetImage"]