Pentagrammic Antiprism

Author

Eric W. Weisstein
September 21, 2023

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

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

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

Variants

variants=PolyhedronData["PentagrammicAntiprism*"]

GraphicsRow[Graphics3D[{PolyhedronData[#,"Polyhedron"]},Boxed->False]&/@variants,Dividers->All]

Polyhedron: "PentagrammicAntiprismHull"

PolyhedronData["PentagrammicAntiprismHull"]

Polyhedron

bug(431603): Graphics3D[Polyhedron[polygrammic antiprism] fails to render top and bottom faces

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

Solid and Dual

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

Polyhedron: "PentagrammicAntiprism"

PolyhedronData[stdname="PentagrammicAntiprism","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"}

UniformPolyhedron

uniform=UniformPolyhedron[stdname="PentagrammicAntiprism"]

Bulatov

BulatovUniformName[UniformPolyhedronIndex[stdname,"Kaleido"]]

Graphics3D[#,Boxed->False]&/@{bulatov,polys}

Maeder

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: "PentagrammicAntiprismHull"

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

AdjacenctFaceIndices

AdjacentFaceIndices[p]

Centroid

PolyhedronData[pname,"Centroid"]

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

RegionCentroid[p]//FullSimplify//Quiet//Timing

PolyhedronCentroid[p]//FullSimplify//Quiet//Timing

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

sphere=Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

SimplifyNumericallyDistinct[Norm/@PolyhedronCoordinates[p]]//Tally

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

Compound

PolyhedronData[pname,"Compound"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]

ConvexHull

PolyhedronData[pname,"ConvexHull"]

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

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],convexhull}]}

Show[%]

EuclideanDistance@@v[[{3,4}]]//FullSimplify

N[(1/2) (1+(Sqrt[5]))]

EuclideanDistance@@v[[{1,4}]]//FullSimplify

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhull]]//Tally

N[%]

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

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]

PolyhedronData[pname,"DihedralAngles"]//Tally

SimplifyNumericallyDistinct[DihedralAngles[p]]//Tally

EdgeCount

PolyhedronData[pname,"EdgeCount"]

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

lens=SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p]];//Quiet

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

v=PolyhedronCoordinates[p];

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

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

Hull

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

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

PolyhedronData[pname,"Hull"]

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

Show[%]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i=((MomentOfInertia[p,{0,0,0}])/(Volume[p])))//Timing

Map[ToAlgebraicRoot,i,{2}]

PolyhedronInertiaTensor[p]//Timing

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[N[p,50]]

sphere=MyInsphere[p,Debug->True,"Simplification"->FullSimplify]

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

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

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

Integrate over polyhedron

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

Divergence theorem

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

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)

