Pentagonal Antiprism

Author

Eric W. Weisstein
September 11, 2023

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

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

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

Polyhedron

PolyhedronData["PentagonalAntiprism","StandardName"]

PolyhedronData[stdname={"Antiprism",5},"Orientations"]

PolyhedronData[stdname]

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

Polyhedron

Graphics3D[{FaceForm[Green,Red],PolyhedronData[stdname,"Polyhedron"]}]

Region

PolyhedronData[stdname,"Region"]

Solid and Dual

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

Maeder

stdname

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}

Properties

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"Antiprism",5},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]//FullSimplify

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

Graphics3D[{{Opacity[.3],Green,sphere},Blue,p},Boxed->False]

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

Concave

PolyhedronData[pname,"Concave"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]

ConvexHull

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

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

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

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

PolyhedronEdgeLengths[convexhull]//RootReduce//Tally

((Max[Norm/@convexhull[[1]]])/(Max[Norm/@PolyhedronData[PolyhedronData[pname,"ConvexHull","Name"],"Polyhedron"][[1]]]))//FullSimplify//Quiet

v=PolyhedronCoordinates[convexhull]

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

Graphics3D[{FaceForm[Green,Red],convexhull,MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

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

Show[%]

Graphics3D[{p,MapIndexed[Text[#2[[1]],#,Background->White]&,p[[1]]]}]

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

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]

EdgeCount

PolyhedronData[pname,"EdgeCount"]

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

SimplifyNumericallyDistinct[PolyhedronData[pname,"Lines"]/.Line[l_]:>EuclideanDistance@@l,"Simplification"->RootReduce]//FullSimplify//Tally//Timing

(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

FaceCount

PolyhedronData[pname,"FaceCount"]

FaceCountRules

PolyhedronData[pname,"FaceCountRules"]

PolyhedronFaceTally[p]

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[%]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

(sphere=MyInsphere[p,"Simplification"->RootReduce])//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

Integrate over polyhedron

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

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

Boole

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

((NIntegrate[(Sqrt[x^2+y^2])Boole[reg],{z,-1/2,1/2},{x,-1,1},{y,-1,1}])/vol)

r=Csc[Pi/5]/2;

((NIntegrate[(Sqrt[x^2+y^2])Boole[reg],{z,-1/2,1/2},{x,-r,r},{y,-r,r}])/vol)

((NIntegrate[(Sqrt[x^2+y^2])Boole[reg],{z,-1/2,1/2},{x,-r,r},{y,-r,r},Method->"QuasiMonteCarlo"])/vol)

NMaxValue[{(Sqrt[x^2+y^2]),reg},{x,y,z}]

Csc[Pi/5]/2.

(i1=Assuming[-Csc[Pi/5]/2<x<Csc[Pi/5]/2&&-Csc[Pi/5]/2<y<Csc[Pi/5]/2,Integrate[Sqrt[(x^2)+(y^2)]Boole[reg],{z,-1/2,1/2}]])//Timing

ByteCount[i1]

(i1=Assuming[-1<x<1&&-1<y<1,Integrate[Sqrt[(x^2)+(y^2)]Boole[reg],{z,-1/2,1/2}]])//Timing

ByteCount[i1]

((NIntegrate[i1,{x,-r,r},{y,-r,r}])/vol)//Timing

(i2=Assuming[-1<y<1,Integrate[i1,{x,-1,1}]])//Timing

((NIntegrate[i2,{y,-r,r}])/vol)//Timing

(i3=((Integrate[i2,{y,-1,1}])/vol))//Timing

Divergence theorem

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

Divergence theorem "Triangulation" -> Center

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

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=MeanSquareCylindricalRadius[p]//FullSimplify)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

Integrate over polyhedron

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

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

Divergence theorem

MeanSphericalRadius[p]

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxy2=MeanSquareSphericalRadius[p]//FullSimplify//Expand)//Timing

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

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

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

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

Net

PolyhedronData[pname,"Net"]

NotationRules

PolyhedronData[pname,"NotationRules"]

Orientations

PolyhedronData[pname,"Orientations"]

PolyhedronData[pname,"DefaultOrientation"]

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

Polygons

PolyhedronData[pname,"FaceCount"]

PolyhedronFaceTally[p]

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[%]

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

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

SurfaceArea[p]//FullSimplify

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

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

FullSimplify[Subtract@@{(5/2) ((Sqrt[3])+(Sqrt[1+(2/(Sqrt[5]))])),(Sqrt[(5/2) (10+(Sqrt[5])+(Sqrt[75+30 (Sqrt[5])]))])}]

Uniform

PolyhedronData[pname,"Uniform"]

With[{rules=PolyhedronData[pname,"NotationRules"]},{
UniformPolyhedron[Lookup[rules,"WenningerIndex"]],
UniformPolyhedron[{"Coxeter",Lookup[rules,"CoxeterIndex"]}],
UniformPolyhedron[{"Kaleido",Lookup[rules,"KaleidoIndex"]}],
UniformPolyhedron[{"Uniform",Lookup[rules,"MaederIndex"]}],
UniformPolyhedron[{"Wenninger",Lookup[rules,"WenningerIndex"]}]
}]

SameQ@@%

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

subsethulls=PolyhedronData[pname,"VertexSubsetHulls"]

v=PolyhedronData[pname,"Vertices"];

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

Rule[#,Graphics3D[ConvexHullRegion[v[[#]]]&/@Lookup[subsethulls,#]]]&/@subsethulls[[All,1]]

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

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

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

Volume[p]

PolyhedronVolume[p]//FullSimplify

Volume[PolyhedronData[pname,"Region"]]

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]