Snub Square Antiprism

Author

Eric W. Weisstein
May 15, 2021

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

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

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

Solid

PolyhedronData["SnubSquareAntiprism","StandardNames"]

PolyhedronData["SnubSquareAntiprism","Orientations"]

PolyhedronData["SnubSquareAntiprism"]

Net

PolyhedronData["SnubSquareAntiprism","Net"]

PolyhedronData["SnubSquareAntiprism","Net","Colored"]

Properties

<<MathWorld`PolyhedronOperations`

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

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

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Convex

ConvexPolyhedronQ[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//FullSimplify//Tally

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

Faces

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

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]

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

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

N[i]

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

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

N[i]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

(sphere=Midsphere[p])//Timing

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

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

Weisstein

June 22, 2018-ish

PolyhedronData[{"Johnson",85},"VertexCoordinates"]

v0=PolyhedronData[{"Johnson",85},"Vertices"]

SquaredEuclideanDistance@@@{v0[[{11,13}]],v0[[{13,12}]],v0[[{12,16}]],v0[[{13,16}]]}

Graphics3D[{{Opacity[.4],PolyhedronData[{"Johnson",85},"GraphicsComplex"]},MapIndexed[Text[#2[[1]],#,Background->White]&,v]},Boxed->False]

v3={-1/2,1/2,h};
v6={-1/2,-1/2,h};
v9={1/2,1/2,h};
v11={1/2,-1/2,h};
v12={0,-(1/(Sqrt[2])),-h};
v13={0,-y,h1};
v14={(1/(Sqrt[2])),0,-h};
v15={y,0,h1};
v16={(y/(Sqrt[2])),((-y)/(Sqrt[2])),-h1};

eqns=Thread[SquaredEuclideanDistance@@@{{v11,v13},{v13,v12},{v12,v16},{v16,v11},{v13,v16}}==1]

solns=Solve[And@@Join[eqns,{0<h1<h,y>0}],{y,h,h1}]//RootReduce

N[%]

poly=Join[{
{{1/2,-1/2,h},{1/2,1/2,h},{-1/2,1/2,h},{-1/2,-1/2,h}},
Reverse@{{0,-1/(Sqrt[2]),-h},{1/(Sqrt[2]),0,-h},{0,1/(Sqrt[2]),-h},{-1/(Sqrt[2]),0,-h}}
},
Flatten[Table[Map[RotationMatrix[k π/2,{0,0,1}].#&,{
{v11,v13,v16},
{v14,v16,v12},
{v12,v16,v13},
{v6,v13,v11},
{v11,v16,v15},
{v14,v15,v16}
},{2}],{k,0,3}],1]]/.solns[[1]];

Graphics3D[{FaceForm[Green,Red],Polygon[poly]},BoxRatios->Automatic]

PolyhedronEdgeLengths[poly]//FullSimplify

poly0=FullSimplify[poly];

PolyhedronVertices[Polygon/@poly0]

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["~/snub.m"]

WriteString[file,PolyhedronDataString[gc,
"StandardName"->PolyhedronData[{"Johnson",85},"StandardName"],
"Name"->PolyhedronData[{"Johnson",85},"Name"],
"Classes"->PolyhedronData[{"Johnson",85},"Classes"],
"NotationRules"->PolyhedronData[{"Johnson",85},"NotationRules"]
]]

Close[file]

Timofeenko

Timofeenko, A.~V.  ``The Non-Pkatonic and Non-Archimedean Noncomposite Polyhedra.''  {\it J.\ Math.\ Sci.} {\bf 162}, 710--729, 2009.