Gyroelongated Pentagonal Birotunda

Author

Eric W. Weisstein
May 13, 2021

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

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

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

Graphic

PolyhedronData["J48","Name"]

PolyhedronData

PolyhedronData["GyroelongatedPentagonalBirotunda","Orientations"]

PolyhedronData["GyroelongatedPentagonalBirotunda"]

BoundaryMeshRegion

PolyhedronData[{"Johnson",48},"BoundaryMeshRegion"]

Region

PolyhedronData[{"Johnson",48},"Region"]

Net

PolyhedronData["GyroelongatedPentagonalBirotunda","Net"]

PolyhedronData["GyroelongatedPentagonalBirotunda","Net","Colored"]

Construction

PolyhedronData["PentagonalRotunda"]

PolyhedronData["GyroelongatedPentagonalBirotunda"]

rim=SelectFirst[PolyhedronData["PentagonalRotunda","Faces","Polygon"][[1,All,1]],Length[#]==10&]

Graphics3D[Polygon[rim]]

h=(Sqrt[1-(1/4)((Sec[(π/(2 10))])^2)])

Select[PolyhedronData["PentagonalRotunda","Faces","Polygon"][[1,All,1]],Length[#]<10&]

Graphics3D[top=Polygon/@Map[{#[[1]],#[[2]],#[[3]]+h/2}&,Select[PolyhedronData["PentagonalRotunda","Faces","Polygon"][[1,All,1]],Length[#]<10&],{2}]]

Graphics3D[bottom=Polygon/@Reverse/@Map[RotationMatrix[π/10,{0,0,1}].{#[[1]],#[[2]],-(#[[3]]+h/2)}&,Select[PolyhedronData["PentagonalRotunda","Faces","Polygon"][[1,All,1]],Length[#]<10&],{2}]]

Graphics3D[{FaceForm[Green,Red],top,bottom}]

Graphics3D[Polygon[toprim={#1,#2,h/2}&@@@rim//FullSimplify]]

Graphics3D[Polygon[botrim=Map[RotationMatrix[π/10,{0,0,1}].{#[[1]],#[[2]],-#[[3]]}&,toprim,{1}]//FullSimplify]]

Transpose[{toprim,botrim,RotateLeft[toprim]}]

Graphics3D[{FaceForm[Green,Red],poly=Flatten[{top,bottom,
Polygon/@Transpose[{RotateLeft[toprim],RotateLeft@botrim,toprim}],
Polygon/@Transpose[{toprim,RotateLeft@botrim,botrim}]
}]
}]

<<MathWorld`PolyhedronOperations`

PolyhedronEdgeLengths[poly]//FullSimplify//Quiet

poly0=FullSimplify[poly[[All,1]]];

poly0=FullSimplify[RootReduce[ToRadicals[poly[[All,1]]]]]

Polygon[poly0/.Through[Range[Length[v]]->v]]

Graphics3D[gc=With[{v=PolyhedronVertices[Polygon/@poly0]},GraphicsComplex[v,Polygon[poly0/.Thread[v->Range[Length[v]]]]]]]

PolyhedronEdgeLengths[gc]//FullSimplify

file=OpenWrite["~/gyro.m"]

With[{j=48},WriteString[file,PolyhedronDataString[gc,
"StandardName"->PolyhedronData[{"Johnson",j},"StandardName"],
"Name"->PolyhedronData[{"Johnson",j},"Name"],
"Classes"->PolyhedronData[{"Johnson",j},"Classes"],
"NotationRules"->PolyhedronData[{"Johnson",j},"NotationRules"]
]]]

Close[file]

Properties

<<MathWorld`PolyhedronOperations`

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

AdjacentFaceIndices

PolyhedronData["GyroelongatedPentagonalBirotunda","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]//RootReduce//Timing

PolyhedronCentroid[p]//RootReduce//Quiet//Timing

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Convex

ConvexPolyhedronQ[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//RootReduce//Tally

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

Faces

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

Inequalities

ineq=RootReduce[PolyhedronInequalities[Flatten[Normal[gc]],{x,y,z}]]

ByteCount[ineq]

ineq2=FullSimplify[ineq]

And@@ineq2

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

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

N[i]

(r=RootApproximant[N[i,1000],32])//Timing

N[r-i,10^4]

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"]))

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

N[i]

(r=RootApproximant[N[i,1000],32])//Timing

N[r-i,10^4]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

(sphere=Midsphere[p,"Simplification"->FullSimplify])//Timing

Oriented

Graphics3D[{FaceForm[Green,Red],PolyhedronData["GyroelongatedPentagonalBirotunda","GraphicsComplex"]}]

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

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