((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)//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

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

N[%]

Integrate over Polyhedron

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

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

Divergence theorem

(rxy=MeanSquareCylindricalRadius[p,Debug->False]//FullSimplify)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

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

Integrate

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

Divergence theorem

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

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)

((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)//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

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

N[%]

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

Integrate

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

Divergence theorem

(rxy=MeanSquareSphericalRadius[p,Debug->False]//FullSimplify)//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"]

(sphere=Midsphere[N[p,20]])//Timing

(sphere=Midsphere[p])//Timing

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

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

Net

PolyhedronData[pname,"Net"]

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

PolyhedronData[pname,"SurfaceArea"]

Polygons

PolyhedronData[pname,"FaceCount"]

Graphics3D/@PolyhedronData[pname,"Polygons"]

Show[%]

Region

PolyhedronData[pname,"Region"]

RegionFunction

reg=PolyhedronData[pname,"RegionFunction"]

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

FullSimplify[%]

RegionPlot3D[reg[x,y,z],{x,-2,2},{y,-2,2},{z,-2,2}]

SimplePolyhedron

PolyhedronData[pname,"Simple"]

SimplePolyhedronQ[p]

Skeleton

PolyhedronData[pname,"Skeleton"]

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

With[{gn="ChamferedCubicalGraph",verts=PolyhedronData[pname,"Vertices"],faces=PolyhedronData[pname,"Faces","List"]},
ToCommonEdges[GraphData[gn],Graph[Range[Length[verts]],UndirectedEdge@@@Union[Sort/@Flatten[Partition[#,2,1,1]&/@faces,1]]]]]//Chop[#,1*^-5]&//N

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

RootReduce[%]

N[%%]

SurfaceArea[p]//FullSimplify//Timing

RootReduce[(1/8) (Sqrt[(5/2) (4865+2059 (Sqrt[5])+32 (Sqrt[8175+3630 (Sqrt[5])]))])]

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

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

PolyhedronData[pname,"VertexSubsetHulls"]

Construction

Graphics3D[p]

Graphics3D[hull=ConvexHullRegion[p[[1]]]]

5-prism, but not equilateral:

PolyhedronEdgeLengths[hull]//FullSimplify//Quiet//Tally

Sort[hull[[1]]/.MapIndexed[#->#2[[1]]&,p[[1]]]]

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p]//FullSimplify

Properties: "PentagrammicAntiprism"

Initialization

<<MathWorld`Polyhedra`

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

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

(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

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[{p,MapIndexed[Text[#2[[1]],#,Background->White]&,v1=convexhull[[1]]]}],
Graphics3D[{prism=PolyhedronData[{"Prism",5},"Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,v2=prism[[1]]]}]
}

((Norm[Most@v2[[1]]])/(Norm[Most@v1[[1]]]))//FullSimplify

((v2[[2,3]])/(v1[[1,3]]))//FullSimplify

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

Show[%]

DehnInvariant

PolyhedronData[pname,"DehnInvariant"]

(dehn=DehnInvariant[p,Debug->True])//Timing

ToConwayBasis[dehn]

DihedralAngles

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

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

dih1===dih2

EdgeCount

PolyhedronData[pname,"EdgeCount"]

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

Tally[lens=Tally[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"]

Graphics3D[hull=PolyhedronData[pname,"Hull","Polyhedron"]]

{
Graphics3D[{p,MapIndexed[Text[#2[[1]],#,Background->White]&,v1=p[[1]]]}],
Graphics3D[{hull=PolyhedronData[hullname,"Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,v2=hull[[1]]]}]
}

((Norm[Most@v1[[1]]])/(Norm[Most@v2[[1]]]))//FullSimplify

Mean/@{v1,v2}//RootReduce

((v1[[1,3]])/(v2[[1,3]]))//FullSimplify//Abs

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

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

Midsphere[N[p,200]]

RootApproximant[%[[2]]]

(sphere=Midsphere[p]//RootReduce)//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"]

Graphics3D/@PolyhedronData[pname,"Polygons"]

Show[%]

Polyhedra

PolyhedronData[pname,"Polyhedra"]

Graphics3D[%]

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

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]

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

SurfaceArea[PolyhedronData[pname,"Region"]]

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]

Volume[PolyhedronData[pname,"Region"]]

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Net construction

https://en.wikipedia.org/wiki/Pentagrammic_antiprism#Net

Import["https://upload.wikimedia.org/wikipedia/commons/6/67/Pentagrammic_antiprism_flat.png"]

pent=RotationMatrix[Pi/2+2Pi/5].#&/@Entity["Lamina","FilledPentagram"]["Vertices"][1][[1]]//FullSimplify;

v=Join[pent];
f=Range[Length[pent]];

Graphics[{EdgeForm[Black],FaceForm[LightYellow],Polygon[v,f],MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

Construction

"PentagrammicAntiprism"

Graphics3D[{p1=PolyhedronData[{"Antiprism", {5, 2}},"Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,v=p1[[1]]]},Boxed->False]

h=((v[[6,3]])/(EuclideanDistance@@v[[{6,9}]]))//RootReduce

c=CirclePoints[{(Sqrt[(1/10) (5-(Sqrt[5]))]),0},5]//FullSimplify

v=Join[Append[#,h]&/@c,Append[#,-h]&/@c]

Graphics3D[{prism=ConvexHullRegion[v],MapIndexed[Text[#2[[1]],#,Background->White]&,v]},Boxed->False]

Graphics3D[{FaceForm[Green,Red],p=Polyhedron[v,{{1,3,5,2,4},{6,9,7,10,8},{3,7,9},{9,5,3},{9,6,5},{2,5,6},{6,8,2},{8,4,2},{8,10,4},{10,1,4},{10,7,1},{7,3,1}}],MapIndexed[Text[#2[[1]],#,Background->White]&,v]},Boxed->False]

PolyhedronEdgeLengths[p]//RootReduce//Quiet//Union

Midsphere[p]//RootReduce

{"Prism",{5,2}}

v=PolyhedronData[{"Prism",{5,2}},"VertexCoordinates"];

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

RegionIntersection[Line[v[[{3,9}]]],Line[v[[{4,8}]]]]//FullSimplify

mid=Table[RotationMatrix[2Pi i/5,{0,0,1}].{0,(NumericalApproximation[Root, (RowDefault["-1.11", FEExpressionsNumericalApproximationElider]), Root[1-100 ((#1)^2)+80 ((#1)^4)&,1], ]),0},{i,0,4}]

v2=Join[v,mid]//FullSimplify

Graphics3D[{PolyhedronData[{"Prism",{5,2}},"Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,v2]}]

s=EuclideanDistance@@v2[[{8,10}]]//FullSimplify

v2[[{4,10}]]

FullSimplify[EuclideanDistance@@{{(1/4) (1+(Sqrt[5])),-(1/4) (Sqrt[10+(22/(Sqrt[5]))]),-z},{(1/4) (3+(Sqrt[5])),(1/4) (Sqrt[2+(2/(Sqrt[5]))]),z}},z>0]

Solve[((Sqrt[3+(Sqrt[5])+8 (z^2)])/(Sqrt[2]))==(1/2) (3+(Sqrt[5])),z]//FullSimplify

mid=Table[RotationMatrix[2Pi i/5,{0,0,1}].{0,(NumericalApproximation[Root, (RowDefault["-1.11", FEExpressionsNumericalApproximationElider]), Root[1-100 ((#1)^2)+80 ((#1)^4)&,1], ]),0},{i,0,4}]

v3=Join[{#,#2,(Sqrt[2+(Sqrt[5])])#3}&@@@v,mid]//FullSimplify

faces

{EuclideanDistance@@v3[[{4,10}]],EuclideanDistance@@v3[[{8,10}]]}//FullSimplify

faces=Sort@Join[PolyhedronData[{"Prism",{5,2}},"FaceIndices"][[-2;;]],
{{22,10,17},{17,9,22},{10,22,23},{23,18,10},{23,6,18},{24,6,23},{24,19,6},{24,7,19},{25,7,24},{25,20,7},{25,8,20},{21,8,25},{21,16,8},{23,22,5},{23,5,13},{13,1,23},{1,24,23},{14,24,1},{2,24,14},{25,24,2},{15,25,2},{15,3,25},{3,21,25},{21,9,16},{21,22,9},{11,21,3},{11,4,21},{4,22,21},{12,22,4},{12,5,22}}];
Graphics3D[{FaceForm[Green,Red],Polygon[v3,faces],MapIndexed[Text[#2[[1]],#,Background->White]&,v3]}]

Graphics3D[{FaceForm[Green,Red],p=Polyhedron[v3,faces],MapIndexed[Text[#2[[1]],#,Background->White]&,v3]}]

Then rotate result by -Pi/2

PolyhedronData[pname,"Vertices"]

RotationMatrix[-Pi/2,{0,0,1}].#&/@PolyhedronData[pname,"Vertices"]//FullSimplify

PolyhedronData

<<MathWorld`Polyhedra`

PolyhedronDataString

{"Prism", {5,2}}

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

WriteString[file,PolyhedronDataString[
p,
"StandardName"->"PentagrammicAntiprismHull",
"AlternateStandardNames"->{"PentagrammicAntiprism"},
"Name"->"(5,2)\[Hyphen]polygrammic antiprism",
"StandardNames"->{"pentagrammic antiprism"},
"Information"->"PentagrammicAntiprism",
Debug->True
]]

"PentagrammicAntiprism"

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

stdname="PentagrammicAntiprism";

wythoff=MaederWythoffSymbol[maederindex=UniformPolyhedronIndex[stdname,"Maeder"]]

WriteString[file,PolyhedronDataString[p,
"StandardName"->stdname,
"AlternateStandardNames"->{"U"<>ToString[maederindex],{"Uniform",maederindex}},
"Name"->StringTrim[StringReplace[stdname,RegularExpression["([A-Z])"]:>" "<>ToLowerCase["$1"]]],
"Information"->stdname,
"WythoffSymbol"->wythoff/.{
w0[p_,q_,r_]:>{{},{p,q,r}},
w1[p_,q_,r_]:>{{p},{q,r}},
w2[p_,q_,r_]:>{{p,q},{r}},
w3[p_,q_,r_]:>{{p,q,r}},
w4[p_,q_,r_,s_]:>{{},{p,q,r,s}}
},
"Classes"->{"Canonical","Equilateral","Uniform"},
"NotationRules"->{"KaleidoIndex"->4,"MaederIndex"->79}
]]

Close[file]