Octahedron 20-Compound

Author

Eric W. Weisstein
October 7, 2023

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polyhedra/Octahedron20-Compound.nb.

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

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

Variants

variants=PolyhedronData["OctahedronTwentyCompound*"]

PolyhedronData[#,"FaceCount"]&/@variants

Length[PolyhedronData[#,"Polyhedra"]]&/@variants

Polyhedra

GraphicsGrid[Transpose[{
Graphics3D[{PolyhedronData[#,"Polyhedron"]},Boxed->False],
With[{poly=PolyhedronData[#,"Polyhedra"]},Graphics3D[Table[{Hue[(i/(Length[poly]))],poly[[i]]},{i,Length[poly]}],Boxed->False]]
}&/@variants],Dividers->All,ImageSize->400]

Solids and duals

GraphicsGrid[
Table[
With[
{
s={Yellow,PolyhedronData[pname,"Midsphere"]},
dname=PolyhedronData[pname,"Dual","Name"],
style=Directive[Black,Italic,FontFamily->"Times",14]
},
{
Graphics3D[{s,Green,Opacity[.1],PolyhedronData[pname,"Polyhedron"]},Boxed->False,PlotLabel->TextCell[Style[PolyhedronData[pname,"Name"],style],PageWidth->200,TextAlignment->Center]],

Graphics3D[{s,Red,Opacity[.2],PolyhedronData[pname,"Dual","Polyhedron"]},Boxed->False,PlotLabel->Style[PolyhedronData[dname,"Name"],style]],

Graphics3D[{
{Green,Opacity[.1],PolyhedronData[pname,"Polyhedron"]},
{Red,Opacity[.2],PolyhedronData[pname,"Dual","Polyhedron"]},
s
},Boxed->False,PlotLabel->Style["compound with midsphere",style]],

Graphics3D[{
PolyhedronData[pname,"Polyhedron"],
PolyhedronData[pname,"Dual","Polyhedron"]
},Boxed->False,PlotLabel->Style["compound",style]]
}],
{pname,variants}
],
Dividers->All,ImageSize->800,Alignment->Top
]

Interior and convex hull

GraphicsGrid[
With[{style=Directive[Black,Italic,FontFamily->"Times",16]},
Table[{
Graphics3D[PolyhedronData[pname,"Polyhedron"],PlotLabel->TextCell[Style[PolyhedronData[pname,"Name"],style],PageWidth->200,TextAlignment->Center],Boxed->False],
Graphics3D[{AbsoluteThickness[.1],PolyhedronData[pname,"Lines"],Opacity[.8],PolyhedronData[pname,"CompoundInterior","Polyhedron"]},PlotLabel->Style["interior",style],Boxed->False],
Graphics3D[{
{EdgeForm[None],PolyhedronData[pname,"Polyhedron"]},
{Opacity[.7],EdgeForm[Thickness[.005]],PolyhedronData[pname,"ConvexHull","Polyhedron"]}},PlotLabel->Style["convex hull",style],Boxed->False]
},
{pname,variants}]
],
Dividers->All,ImageSize->700]

Polyhedron: {"OctahedronTwentyCompound", 1}

PolyhedronData[{"OctahedronTwentyCompound",1},"Orientations"]

Graphics3D[PolyhedronData[{"OctahedronTwentyCompound",1},"Polyhedron"],Boxed->False]

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

Polyhedron

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

Region

PolyhedronData[{"OctahedronTwentyCompound",1},"Region"]

Solid and Dual

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

Show[Most@%]

Polyhedron: {"OctahedronTwentyCompound", 2}

PolyhedronData[{"OctahedronTwentyCompound",2},"Orientations"]

Graphics3D[PolyhedronData[{"OctahedronTwentyCompound",2},"Polyhedron"],Boxed->False]

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

Polyhedron

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

Region

PolyhedronData[{"OctahedronTwentyCompound",2},"Region"]

Solid and Dual

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

Show[Most@%]

Properties: {"OctahedronTwentyCompound", 1}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"OctahedronTwentyCompound",1},"Polyhedron"]

AdjacentFaceIndices

adj1=PolyhedronData[pname,"AdjacentFaceIndices"]

adj2=AdjacentFaceIndices[p]

adj1===adj2

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

sphere=Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

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

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

CompoundInterior

Interior

intname=PolyhedronData[pname,"CompoundInterior","Name"]

PolyhedronData[pname,"CompoundInterior","Scale"]

PolyhedronData[pname,"CompoundInterior","RotationMatrix"]

PolyhedronData[pname,"CompoundInterior"]

Graphics3D[{
AbsoluteThickness[1],PolyhedronData[pname,"Lines"],
Opacity[.8],interior=PolyhedronData[pname,"CompoundInterior","Polyhedron"]},Boxed->False]

Graphics3D[{{Opacity[0],p},Red,interior},Boxed->False]

MyCircumsphere[interior]//Quiet

Insphere[interior]/.x_?NumericQ:>RootReduce[x]//Quiet//Timing

Midsphere[interior//N]

Construction

int=RegionIntersection[Sequence@@PolyhedronData[pname,"Polyhedra"],PerformanceGoal->"Quality"]

Graphics3D[int]

Graphics3D[{{Opacity[.1],p},Red,int},Boxed->False]

Numerically group

Union[Chop@int[[1]]]//Length

Length[grouped=SplitBy[SortBy[{#,Round[1*^12#]}&/@Chop[int[[1]]],Last],Last][[All,All,1]]]

Max[EuclideanDistance@@@Flatten[Subsets[#,{2}]&/@grouped,1]]

grouped//Column

rules=Flatten[Function[l,Rule[#,Mean[l]]&/@l]/@grouped,1];

newi=ConvexHullRegion[DeleteDuplicates[Chop[int[[1]]]/.rules]]

Graphics3D[LabelPolyhedron@newi]

Midsphere[newi]

RecognizeGraph@PolyhedronGraph@newi

lengths=PolyhedronEdgeLengths[newi]

Divide@@MinMax[%lengths]

Round[10^12lengths]/10^12.//Counts

newi[[1]]

Sort[newi[[2]]]

Graphics3D[{
AbsoluteThickness[.1],PolyhedronData[pname,"Lines"],
Opacity[.8],newi},Boxed->False]

Plane intersections numerically

Length[polygons=PolyhedronData[pname,"Polygons"]]

Binomial[%,3]

Length[nintersections=ThreePlaneIntersection/@Subsets[N[polygons,20],{3}]]//Timing

groupednorms=Mean/@SplitBy[SortBy[{#,Round[1*^12#]}&/@Chop[Norm/@int[[1]]],Last],Last][[All,All,1]]

normineqs[l_,dx_:1.*^-6]:=Function[Evaluate[Or@@(Function[f,f-dx<=Norm[#]<=f+dx]/@l)]]

Length[pos=Position[nintersections,Point[x_]/;normineqs[groupednorms][x]]//Flatten]//Quiet//Timing

Length[intersections=ThreePlaneIntersection/@Subsets[polygons,{3}][[pos]]]//Timing

Length[pts=Cases[intersections,Point[x_]:>Flatten[x]]]

Graphics3D[{AbsolutePointSize[5],Point[N[pts]],Opacity[.2],p}]

Length[pts2=DeleteDuplicates[Map[ToAlgebraicRoot,pts,{2}]]]//Quiet//Timing

Length[grouped]

Graphics3D[{AbsolutePointSize[5],Point[pts2],{Opacity[.2],p},Red,ConvexHullRegion[pts2]}]

vexact=pts2

Exact interior

inthull=ConvexHullRegion[Union@vexact]

v=inthull[[1]]

faces=Sort[inthull[[2]]]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[inthull]]//Counts//Quiet

pname

Concave

PolyhedronData[pname,"Concave"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]

ConvexHull

convexhullname=PolyhedronData[pname,"ConvexHull","Name"]

((Max[Norm/@p[[1]]])/(Max[Norm/@PolyhedronData[convexhullname,"Polyhedron"][[1]]]))//FullSimplify//Quiet

PolyhedronData[pname,"ConvexHull","Scale"]

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

Show[%]

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

DehnInvariant

PolyhedronData[pname,"DehnInvariant"]

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

ToConwayBasis[dehn]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

SimplifyNumericallyDistinct[DihedralAngles[p]]//Tally

N[{ArcSec[-3],π-ArcSec[3]}]

Dual

pname

dname=PolyhedronData[pname,"Dual","Name"]

PolyhedronData[pname,"Dual","Scale"]

midrs={PolyhedronData[pname,"Midradius"],PolyhedronData[dname,"Midradius"]}

Divide@@midrs//FullSimplify

GraphicsRow[With[{
s={Yellow,PolyhedronData[pname,"Midsphere"]},
style=Directive[Black,Italic,FontFamily->"Times",14]
},
{
Graphics3D[{s,Green,Opacity[.1],PolyhedronData[pname,"Polyhedron"]},Boxed->False,PlotLabel->TextCell[Style[PolyhedronData[pname,"Name"],style],PageWidth->200,TextAlignment->Center]],
Graphics3D[{s,Red,Opacity[.5],PolyhedronData[pname,"Dual","Polyhedron"]},Boxed->False,PlotLabel->Style[PolyhedronData[dname,"Name"],style]],
Graphics3D[{
{Green,Opacity[.2],PolyhedronData[pname,"Polyhedron"]},
{Red,Opacity[.5],PolyhedronData[pname,"Dual","Polyhedron"]},
s
},Boxed->False,PlotLabel->Style["compound with midsphere",style]],
Graphics3D[{
PolyhedronData[pname,"Polyhedron"],
PolyhedronData[pname,"Dual","Polyhedron"]
},Boxed->False,PlotLabel->Style["compound",style]]
}],Alignment->Top,ImageSize->800]

EdgeCount

PolyhedronData[pname,"EdgeCount"]

EdgeLengths

Tally[PolyhedronEdgeLengths[p]//RootReduce]

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

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

Hull

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

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

((Max[Norm/@p[[1]]])/(Max[Norm/@PolyhedronData[hullname,"Polyhedron"][[1]]]))//FullSimplify//Quiet

PolyhedronData[pname,"Hull"]

Max[Norm/@PolyhedronData[pname,"Hull","Polyhedron"][[1]]]

Max[Norm/@p[[1]]]

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

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

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

Midsphere[p//N]

(sphere=Midsphere[p])//Timing

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

Graphics3D[{{Opacity[.1],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

polyhedra=PolyhedronData[pname,"Polyhedra"]

Length[polyhedra]

Graphics3D[polyhedra]

Graphics3D[Table[{Hue[(i/(Length[polyhedra]))],polyhedra[[i]]},{i,Length[polyhedra]}]]

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

Tally[RecognizeGraph/@ConnectedGraphComponents[PolyhedronData[pname,"Skeleton"]]]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]

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

SurfaceArea[PolyhedronData[pname,"Region"]]

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

pname

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

PolyhedronVolume[p]

Volume[PolyhedronData[pname,"Region"]]

Properties: {"OctahedronTwentyCompound", 2}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"OctahedronTwentyCompound",2},"Polyhedron"]

AdjacentFaceIndices

adj1=PolyhedronData[pname,"AdjacentFaceIndices"]

adj2=AdjacentFaceIndices[p]

adj1===adj2

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

sphere=Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

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

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

CompoundInterior

Interior

intname=PolyhedronData[pname,"CompoundInterior","Name"]

PolyhedronData[pname,"CompoundInterior","Scale"]

PolyhedronData[pname,"CompoundInterior","RotationMatrix"]

PolyhedronData[pname,"CompoundInterior"]

Graphics3D[{
AbsoluteThickness[.1],PolyhedronData[pname,"Lines"],
Opacity[.8],interior=PolyhedronData[pname,"CompoundInterior","Polyhedron"]},Boxed->False]

Graphics3D[{{Opacity[0],p},Red,interior},Boxed->False]

MyCircumsphere[interior]//Quiet

Insphere[interior]/.x_?NumericQ:>RootReduce[x]//Quiet//Timing

MyInsphere[interior]

Midsphere[interior//N]

Construction

int=RegionIntersection[Sequence@@PolyhedronData[pname,"Polyhedra"],PerformanceGoal->"Quality"]

Graphics3D[int]

Graphics3D[{{Opacity[.1],p},Red,int},Boxed->False]

Numerically group

Union[Chop@int[[1]]]//Length

Length[grouped=SplitBy[SortBy[{#,Round[1*^12#]}&/@Chop[int[[1]]],Last],Last][[All,All,1]]]

Max[EuclideanDistance@@@Flatten[Subsets[#,{2}]&/@grouped,1]]

grouped//Column

rules=Flatten[Function[l,Rule[#,Mean[l]]&/@l]/@grouped,1];

newi=ConvexHullRegion[DeleteDuplicates[Chop[int[[1]]]/.rules]]

Graphics3D[LabelPolyhedron@newi]

Midsphere[newi]

RecognizeGraph@PolyhedronGraph@newi

lengths=PolyhedronEdgeLengths[newi]

Divide@@MinMax[%lengths]

Round[10^12lengths]/10^12.//Counts

newi[[1]]

Sort[newi[[2]]]

Graphics3D[{
AbsoluteThickness[.1],PolyhedronData[pname,"Lines"],
Opacity[.8],newi},Boxed->False]

Plane intersections numerically

Length[polygons=PolyhedronData[pname,"Polygons"]]

Binomial[%,3]

Length[nintersections=ThreePlaneIntersection/@Subsets[N[polygons,20],{3}]]//Timing

groupednorms=Mean/@SplitBy[SortBy[{#,Round[1*^12#]}&/@Chop[Norm/@int[[1]]],Last],Last][[All,All,1]]

normineqs[l_,dx_:1.*^-6]:=Function[Evaluate[Or@@(Function[f,f-dx<=Norm[#]<=f+dx]/@l)]]

Length[pos=Position[nintersections,Point[x_]/;normineqs[groupednorms][x]]//Flatten]//Quiet//Timing

Length[intersections=ThreePlaneIntersection/@Subsets[polygons,{3}][[pos]]]//Timing

Length[pts=Cases[intersections,Point[x_]:>Flatten[x]]]

Graphics3D[{AbsolutePointSize[5],Point[N[pts]],Opacity[.2],p}]

Length[pts2=DeleteDuplicates[Map[ToAlgebraicRoot[#,"RootReduce"->False]&,pts,{2}]]]//Quiet//Timing

Length[grouped]

Graphics3D[{AbsolutePointSize[5],Point[pts2],{Opacity[0],p},Red,ConvexHullRegion[pts2]}]

Length[polyhedra=PolyhedronData[pname,"Polyhedra"]]

inside=Select[pts2,AllTrue[polyhedra,Function[poly,RegionMember[poly,#]]]&]

Length[inside]

SimplifyNumericallyDistinct[Norm/@pts2,"Simplification"->RootReduce]//Union

SimplifyNumericallyDistinct[Norm/@inside,"Simplification"->RootReduce]//Union

outside=Complement[pts2,inside]

Graphics3D[{{Opacity[.2],int},AbsolutePointSize[5],Point[inside],Red,Point[outside]},Boxed->False]

hull=ConvexHullRegion[inside]

Graphics3D[{{Opacity[.5],hull},Point[inside]}]

vexact=inside

Exact interior

inthull=ConvexHullRegion[Union@vexact]

v=inthull[[1]]

faces=Sort[inthull[[2]]]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[inthull]]//Counts//Quiet

pname

Concave

PolyhedronData[pname,"Concave"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]//Timing

ConvexHull

convexhullname=PolyhedronData[pname,"ConvexHull","Name"]

((Max[Norm/@p[[1]]])/(Max[Norm/@PolyhedronData[convexhullname,"Polyhedron"][[1]]]))//FullSimplify//Quiet

PolyhedronData[pname,"ConvexHull","Scale"]

PolyhedronData[pname,"ConvexHull"]

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

Counts[SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhull]]]

Keys[%]//N

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

Show[%]

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

DehnInvariant

PolyhedronData[pname,"DehnInvariant"]

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

ToConwayBasis[dehn]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

SimplifyNumericallyDistinct[DihedralAngles[p],"Simplification"->RootReduce]//FullSimplify//Quiet//Tally

Dual

pname

dname=PolyhedronData[pname,"Dual","Name"]

PolyhedronData[pname,"Dual","Scale"]

midrs={PolyhedronData[pname,"Midradius"],PolyhedronData[dname,"Midradius"]}

Divide@@midrs//FullSimplify

GraphicsRow[With[{
s={Yellow,PolyhedronData[pname,"Midsphere"]},
style=Directive[Black,Italic,FontFamily->"Times",14]
},
{
Graphics3D[{s,Green,Opacity[.1],PolyhedronData[pname,"Polyhedron"]},Boxed->False,PlotLabel->TextCell[Style[PolyhedronData[pname,"Name"],style],PageWidth->200,TextAlignment->Center]],
Graphics3D[{s,Red,Opacity[.5],PolyhedronData[pname,"Dual","Polyhedron"]},Boxed->False,PlotLabel->Style[PolyhedronData[dname,"Name"],style]],
Graphics3D[{
{Green,Opacity[.3],PolyhedronData[pname,"Polyhedron"]},
{Red,Opacity[.5],PolyhedronData[pname,"Dual","Polyhedron"]},
s
},Boxed->False,PlotLabel->Style["compound with midsphere",style]],
Graphics3D[{
PolyhedronData[pname,"Polyhedron"],
PolyhedronData[pname,"Dual","Polyhedron"]
},Boxed->False,PlotLabel->Style["compound",style]]
}],Alignment->Top,ImageSize->800]

EdgeCount

PolyhedronData[pname,"EdgeCount"]

EdgeLengths

Tally[PolyhedronEdgeLengths[p]//RootReduce]

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

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

Hull

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

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

((Max[Norm/@p[[1]]])/(Max[Norm/@PolyhedronData[hullname,"Polyhedron"][[1]]]))//FullSimplify//Quiet

PolyhedronData[pname,"Hull"]

Max[Norm/@PolyhedronData[pname,"Hull","Polyhedron"][[1]]]

Max[Norm/@p[[1]]]

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

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

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

Midsphere[p//N]

(sphere=Midsphere[p])//Timing

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

Graphics3D[{{Opacity[.1],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

polyhedra=PolyhedronData[pname,"Polyhedra"]

Length[polyhedra]

Graphics3D[polyhedra]

Graphics3D[Table[{Hue[(i/(Length[polyhedra]))],polyhedra[[i]]},{i,Length[polyhedra]}]]

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

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]//Timing

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

SurfaceArea[PolyhedronData[pname,"Region"]]

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

pname

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

PolyhedronVolume[p]

Volume[PolyhedronData[pname,"Region"]]

Construction

First (from IcositruncatedDodecadodecahedron)

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

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

octahedronindices=Lookup[h,"Octahedron"]

Flatten[octahedronindices]//Union

%===Range[120]

Length[octahedronindices]

v=p[[1]];

Graphics3D[{{Opacity[.2],{Green,p}},Blue,ConvexHullRegion[v[[#]]]},Boxed->False]&/@octahedronindices

Graphics3D[ConvexHullRegion[v[[#]]]&/@octahedronindices,Boxed->False]

originalfaces[v_,orig_]:=Module[{con=ConvexHullRegion[v]},
(con[[2]]/.i_Integer:>con[[1,i]])/.Thread[orig->Range@Length@orig]
]

faces=originalfaces[v[[#]],v]&/@octahedronindices

compound=Polyhedron[v,Flatten[faces,1]]

Graphics3D[compound]

Second (from GreatDirhombicosidodecahedron)

BulatovUniformName[80]

UniformPolyhedronIndex["GreatDirhombicosidodecahedron"]

Graphics3D[GreatDirhombicosidodecahedron=PolyhedronData["GreatDirhombicosidodecahedron","Polyhedron"]]

hulls=VertexSubsetHulls[GreatDirhombicosidodecahedron,"Platonic"]

octahedronindices=Lookup[hulls,"Octahedron"]

Flatten[octahedronindices]//Union

%===Range[60]

Length[octahedronindices]

v=GreatDirhombicosidodecahedron[[1]];

Graphics3D[{{Opacity[.2],{Green,GreatDirhombicosidodecahedron}},Blue,ConvexHullRegion[v[[#]]]},Boxed->False]&/@octahedronindices

Graphics3D[ConvexHullRegion[v[[#]]]&/@octahedronindices,Boxed->False]

originalfaces[v_,orig_]:=Module[{con=ConvexHullRegion[v]},
(con[[2]]/.i_Integer:>con[[1,i]])/.Thread[orig->Range@Length@orig]
]

originalfaces[v[[octahedronindices[[1]]]],v]

faces=originalfaces[v[[#]],v]&/@octahedronindices

compound=Polyhedron[v,Flatten[faces,1]]

Graphics3D[compound]

Second (from GreatSnubDodecicosidodecahedron)

UniformPolyhedronIndex["GreatSnubDodecicosidodecahedron"]

Graphics3D[p=PolyhedronData["GreatSnubDodecicosidodecahedron","Polyhedron"]]

hulls=VertexSubsetHulls[p,"Platonic"]

octahedronindices=Lookup[hulls,"Octahedron"]

Flatten[octahedronindices]//Union

%===Range[60]

Length[octahedronindices]

v=p[[1]];

Graphics3D[{{Opacity[.2],{Green,p}},Blue,ConvexHullRegion[v[[#]]]},Boxed->False]&/@octahedronindices

Graphics3D[ConvexHullRegion[v[[#]]]&/@octahedronindices,Boxed->False]

originalfaces[v_,orig_]:=Module[{con=ConvexHullRegion[v]},
(con[[2]]/.i_Integer:>con[[1,i]])/.Thread[orig->Range@Length@orig]
]

originalfaces[v[[octahedronindices[[1]]]],v]

faces=originalfaces[v[[#]],v]&/@octahedronindices

compound=Polyhedron[v,Flatten[faces,1]]

Graphics3D[compound]

PolyhedronData

PolyhedronDataString

<<MathWorld`Polyhedra`

file=OpenWrite["~/20compound.m"]

WriteString[file,PolyhedronDataString[compound,
"StandardName"->{"OctahedronTwentyCompound",2},
"AlternateStandardNames"->{},
"Name"->"second cube 20\[Hyphen]compound",
"Information"->"Octahedron20-Compound",
"Classes"->{"Compound"}
]]

Close[file]