Pentagonal Rotunda

Author

Eric W. Weisstein
September 9, 2023

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

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

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

Solid

PolyhedronData["PentagonalRotunda","Orientations"]

PolyhedronData["PentagonalRotunda"]

Net

PolyhedronData["PentagonalRotunda","Net"]

PolyhedronData["PentagonalRotunda","Net","Colored"]

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

Properties

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

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

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

Faces

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

Height

Show[Graphics3D[Polyhedron[Rotunda[5]][[{1,-1}]]],Boxed->False]

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

h=ToExact[Norm[Subtract@@Centroid/@Polyhedron[Rotunda[5]][[{1,-1}]]]]

N[%]

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

PolyhedronData[pname,"MeanCylindricalRadius"]

Integrate over polyhedron

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

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

N[rxy]

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/2

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

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

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

Simplify`SimplifyCount[rxysimp1]

rxysimp2=rxysimp1//RootReduce

N[rxysimp2,20]

Simplify`SimplifyCount[rxysimp2]

RootReduce[(NumericalApproximation[Root, (RowDefault["8.21", FEExpressionsNumericalApproximationElider, " × ", (Superscript["10", "-16"])]), Root[1-6646114628989760 #1+6613979812735372457543815978496 ((#1)^2)+788559700230276256629118190935144070758400 ((#1)^3)+16750685342357093314235493352508168438826867124928512 ((#1)^4)&,4], ]){(NumericalApproximation[Root, (RowDefault["1.07", FEExpressionsNumericalApproximationElider, " × ", (Superscript["10", "15"])]), Root[255595174291337483432548421516543097516279100417-2709012459185966929089785312412922131700 #1+5115985416972366195254639261754 ((#1)^2)-5844975973568620 ((#1)^3)+((#1)^4)&,3], ]),(NumericalApproximation[Root, (RowDefault["-1.31", FEExpressionsNumericalApproximationElider, " × ", (Superscript["10", "13"])]), Root[255595174291337483432548421516543097516279100417-33007873097000505817427063370728513140 #1+757533085854815780130039710 ((#1)^2)+71226163581340 ((#1)^3)+((#1)^4)&,2], ]), (NumericalApproximation[Root, (RowDefault["-1.07", FEExpressionsNumericalApproximationElider, " × ", (Superscript["10", "15"])]), Root[255595174291337483432548421516543097516279100417+2709012459185966929089785312412922131700 #1+5115985416972366195254639261754 ((#1)^2)+5844975973568620 ((#1)^3)+((#1)^4)&,2], ]),(NumericalApproximation[Root, (RowDefault["3.98", FEExpressionsNumericalApproximationElider, " × ", (Superscript["10", "14"])]), Root[1070348584894778337299762239483130343652527370183947519312427839898579816809864436537536832698597376-83406714023070564259418678881264473287004552303505443465414046458504730400284672 ((#1)^2)+498093858598607789071203692633552348620696137851243149960448 ((#1)^4)-3301425020394001515492842247872 ((#1)^6)+((#1)^8)&,7], ])}]

rxysimp3=FullSimplify[Log[(NumericalApproximation[Root, (RowDefault["3.61", FEExpressionsNumericalApproximationElider]), Root[1+12 #1-2 ((#1)^2)-4 ((#1)^3)+((#1)^4)&,4], ])] (1/16) (7+5 (Sqrt[2]))+ArcSinh[1+(Sqrt[2])](1/16) (-3+2 (Sqrt[2]))+ArcSinh[1](1/16) (-7-5 (Sqrt[2]))+(NumericalApproximation[Root, (RowDefault["0.327", FEExpressionsNumericalApproximationElider]), Root[1-64 ((#1)^2)+512 ((#1)^4)&,4], ])]

N[rxysimp3,20]

ResourceFunction["LogSimplify"][rxysimp3]

Simplify`SimplifyCount[rxysimp3]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

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

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

N[i]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

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

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

N[i]

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

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

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

N[i]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

(sphere=Midsphere[p]//FullSimplify)//Timing

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

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

Perspective projections

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

XXX

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