Augmented Sphenocorona

Author

Eric W. Weisstein
May 11, 2021

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

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

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

Graphic

PolyhedronData["AugmentedSphenocorona","StandardNames"]

PolyhedronData

Show[PolyhedronData["AugmentedSphenocorona"],Boxed->True,Method->{"ShrinkWrap"->True}]

Show[PolyhedronData["Sphenocorona"],Boxed->True,Method->{"ShrinkWrap"->True}]

PolyhedronData["AugmentedSphenocorona","VertexCoordinates"]

FullSimplify[%]//ToRadicals

PolyhedronData (V12.1)

Show[PolyhedronData["AugmentedSphenocorona"],Boxed->False,Method->{"ShrinkWrap"->True}]

PolyhedronData["AugmentedSphenocorona","VertexCoordinates"]

Net

PolyhedronData

PolyhedronData["AugmentedSphenocorona","Net"]

Netlib

Show[Graphics[Net[JohnsonSolid[87]]],AspectRatio->Automatic]

Construction

By augmenting a square pyramid onto one of the two equivalent square faces of a "Sphenocorona"

PolyhedronData/@{"Sphenocorona","AugmentedSphenocorona"}

PolyhedronData["Sphenocorona","VertexCoordinates"]

PolyhedronData[#,"V"]&/@{"Sphenocorona","AugmentedSphenocorona"}

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

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

(soln=Solve[SquaredEuclideanDistance[v[[#]],{x,y,z}]==1&/@{1,2,6}/.Abs[x_]:>x,{x,y,z}])//N

apex=soln[[2]][[All,2]]

FullSimplify[Take[apex,2]]

ByteCount[apex[[-1]]]

a=Simplify[apex[[-1]]]

ByteCount[a]

FullSimplify[a]//Timing

ToRadicals[Root[197037369-5651497536 ((#1)^2)+55632772864 ((#1)^4)-243092221952 ((#1)^6)+578722553856 ((#1)^8)-828332834816 ((#1)^10)+727828135936 ((#1)^12)-376229068800 ((#1)^14)+94371840000 ((#1)^16)&,3]]

apex={(1/60) (6+(Sqrt[6])+2 (Sqrt[213-57 (Sqrt[6])])+2 (Sqrt[3+108 (Sqrt[6])-6 (Sqrt[538+18 (Sqrt[6])])])),0,Root[197037369-5651497536 ((#1)^2)+55632772864 ((#1)^4)-243092221952 ((#1)^6)+578722553856 ((#1)^8)-828332834816 ((#1)^10)+727828135936 ((#1)^12)-376229068800 ((#1)^14)+94371840000 ((#1)^16)&,3]};

apex//N

PolyhedronData["Sphenocorona","FaceIndices"]

v=Append[PolyhedronData["Sphenocorona","VertexCoordinates"],apex];

v//FullSimplify

SmallestRotation[l_]:=Sort[NestList[RotateRight,l,Length[l]-1]][[1]]

faces=Sort[SmallestRotation/@Join[{{3,2,1,5},{3,9,2},{9,6,2},{9,3,4},{6,9,7},{3,5,4},{6,7,8},{4,7,9},{10,7,4},{10,8,7},{5,10,4},{1,8,10},{5,1,10}},Append[#,11]&/@Partition[{2,6,8,1},2,1,1]]]

PolyhedronData["AugmentedSphenocorona","V"]

PolyhedronData["AugmentedSphenocorona","F"]

Length[polygons]

e=Select[Subsets[Range[Length[v]],{2}],N[EuclideanDistance@@v[[#]],20]==1&]

Length[e]

PolyhedronData["AugmentedSphenocorona","E"]

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

p=Polyhedron[v,faces]

Graphics3D[p]

Properties

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

prootreduced=Polyhedron[FullSimplify[PolyhedronCoordinates[p]]//ToRadicals,p[[2]]]

AdjacentFaceIndices

AdjacentFaceIndices[p]

Centroid

PolyhedronData["AugmentedSphenocorona","Centroid"]

N[%]

N[xbar=RegionCentroid[p]]

ByteCount[xbar]

FullSimplify/@xbar

RootReduce[%]

N[%]

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

MyCircumsphere[p]

Convex

ConvexPolyhedronQ[p]

DihedralAngles

dih=PolyhedronData["AugmentedSphenocorona","DihedralAngles"]

dih-DihedralAngles[p]//N//Chop//Union

GeneralizedDiameter

PolyhedronData["AugmentedSphenocorona","GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//RootReduce

N[%]

InertiaTensor

vol=Root[1439671249-1275399855936 #1^2+3306865979520 #1^4-58793017190400 #1^6+364547659290624 #1^8+209269081571328 #1^10-191069246324736 #1^12-110336743047168 #1^14+45137758519296 #1^16&,8];

MomentOfInertia[p//N,{0,0,0}]/vol//Chop

PolyhedronInertiaTensor[p//N,vol,Identity,Identity]//Chop

i1=PolyhedronInertiaTensor[p,vol,Identity,Identity];//Timing

N[i1]

i2=PolyhedronInertiaTensor[p,vol];//Timing

i3=PolyhedronInertiaTensor[p,1,FullSimplify,FullSimplify];//Timing

ByteCount[i3]

i3

N[i3/vol]

FullSimplify[i3/vol]//Timing

N[%]

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]//Timing

MyInsphere[p]//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"]))//RootReduce)//Timing

N[i]

MeanCylindricalSquareRadius

((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,2000],16]

N[i-r,5000]

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])/(PolyhedronData[pname,"Volume"])))//Timing

N[i]

MeanSphericalSquareRadius

((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,2000],16]

N[i-r,5000]

Midsphere

PolyhedronData[pname,"Midsphere"]

Midsphere[p]

RegionFunction

reg=PolyhedronData["AugmentedSphenocorona","RegionFunction"]

bounds=RegionBounds[ImplicitRegion[Evaluate[N[reg[x,y,z]]],{x,y,z}]]

ranges=Flatten/@Transpose[{{x,y,z},.1{-1,1}+#&/@bounds}]

RegionPlot3D[Evaluate[N[reg[x,y,z]]],Evaluate[Sequence@@ranges],BoxRatios->Automatic,PlotPoints->40]

ineq2=FullSimplify[ineq];//Timing

ByteCount[ineq2]

ineq

SkeletonCoordinates

vc=PolyhedronData["AugmentedSphenocorona","V"]

g=Graph[Range[vc],UndirectedEdge@@@e]

r=RecognizeGraph[g]

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

ToCommonEdges[GraphData[r],g]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]//RootReduce//Timing

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

VertexSubsetHulls

PolyhedronData[pname,"VertexSubsetHulls"]

Platonic

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

Volume

PolyhedronData["AugmentedSphenocorona","Volume"]

(v1=Volume[p])//N

ByteCount[v1]

FullSimplify[v1]

RootReduce[%]

N[%]