Octagrammic Prism

Author

Eric W. Weisstein
September 21, 2023

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

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

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

Variants

variants=PolyhedronData["OctagrammicPrism*"]

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

Polyhedron: "OctagrammicPrismHull"

Orientations

PolyhedronData["OctagrammicPrismHull","Orientations"]

PolyhedronData["OctagrammicPrismHull","DefaultOrientation"]

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

Polyhedron

Graphics3D[{Opacity[.8],PolyhedronData["OctagrammicPrismHull","Polyhedron"]}]

Face orientation

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

Graphics3D[LabelPolyhedron@PolyhedronData["OctagrammicPrismHull","Polyhedron"]]

PolyhedronData["OctagrammicPrismHull","FaceIndices"]

Region

PolyhedronData["OctagrammicPrismHull","Region"]

Solid and dual

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

Graphics3D[{{Opacity[.6],
Red,PolyhedronData["OctagrammicPrismHull","Polyhedron"],
Green,PolyhedronData["OctagrammicPrismHull","Dual","Polyhedron"]},
Yellow,PolyhedronData["OctagrammicPrismHull","Midsphere"]},Boxed->False]

Properties: "OctagrammicPrismHull"

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

Graphics3D[%]

AdjacentFaceIndices

PolyhedronData["OctagrammicPrismHull","AdjacentFaceIndices"]

AdjacentFaceIndices[p]===%

Centroid

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

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p]//FullSimplify

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Convex

ConvexPolyhedronQ[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//FullSimplify//Tally

EdgeCount

PolyhedronData["OctagrammicPrismHull","EdgeCount"]

PolyhedronData["OctagrammicPrismHull","Lines"]//Length

EdgeLengths

PolyhedronData["OctagrammicPrismHull","EdgeLengths"]

PolyhedronData["OctagrammicPrismHull","Lines"]/.Line[{l__}]:>EuclideanDistance[l]//FullSimplify//Union

Faces

Rule@@@Tally[Length/@PolyhedronData["OctagrammicPrismHull","FaceIndices"]]

GeneralizedDiameter

PolyhedronData["OctagrammicPrismHull","GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

((MomentOfInertia[p,{0,0,0}])/(Volume[p]))//FullSimplify//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"]))//FullSimplify)//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"]))//FullSimplify)//Timing

N[i]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

(sphere=Midsphere[p])//Timing

Net

PolyhedronData["OctagrammicPrismHull","Net"]

RegionFunction

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

1+2 #3≥0&&2 #3≤1&&((-3-2 (Sqrt[2])≤(2+(Sqrt[2])) #1≤3+2 (Sqrt[2])&&-3-2 (Sqrt[2])≤(2+(Sqrt[2])) #2≤3+2 (Sqrt[2]))||(-3-2 (Sqrt[2])≤(1+(Sqrt[2])) (#1+#2)≤3+2 (Sqrt[2])&&-3-2 (Sqrt[2])≤(1+(Sqrt[2])) (#1-#2)≤3+2 (Sqrt[2])))&

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]

c=CirclePoints[{(Sqrt[2])+1,0},8];

Graphics[{ClosedLine/@(tris=Transpose[Partition[c,2]]),MapIndexed[Text[#2[[1]],#,Background->White]&,c]}]

Or@@Table[And@@PolyhedronInequalities[Polygon/@{Append[#,1/2]&/@tris[[i]],
Append[#,-1/2]&/@Reverse[tris[[i]]],
Sequence@@({Append[#2,-1/2],Append[#2,1/2],Append[#1,1/2],Append[#1,-1/2]}&@@@Partition[tris[[i]],2,1,1])},{x,y,z}],{i,2}]//FullSimplify

Skeleton

g=PolyhedronData["OctagrammicPrismHull","Skeleton"]

r=RecognizeGraph[g]

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

ToCommonEdges[GraphData[r],g]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]//FullSimplify

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

VertexSubsetHulls

PolyhedronData[pname,"VertexSubsetHulls"]

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p,Debug->True]//FullSimplify

Integrate[Evaluate[Boole[PolyhedronData["OctagrammicPrismHull","RegionFunction"][x,y,z]]],{x,y,z}∈FullRegion[3]]//FullSimplify

Construction: {8, 2} = Star of Lakshmi

c=CirclePoints[{(Sqrt[2])+1,0},8];

Graphics[{ClosedLine/@Transpose[Partition[c,2]],MapIndexed[Text[#2[[1]],#,Background->White]&,c]}]

EuclideanDistance@@c[[{1,3}]]

p=RegionIntersection[Line[c[[{1,3}]]],Line[c[[{2,8}]]]][[1,1]]//FullSimplify

r=Norm[p]//FullSimplify

1/EuclideanDistance[c[[1]],p]//FullSimplify

Graphics[{EdgeForm[Black],FaceForm[LightYellow],Polygon/@Transpose[Partition[c,2]],AbsolutePointSize[5],Point[c2=CirclePoints[{r,π/8},8]]}]

Table[Graphics[Polygon[Flatten[Transpose[{c,RotateRight[c2,i]}],1]]],{i,0,5}]

Graphics[{EdgeForm[Black],FaceForm[LightYellow],Polygon[top=Flatten[Transpose[{c,c2}],1]]}]

Length[top]

top//N

v=Join[Append[#,1/2]&/@top,Append[#,-1/2]&/@top]//FullSimplify

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

faces=Sort[SmallestRotation/@{Range[16],Reverse@Range[17,32],{32,17,1,16},Sequence@@Table[{i+16,i+17,i+1,i},{i,15}]}]

Graphics3D[{FaceForm[Green,Red],Polyhedron[v,faces]}]

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

Volume[p]

Graphics3D[{FaceForm[Green,Red],Polygon[#[{{0,0,0},{1,0,0},{0,1,0}}]]}]&/@{Identity,Reverse}

vv=Take[v,16]

Graphics3D[{FaceForm[Green,Red],Polygon[#[vv]]}]&/@{Identity,Reverse}

Graphics3D[{FaceForm[Green,Red],Polygon[N@#[vv]]}]&/@{Identity,Reverse}

pentagram=Table[Append[Through[{Cos,Sin}[2π i/5]],0],{i,1,10,2}];

Graphics3D[{FaceForm[Green,Red],Polygon[#[pentagram]]}]&/@{Identity,Reverse}

Construction: {8, 3}

ClosedLine[l_]:=Line[Append[l,First[l]]]

Graphics[ClosedLine[Table[Through[{Cos,Sin}[π/8+3 2π i/8]],{i,0,7}]]]