Sphenocorona

Author

Eric W. Weisstein
September 30, 2022

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

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

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

Solid

PolyhedronData["Sphenocorona","Orientations"]

PolyhedronData["Sphenocorona"]

Net

PolyhedronData["Sphenocorona","Net"]

PolyhedronData["Sphenocorona","Net","Colored"]

NetPrintout[PolyhedronData["Sphenocorona","Polyhedron"],"SmallTriakisOctahedron.pdf"]

Properties

<<MathWorld`Polyhedra`

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

Centroid

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p]//RootReduce

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

MyCircumsphere[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//RootReduce//Tally

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

Faces

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify

RootReduce[%]//FullSimplify

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

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

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

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

PolyhedronInertiaTensor[p]//Timing

MeanCylindricalRadius

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

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=MinMax/@Transpose[PolyhedronCoordinates[p]]

ineq=FullSimplify/@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"]

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

N[i]

MeanSphericalRadius

PolyhedronData[pname,"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]

MeanSquareSphericalRadius

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

N[i]

Midsphere

PolyhedronData[pname,"Midsphere"]

Midsphere[p]

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

Construction

Graphics3D[{Polyhedron[JohnsonSolid[86]]}]//Show

Graphics3D[{(Polyhedron[JohnsonSolid[86]]//Normal)[[{1,2,7,8,9,10}]]}]//Show

p[1]={0,-1/2,0};
p[2]={0,1/2,0};
p[3]={-x1,1/2,z1};
p[4]={-1/2,0,z2};
p[5]={-x1,-1/2,z1};
p[6]={x1,1/2,z1};
p[7]={1/2,0,z2};
p[8]={x1,-1/2,z1};
p[9]={0,y3,z3};
p[10]={0,-y3,z3};
n[x_,y_]:=(p[x]-p[y]).(p[x]-p[y])==1

Graphics3D[{PointSize[.02],MapIndexed[Text[#2[[1]],#1+{.1,0,0}]&,Array[p,10]],Point[Array[p,10]],
Line[Map[p,{{3,4},{4,5},{4,10},{4,9},{7,9},{7,10},{6,7},{7,8},{5,10},{8,10},{6,9},{3,9},{2,9},{1,10},{1,8},{2,6},{2,3},{1,5}},{2}]]
}/.{x1->1,z1->1,z2->1.2,y3->.6,z3->.8}/.Line[l_List]:>Line/@l/.Point[l_List]:>Point/@l]//Show

Select[{x1,z1,z2,y3,z3}/.NSolve[And@@(n@@@{{3,4},{4,5},{4,10},{4,9},{7,9},{7,10},{6,7},{7,8},{5,10},{8,10},{6,9},{3,9},{2,9},{1,10},{1,8},{2,6},{2,3},{1,5}}),{x1,z1,z2,y3,z3}],Total[Abs[Im[#]]]==0&]//Chop

solns=Select[(vars={x1,z1,z2,y3,z3})/.Solve[And@@(n@@@{{3,4},{4,5},{4,10},{4,9},{7,9},{7,10},{6,7},{7,8},{5,10},{8,10},{6,9},{3,9},{2,9},{1,10},{1,8},{2,6},{2,3},{1,5}}),{x1,z1,z2,y3,z3}],Total[Abs[Im[#]]]==0&&And@@Positive[#]&]

solns2=FullSimplify[solns]

PolyhedronData["Sphenocorona","V"]

p/@Range[10]/.Thread[vars->solns2[[1]]]//InputForm

ConvexHullMesh[{{0, -1/2, 0}, {0, 1/2, 0}, {(-6 - Sqrt[6] - 2*Sqrt[213 - 57*Sqrt[6]])/30, 1/2, 
  Sqrt[1/6 + 6*Sqrt[6] - Sqrt[538 + 18*Sqrt[6]]/3]/5}, {-1/2, 0, Sqrt[(1 + Sqrt[6])/2]}, 
 {(-6 - Sqrt[6] - 2*Sqrt[213 - 57*Sqrt[6]])/30, -1/2, Sqrt[1/6 + 6*Sqrt[6] - Sqrt[538 + 18*Sqrt[6]]/3]/5}, 
 {(6 + Sqrt[6] + 2*Sqrt[213 - 57*Sqrt[6]])/30, 1/2, Sqrt[1/6 + 6*Sqrt[6] - Sqrt[538 + 18*Sqrt[6]]/3]/5}, 
 {1/2, 0, Sqrt[(1 + Sqrt[6])/2]}, {(6 + Sqrt[6] + 2*Sqrt[213 - 57*Sqrt[6]])/30, -1/2, 
  Sqrt[1/6 + 6*Sqrt[6] - Sqrt[538 + 18*Sqrt[6]]/3]/5}, {0, (9 - Sqrt[6] + 2*Sqrt[213 - 57*Sqrt[6]])/30, 
  Sqrt[1/6 + 6*Sqrt[6] + Sqrt[538 + 18*Sqrt[6]]/3]/5}, {0, (-9 + Sqrt[6] - 2*Sqrt[213 - 57*Sqrt[6]])/30, 
  Sqrt[1/6 + 6*Sqrt[6] + Sqrt[538 + 18*Sqrt[6]]/3]/5}},Boxed->True]