Dodecahedron 5-Compound

Author

Eric W. Weisstein
October 6, 2023

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

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

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

Variants

variants=PolyhedronData["DodecahedronFiveCompound*"]

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

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[.5],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[.5],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]]
}],
{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[.2],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: {"DodecahedronFiveCompound", 1}

Orientations

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

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

PolyhedronData[{"DodecahedronFiveCompound",1}]

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

Polyhedron

Graphics3D[{Opacity[.7],PolyhedronData[{"DodecahedronFiveCompound",1},"Polyhedron"]}]

Face orientation

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

Region

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

Solid and dual

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

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

Polyhedron: {"DodecahedronFiveCompound", 2}

Orientations

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

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

PolyhedronData[{"DodecahedronFiveCompound",2}]

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

Polyhedron

Graphics3D[{Opacity[.7],PolyhedronData[{"DodecahedronFiveCompound",2},"Polyhedron"]}]

Face orientation

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

Region

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

Solid and dual

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

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

Polyhedron: {"DodecahedronFiveCompound", 3}

Orientations

PolyhedronData[{"DodecahedronFiveCompound",3},"Orientations"]

PolyhedronData[{"DodecahedronFiveCompound",3},"Orientations"]

PolyhedronData[{"DodecahedronFiveCompound",3}]

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

Polyhedron

Graphics3D[{Opacity[.7],PolyhedronData[{"DodecahedronFiveCompound",3},"Polyhedron"]}]

Face orientation

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

Region

PolyhedronData[{"DodecahedronFiveCompound",3},"Region"]

Solid and dual

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

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

Properties: {"DodecahedronFiveCompound", 1}

Initialization

<<MathWorld`Polyhedra`

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

AdjacentFaceIndices

adj1=PolyhedronData[pname,"AdjacentFaceIndices"]

adj2=AdjacentFaceIndices[p]

adj1===adj2

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

(sphere=Circumsphere[p])//Timing

sphere=Circumsphere[p//N]

MyCircumsphere[p//N]

(sphere=MyCircumsphere[p])//Timing

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

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

CompoundInterior

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[.1],p},Red,interior},Boxed->False]

MyCircumsphere[interior]//Quiet

Insphere[interior]//Quiet

Midsphere[interior//N]

Construction

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

Graphics3D[int]

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

Exactify: RootApproximant

vexact=DeleteDuplicates[RootApproximant[Chop[int[[1]]]]]

Length[vexact]

Exactify: ToAlgebraicRoot

vexact=DeleteDuplicates[Map[ToAlgebraicRoot[SetPrecision[#,14],"MaxDegree"->4]&,Chop[int[[1]]],{2}]]

Length[vexact]

Plane intersections when all intersections are computable

polygons=PolyhedronData[pname,"Polygons"]

Length@polygons

Binomial[%,3]

Length[intersections=RegionIntersection@@@Subsets[InfinitePlane@@@polygons,{3}]]//Timing

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

pts[[1]]

bug(440813): RegionIntersection[plane1, plane2, plane3] returns Point with hidden zero in denominator for planes that don't intersect in a point

Length[pts2=Select[pts,Min[Abs[Denominator[#]]]>1*^-100&]]//Quiet//Timing

Graphics3D[{AbsolutePointSize[5],Point[N[pts2]],Opacity[.2],p},PlotRange->.7]

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

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

ineq=normineqs[groupednorms,.0001]

Length[pts3=Select[pts2,ineq]]//Quiet//Timing

Graphics3D[{AbsolutePointSize[5],Point[N[pts3]],Opacity[.2],p},PlotRange->.7]

Length[pts4=DeleteDuplicates[Map[ToAlgebraicRoot,pts3,{2}]]]//Timing

Graphics3D[{AbsolutePointSize[5],Point[pts4],{Opacity[0],p},Red,ConvexHullRegion[pts4]},PlotRange->.4]

vexact=pts4

Plane intersections numerically

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

Binomial[%,3]

Length[nintersections=RegionIntersection@@@Subsets[InfinitePlane[Take[#,3]]&@@@N[polygons,20],{3}]]//Timing

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

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

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

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

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

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

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

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

vexact=pts2

Exact interior

inthull=ConvexHullRegion[Union@vexact]

v=inthull[[1]]//ToRadicals

faces=Sort[inthull[[2]]]

gname=RecognizeGraph@PolyhedronGraph[inthull]

GraphData[gname,"PolyhedralEmbeddings"]

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

lengths=Keys[%]

(lengths/(Min[lengths]))//FullSimplify

PolyhedronData["DeltoidalHexecontahedron","EdgeLengths"]

RootReduce[PolyhedronEdgeLengths[PolyhedronData["DeltoidalHexecontahedron","Polyhedron"]]]//Counts

pname

Concave

PolyhedronData[pname,"Concave"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]//Timing

ConvexHull

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

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

PolyhedronData[pname,"ConvexHull","RotationMatrix"]

Graphics3D[convexhull=PolyhedronData[pname,"ConvexHull","Polyhedron"]]

{
Graphics3D[{Red,Opacity[.5],p}],
Graphics3D[{Blue,Opacity[.5],convexhull}]
}

Show[%]

Construct using ConvexHullRegion

Graphics3D[convexhullreg=ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]

v=PolyhedronCoordinates[convexhullreg]

Sort[(convexhullreg[[2]]/.i_Integer:>v[[i]])/.Thread[PolyhedronData[pname,"Vertices"]->Range[PolyhedronData[pname,"V"]]]]

Find scale

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhullreg]]//Tally//FullSimplify

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

Find rotation matrix

Graphics3D[{FaceForm[Green,Red],basesolid=PolyhedronData[convexhullname,"Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,basev=basesolid[[1]]]}]

rot=RotationMatrix[{Mean[basev[[{11,12}]]],{0,0,1}}]//FullSimplify

{Graphics3D[{Polyhedron[newv=rot.#&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ArcTan@@(Most@Mean[newv[[{7,29}]]])//FullSimplify

rot2=RotationMatrix[Pi/2+2Pi/5,{0,0,1}].rot//FullSimplify

{Graphics3D[{Polyhedron[(rot2.#)&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ConvexHullOf

hullof=DeleteCases[Select[PolyhedronData[All],PolyhedronData[#,"ConvexHullName"]===pname&],pname]

GraphicsGrid[Partition[Graphics3D[{
{Green,Opacity[.7],PolyhedronData[#,"Polyhedron"]},
{Blue,Opacity[.2],PolyhedronData[#,"ConvexHull","Polyhedron"]}},Boxed->False,PlotLabel->Style[PolyhedronData[#,"Name"],Directive[14,Black,Italic,FontFamily->"Times"]]]&/@hullof,UpTo[3]],Dividers->All,ImageSize->800]

DehnInvariant

PolyhedronData[pname,"DehnInvariant"]

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

ToConwayBasis[dehn]

Complement[Select[PolyhedronData[All],PolyhedronData[#,"DehnInvariant"]==dehn&&PolyhedronData[#,"Volume"]==vol&],{pname}]

DihedralAngles

(dih1=PolyhedronData[pname,"DihedralAngles"])//Tally

(dih2=SimplifyNumericallyDistinct[DihedralAngles[p]])//Tally

dih1===dih2

Dual

pname

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

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

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

Divide@@midrs//FullSimplify

N[%]

GraphicsRow[With[{
s={Yellow,PolyhedronData[pname,"Midsphere"]},
style=Directive[Black,Italic,FontFamily->"Times",14]
},
{
Graphics3D[{s,Green,Opacity[.5],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[.5],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[lens=SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p],"Simplification"->RootReduce]//FullSimplify]//Timing

PolyhedronData[pname,"EdgeLengths"]

PolyhedronData[pname,"Lines"]/.Line[l_]:>EuclideanDistance@@l//FullSimplify//Union//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[%]

Find rotation matrix

Graphics3D[{FaceForm[Green,Red],basesolid=PolyhedronData[hullname,"Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,basev=basesolid[[1]]]}]

rot=RotationMatrix[{Mean[basev[[{11,12}]]],{0,0,1}}]//FullSimplify

{Graphics3D[{Polyhedron[newv=rot.#&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ArcTan@@(Most@Mean[newv[[{7,29}]]])//FullSimplify

rot2=RotationMatrix[Pi/2+2Pi/5,{0,0,1}].rot//FullSimplify

{Graphics3D[{Polyhedron[(rot2.#)&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

HullOf

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===pname&]

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===hullname&]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

Insphere

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]

MyInsphere[p//N]

RootApproximant[1.1135163644116064`]//FullSimplify

(sphere=MyInsphere[p,Debug->True,"Simplification"->RootReduce])//Timing

2 (Sqrt[((2 (((NumericalApproximation[Root, (RowDefault["1.38", FEExpressionsNumericalApproximationElider]), Root[1-10 ((#1)^2)+5 ((#1)^4)&,4], ])^2) ((NumericalApproximation[Root, (RowDefault["-0.851", FEExpressionsNumericalApproximationElider]), Root[1-5 ((#1)^2)+5 ((#1)^4)&,1], ])^2)+2 (NumericalApproximation[Root, (RowDefault["1.38", FEExpressionsNumericalApproximationElider]), Root[1-10 ((#1)^2)+5 ((#1)^4)&,4], ]) (NumericalApproximation[Root, (RowDefault["-0.851", FEExpressionsNumericalApproximationElider]), Root[1-5 ((#1)^2)+5 ((#1)^4)&,1], ]) (NumericalApproximation[Root, (RowDefault["0.263", FEExpressionsNumericalApproximationElider]), Root[1-20 ((#1)^2)+80 ((#1)^4)&,3], ]) (NumericalApproximation[Root, (RowDefault["0.425", FEExpressionsNumericalApproximationElider]), Root[1-20 ((#1)^2)+80 ((#1)^4)&,4], ])+((NumericalApproximation[Root, (RowDefault["0.263", FEExpressionsNumericalApproximationElider]), Root[1-20 ((#1)^2)+80 ((#1)^4)&,3], ])^2) ((NumericalApproximation[Root, (RowDefault["0.425", FEExpressionsNumericalApproximationElider]), Root[1-20 ((#1)^2)+80 ((#1)^4)&,4], ])^2)))/(5+(Sqrt[5])))])//FullSimplify

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

(1/4) (3+(Sqrt[5]))//N

sphere=Midsphere[p//N]

(sphere=Midsphere[p])//Timing

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

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

PolyhedronFaceTally[p]

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

Skeleton

PolyhedronData[pname,"Skeleton"]

gn=PolyhedronData[pname,"Skeleton","Name"]

GraphData[gn]

emb=GraphData[gn,"PolyhedralEmbeddings"]

l={{gn,{0,Union[emb,{pname}]}}}

PropertyReplace[l,"PolyhedralEmbeddings","14.0"]

pname

With[{verts=PolyhedronData[pname,"Vertices"],faces=PolyhedronData[pname,"Faces","List"]},
ToCommonEdges[GraphData[gn],Graph[Range[Length[verts]],UndirectedEdge@@@Union[Sort/@Flatten[Partition[#,2,1,1]&/@faces,1]]]]]//Chop[#,1*^-5]&//N

GraphData[gn,"Graph",{"3D","All"}]

g=PolyhedronGraph[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]

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

SurfaceArea[PolyhedronData[pname,"Region"]]

Uniform

PolyhedronData[pname,"Uniform"]

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

subsethulls=PolyhedronData[pname,"VertexSubsetHulls"]

v=PolyhedronData[pname,"Vertices"];

Rule[#,Length[#2]]&@@@subsethulls

Rule[#,Graphics3D[Function[f,ConvexHullRegion[v[[f]]]]/@#2]]&@@@subsethulls

subsethulls2=Flatten[Function[{pn,l},Rule[pn,#]&/@l]@@@subsethulls]

Rule[#,Graphics3D[{{Opacity[.3],{Green,p}},Blue,ConvexHullRegion[v[[#2]]]}]]&@@@subsethulls2

Convex hull

Graphics3D[convexhullreg=ConvexHullRegion[v=PolyhedronData[pname,"Vertices"]]]

v=PolyhedronCoordinates[convexhullreg]

Flatten[(convexhullreg[[2]]/.i_Integer:>v[[i]])/.Thread[PolyhedronData[pname,"Vertices"]->Range[PolyhedronData[pname,"V"]]]]//Union

%===Range@Length@v

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

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Properties: {"DodecahedronFiveCompound", 2}

Initialization

<<MathWorld`Polyhedra`

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

AdjacentFaceIndices

adj1=PolyhedronData[pname,"AdjacentFaceIndices"]

adj2=AdjacentFaceIndices[p]

adj1===adj2

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

(sphere=Circumsphere[p])//Timing

(sphere=MyCircumsphere[p]//FullSimplify)//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[.2],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[0],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]}]

Union[pts2]//Length

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

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

Length[inside]

outside=Complement[pts2,inside]

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

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

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

bug(392608): It would be nice if ConvexPolyhedronQ[compound polyhedron] returned more quickly

ConvexHull

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

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

PolyhedronData[pname,"ConvexHull","RotationMatrix"]

Graphics3D[convexhull=PolyhedronData[pname,"ConvexHull","Polyhedron"]]

{
Graphics3D[{Red,Opacity[.5],p}],
Graphics3D[{Blue,Opacity[.5],convexhull}]
}

Show[%]

Construct using ConvexHullRegion

Graphics3D[convexhullreg=ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]

v=PolyhedronCoordinates[convexhullreg]

Sort[(convexhullreg[[2]]/.i_Integer:>v[[i]])/.Thread[PolyhedronData[pname,"Vertices"]->Range[PolyhedronData[pname,"V"]]]]

Find scale

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhullreg]]//Tally//FullSimplify

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

Find rotation matrix

Graphics3D[{FaceForm[Green,Red],basesolid=PolyhedronData[convexhullname,"Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,basev=basesolid[[1]]]}]

rot=RotationMatrix[{Mean[basev[[{11,12}]]],{0,0,1}}]//FullSimplify

{Graphics3D[{Polyhedron[newv=rot.#&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ArcTan@@(Most@Mean[newv[[{7,29}]]])//FullSimplify

rot2=RotationMatrix[Pi/2+2Pi/5,{0,0,1}].rot//FullSimplify

{Graphics3D[{Polyhedron[(rot2.#)&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ConvexHullOf

hullof=DeleteCases[Select[PolyhedronData[All],PolyhedronData[#,"ConvexHullName"]===pname&],pname]

GraphicsGrid[Partition[Graphics3D[{
{Green,Opacity[.7],PolyhedronData[#,"Polyhedron"]},
{Blue,Opacity[.2],PolyhedronData[#,"ConvexHull","Polyhedron"]}},Boxed->False,PlotLabel->Style[PolyhedronData[#,"Name"],Directive[14,Black,Italic,FontFamily->"Times"]]]&/@hullof,UpTo[3]],Dividers->All,ImageSize->800]

DehnInvariant

PolyhedronData[pname,"DehnInvariant"]

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

ToConwayBasis[dehn]

Complement[Select[PolyhedronData[All],PolyhedronData[#,"DehnInvariant"]==dehn&&PolyhedronData[#,"Volume"]==vol&],{pname}]

DihedralAngles

(dih1=PolyhedronData[pname,"DihedralAngles"])//Tally

(dih2=SimplifyNumericallyDistinct[DihedralAngles[p]])//Tally

dih1===dih2

Dual

pname

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

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

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

Divide@@midrs//FullSimplify

N[%]

GraphicsRow[With[{
s={Yellow,PolyhedronData[pname,"Midsphere"]},
style=Directive[Black,Italic,FontFamily->"Times",14]
},
{
Graphics3D[{s,Green,Opacity[.5],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[.5],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[lens=SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p],"Simplification"->RootReduce]//FullSimplify]//Timing

PolyhedronData[pname,"EdgeLengths"]

PolyhedronData[pname,"Lines"]/.Line[l_]:>EuclideanDistance@@l//FullSimplify//Union//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[%]

Find rotation matrix

Graphics3D[{FaceForm[Green,Red],basesolid=PolyhedronData[hullname,"Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,basev=basesolid[[1]]]}]

rot=RotationMatrix[{Mean[basev[[{11,12}]]],{0,0,1}}]//FullSimplify

{Graphics3D[{Polyhedron[newv=rot.#&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ArcTan@@(Most@Mean[newv[[{7,29}]]])//FullSimplify

rot2=RotationMatrix[Pi/2+2Pi/5,{0,0,1}].rot//FullSimplify

{Graphics3D[{Polyhedron[(rot2.#)&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

HullOf

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===pname&]

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===hullname&]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

Insphere

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]

MyInsphere[N[p,20]]

%/.x_?InexactNumberQ:>RootApproximant[x]//FullSimplify

(sphere=MyInsphere[p,Debug->True,"Simplification"->RootReduce])//Timing

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

sphere=Midsphere[N[p,20]]

%/.x_?InexactNumberQ:>FullSimplify[RootApproximant[x]]

(sphere=Midsphere[p])//Timing

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

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

PolyhedronFaceTally[p]

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

Skeleton

PolyhedronData[pname,"Skeleton"]

gn=PolyhedronData[pname,"Skeleton","Name"]

GraphData[gn]

emb=GraphData[gn,"PolyhedralEmbeddings"]

l={{gn,{0,Union[emb,{pname}]}}}

PropertyReplace[l,"PolyhedralEmbeddings","14.0"]

pname

With[{verts=PolyhedronData[pname,"Vertices"],faces=PolyhedronData[pname,"Faces","List"]},
ToCommonEdges[GraphData[gn],Graph[Range[Length[verts]],UndirectedEdge@@@Union[Sort/@Flatten[Partition[#,2,1,1]&/@faces,1]]]]]//Chop[#,1*^-5]&//N

GraphData[gn,"Graph",{"3D","All"}]

g=PolyhedronGraph[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]

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

SurfaceArea[PolyhedronData[pname,"Region"]]

Uniform

PolyhedronData[pname,"Uniform"]

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

subsethulls=PolyhedronData[pname,"VertexSubsetHulls"]

v=PolyhedronData[pname,"Vertices"];

Rule[#,Length[#2]]&@@@subsethulls

Rule[#,Graphics3D[Function[f,ConvexHullRegion[v[[f]]]]/@#2]]&@@@subsethulls

subsethulls2=Flatten[Function[{pn,l},Rule[pn,#]&/@l]@@@subsethulls]

Rule[#,Graphics3D[{{Opacity[.3],{Green,p}},Blue,ConvexHullRegion[v[[#2]]]}]]&@@@subsethulls2

Convex hull

Graphics3D[convexhullreg=ConvexHullRegion[v=PolyhedronData[pname,"Vertices"]]]

v=PolyhedronCoordinates[convexhullreg]

Flatten[(convexhullreg[[2]]/.i_Integer:>v[[i]])/.Thread[PolyhedronData[pname,"Vertices"]->Range[PolyhedronData[pname,"V"]]]]//Union

%===Range@Length@v

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

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Properties: {"DodecahedronFiveCompound", 3}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"DodecahedronFiveCompound",3},"Polyhedron"]

AdjacentFaceIndices

adj1=PolyhedronData[pname,"AdjacentFaceIndices"]

adj2=AdjacentFaceIndices[p]

adj1===adj2

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

(sphere=Circumsphere[p])//Timing

sphere=Circumsphere[p//N]

MyCircumsphere[p//N]

(sphere=MyCircumsphere[p])//Timing

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

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

CompoundInterior

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[.1],p},Red,interior},Boxed->False]

MyCircumsphere[interior]//Quiet

Insphere[interior]//Quiet

Midsphere[interior//N]

Construction

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

Graphics3D[int]

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

Exactify: RootApproximant

vexact=DeleteDuplicates[RootApproximant[Chop[int[[1]]]]]

Length[vexact]

Exactify: ToAlgebraicRoot

vexact=DeleteDuplicates[Map[ToAlgebraicRoot[SetPrecision[#,14],"MaxDegree"->4]&,Chop[int[[1]]],{2}]]

Length[vexact]

Plane intersections numerically

polygons=PolyhedronData[pname,"Polygons"]

Length@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_:.0001]:=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

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

gname=RecognizeGraph@PolyhedronGraph[inthull]

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

pname

Concave

PolyhedronData[pname,"Concave"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]//Timing

ConvexHull

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

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

PolyhedronData[pname,"ConvexHull","RotationMatrix"]

Graphics3D[convexhull=PolyhedronData[pname,"ConvexHull","Polyhedron"]]

{
Graphics3D[{Red,Opacity[.5],p}],
Graphics3D[{Blue,Opacity[.5],convexhull}]
}

Show[%]

Construct using ConvexHullRegion

Graphics3D[convexhullreg=ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]

v=PolyhedronCoordinates[convexhullreg]

Sort[(convexhullreg[[2]]/.i_Integer:>v[[i]])/.Thread[PolyhedronData[pname,"Vertices"]->Range[PolyhedronData[pname,"V"]]]]

Find scale

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhullreg]]//Tally//FullSimplify

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

Find rotation matrix

Graphics3D[{FaceForm[Green,Red],basesolid=PolyhedronData[convexhullname,"Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,basev=basesolid[[1]]]}]

rot=RotationMatrix[{Mean[basev[[{11,12}]]],{0,0,1}}]//FullSimplify

{Graphics3D[{Polyhedron[newv=rot.#&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ArcTan@@(Most@Mean[newv[[{7,29}]]])//FullSimplify

rot2=RotationMatrix[Pi/2+2Pi/5,{0,0,1}].rot//FullSimplify

{Graphics3D[{Polyhedron[(rot2.#)&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ConvexHullOf

hullof=DeleteCases[Select[PolyhedronData[All],PolyhedronData[#,"ConvexHullName"]===pname&],pname]

GraphicsGrid[Partition[Graphics3D[{
{Green,Opacity[.7],PolyhedronData[#,"Polyhedron"]},
{Blue,Opacity[.2],PolyhedronData[#,"ConvexHull","Polyhedron"]}},Boxed->False,PlotLabel->Style[PolyhedronData[#,"Name"],Directive[14,Black,Italic,FontFamily->"Times"]]]&/@hullof,UpTo[3]],Dividers->All,ImageSize->800]

DehnInvariant

PolyhedronData[pname,"DehnInvariant"]

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

ToConwayBasis[dehn]

Complement[Select[PolyhedronData[All],PolyhedronData[#,"DehnInvariant"]==dehn&&PolyhedronData[#,"Volume"]==vol&],{pname}]

DihedralAngles

(dih1=PolyhedronData[pname,"DihedralAngles"])//Tally

(dih2=SimplifyNumericallyDistinct[DihedralAngles[p]])//Tally

dih1===dih2

Dual

pname

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

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

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

Divide@@midrs//FullSimplify

N[%]

GraphicsRow[With[{
s={Yellow,PolyhedronData[pname,"Midsphere"]},
style=Directive[Black,Italic,FontFamily->"Times",14]
},
{
Graphics3D[{s,Green,Opacity[.5],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[.5],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[lens=SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p],"Simplification"->RootReduce]//FullSimplify]//Timing

PolyhedronData[pname,"EdgeLengths"]

PolyhedronData[pname,"Lines"]/.Line[l_]:>EuclideanDistance@@l//FullSimplify//Union//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[%]

Find rotation matrix

Graphics3D[{FaceForm[Green,Red],basesolid=PolyhedronData[hullname,"Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,basev=basesolid[[1]]]}]

rot=RotationMatrix[{Mean[basev[[{11,12}]]],{0,0,1}}]//FullSimplify

{Graphics3D[{Polyhedron[newv=rot.#&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ArcTan@@(Most@Mean[newv[[{7,29}]]])//FullSimplify

rot2=RotationMatrix[Pi/2+2Pi/5,{0,0,1}].rot//FullSimplify

{Graphics3D[{Polyhedron[(rot2.#)&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

HullOf

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===pname&]

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===hullname&]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

Insphere

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]

MyInsphere[p//N]

RootApproximant[1.1135163644116064`]//FullSimplify

(sphere=MyInsphere[p,Debug->True,"Simplification"->RootReduce])//Timing

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

sphere=Midsphere[p//N]

(sphere=Midsphere[p])//Timing

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

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

PolyhedronFaceTally[p]

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

Skeleton

PolyhedronData[pname,"Skeleton"]

gn=PolyhedronData[pname,"Skeleton","Name"]

GraphData[gn]

emb=GraphData[gn,"PolyhedralEmbeddings"]

l={{gn,{0,Union[emb,{pname}]}}}

PropertyReplace[l,"PolyhedralEmbeddings","14.0"]

pname

With[{verts=PolyhedronData[pname,"Vertices"],faces=PolyhedronData[pname,"Faces","List"]},
ToCommonEdges[GraphData[gn],Graph[Range[Length[verts]],UndirectedEdge@@@Union[Sort/@Flatten[Partition[#,2,1,1]&/@faces,1]]]]]//Chop[#,1*^-5]&//N

GraphData[gn,"Graph",{"3D","All"}]

g=PolyhedronGraph[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]

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

SurfaceArea[PolyhedronData[pname,"Region"]]

Uniform

PolyhedronData[pname,"Uniform"]

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

subsethulls=PolyhedronData[pname,"VertexSubsetHulls"]

v=PolyhedronData[pname,"Vertices"];

Rule[#,Length[#2]]&@@@subsethulls

Rule[#,Graphics3D[Function[f,ConvexHullRegion[v[[f]]]]/@#2]]&@@@subsethulls

subsethulls2=Flatten[Function[{pn,l},Rule[pn,#]&/@l]@@@subsethulls]

Rule[#,Graphics3D[{{Opacity[.3],{Green,p}},Blue,ConvexHullRegion[v[[#2]]]}]]&@@@subsethulls2

Convex hull

Graphics3D[convexhullreg=ConvexHullRegion[v=PolyhedronData[pname,"Vertices"]]]

v=PolyhedronCoordinates[convexhullreg]

Flatten[(convexhullreg[[2]]/.i_Integer:>v[[i]])/.Thread[PolyhedronData[pname,"Vertices"]->Range[PolyhedronData[pname,"V"]]]]//Union

%===Range@Length@v

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

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Construction

{"DodecahedronFiveCompound", 1}

dodec=PolyhedronData[{"Dodecahedron","C3"},"Polyhedron"]

θ=FullSimplify[ArcCos[Sqrt[2/15(5+Sqrt[5])]]]

Graphics3D[Table[Polyhedron[RotationMatrix[2Pi i/5,{0,0,1}].RotationMatrix[θ,{0,1,0}].#&/@dodec[[1]],dodec[[2]]],{i,0,4}]]

{"DodecahedronFiveCompound", 1} pieces

<<Platonic`;
<<DiscreteMath`Combinatorica`;
<<SolidGeometry`;

<<Simplify`

Off[$MaxExtraPrecision::"meprec"];

FaceIntersections[poly_]:=Module[{pairs=KSubsets[Take[#,3]&/@First/@poly,2]},
DeleteCases[Intersection3D@@@Map[Plane,pairs,{2}],{}]
]

Timing[f=FaceIntersections[Polyhedron[Dodecahedron5Compound]];]

Length[f]

1740 10./60.

Timing[lines=Map[ToExact,f,{3}];]

Length[lines]

Timing[points=Intersection3D@@@KSubsets[lines,2];]

Length[points]

Show[Graphics3D[{Polyhedron[Dodecahedron5Compound],{Red,lines},PointSize[.02],points}]]//Timing

> 0.75

Timing[p=First/@Union[Select[DeleteCases[points,{}],#[[1]].#[[1]]≤2.&]];]

Length[p]

Timing[p2=Select[p,#[[2]]<-.5&];]

Length[p2]

Show[Graphics3D[{Polyhedron[Dodecahedron5Compound],
PointSize[.02],
Point/@p2,
MapIndexed[Text[#2[[1]],#1+{0,0,.05},Background->White]&,p2]
}],Boxed->False,ViewPoint->{0,-2,0}]

p3={2659,1967,1516,2724,1963,2423,2063,1984,2065,2735,273,262,2066,2062};

Show[Graphics3D[{Polyhedron[Dodecahedron5Compound],
PointSize[.01],
Point/@(p2[[p3]]),
MapIndexed[Text[p3[[#2[[1]]]],p2[[#1]]+{0,0,.07},Background->White]&,p3]
}],Boxed->False,ViewPoint->{0,-2,0}]

Timing[n=Map[ToExact,p2[[p3]],{2}]]

Show[Graphics3D[{Polyhedron[Dodecahedron5Compound],
PointSize[.01],
Point/@n,
MapIndexed[Text[#2[[1]],#1+{0,0,.07},Background->White]&,n]
}],Boxed->False,ViewPoint->{0,-2,0}]

<<PolyhedronOperations`

Timing[poly1=Map[ToExact,PlanarPolygon[n[[{12,7,8,6,5,2,3,4,11}]]],{3}]]

poly1=Polygon[{{0,0},{(1/44) (9-5 (Sqrt[5])),-(Sqrt[(65/968)-((19 (Sqrt[5]))/968)])},{(1/20) (5-(Sqrt[5])),-(Sqrt[(1/8)-(1/(8 (Sqrt[5])))])},{(1/20) (5-(Sqrt[5])),-(Sqrt[(5/8)-(11/(8 (Sqrt[5])))])},{(1/2),-(Sqrt[(5/16)-((Sqrt[5])/8)])},{(1/20) (15+(Sqrt[5])),-(Sqrt[(5/8)-(11/(8 (Sqrt[5])))])},{(1/20) (15+(Sqrt[5])),-(Sqrt[(1/8)-(1/(8 (Sqrt[5])))])},{(5/44) (7+(Sqrt[5])),-(Sqrt[(65/968)-((19 (Sqrt[5]))/968)])},{1,0}}];

poly11=poly1/.Polygon[x_]:>ClosedLine[{#[[1]],-#[[2]]}&/@x];

α=-π+ArcTan[(1/44) (9-5 (Sqrt[5])),-(Sqrt[(65/968)-((19 (Sqrt[5]))/968)])];
poly21=poly2/.Polygon[x_]:>ClosedLine[{{Cos[α],Sin[α]},{-Sin[α],Cos[α]}}.({-(1/11) (4-(Sqrt[5])),0}+#)&/@x];

Timing[poly2=Map[ToExact,PlanarPolygon[n[[{4,13,14,11}]]],{3}]]

poly2=Polygon[{{0,0},{(1/176) (9-5 (Sqrt[5])),-(Sqrt[(5/128)+((Sqrt[5])/128)])},{(1/44) (7+(Sqrt[5])),-(Sqrt[(65/968)-((19 (Sqrt[5]))/968)])},{(1/11) (4-(Sqrt[5])),0}}];

Show[Graphics[poly2/.Polygon:>ClosedLine],AspectRatio->Automatic]

Show[Graphics[piece1={
poly1/.Polygon[x_]:>ClosedLine[x],
poly11,
poly21,
poly21/.Line[x_]:>Line[{1-#[[1]],#[[2]]}&/@x]
}],AspectRatio->Automatic]

Show[Graphics[{
poly1/.Polygon[x_]:>ClosedLine[{#[[1]],-#[[2]]}&/@x]}
],AspectRatio->Automatic]

Timing[poly3=Map[ToExact,PlanarPolygon[n[[{8,1,6}]]],{3}]]

poly3=Polygon[{{0,0},{-(Sqrt[(1/4)-(1/(2 (Sqrt[5])))]),(1/(Sqrt[5]))},{(Sqrt[(1/4)-(1/(2 (Sqrt[5])))]),0}}];

Show[Graphics[{
poly3/.Polygon:>ClosedLine,
MapIndexed[Text[#2[[1]],#1+{0,.01},Background->White]&,poly3[[1]]]
}],AspectRatio->Automatic]

poly3[[1,2]]-poly3[[1,3]]

poly3[[1,1]]//N

ToExact[dist[poly3[[1,2]],poly3[[1,3]]]]

ToExact[dist[poly3[[1,1]],poly3[[1,3]]]]

ToExact[(1/5) (5-(Sqrt[5]))-(Sqrt[(1/4)-(1/(2 (Sqrt[5])))])]

Timing[poly4=Map[ToExact,PlanarPolygon[n[[{5,1,6}]]],{3}]]

poly4=Polygon[{{0,0},{-(3/(4 (Sqrt[11 (9+4 (Sqrt[5]))]))),-(Sqrt[(5/22)-((Sqrt[5])/22)])},{((Sqrt[(11/5)])/4),0}}];

ToExact[dist[poly4[[1,2]],poly4[[1,3]]]]

(1/5) (5-(Sqrt[5]))-(Sqrt[(1/4)-(1/(2 (Sqrt[5])))])

poly4[[1,3]]

Show[Graphics[{
poly4/.Polygon:>ClosedLine,
MapIndexed[Text[#2[[1]],#1+{0,.01},Background->White]&,poly4[[1]]]
}],AspectRatio->Automatic]

ToExact/@(poly4[[1,3]]-poly4[[1,1]])

(Sqrt[(1/4)-(1/(2 (Sqrt[5])))])-(1/5) (5-(Sqrt[5]))

α=ArcTan@@(poly4[[1,3]]-poly4[[1,2]])+(Pi-ArcTan@@(poly3[[1,2]]-poly3[[1,3]]));
Show[Graphics[piece2={
poly3/.Polygon[x_]:>ClosedLine[{-(Sqrt[(1/4)-(1/(2 (Sqrt[5])))]),0}+#&/@x],
poly4/.Polygon[x_]:>ClosedLine[{{Cos[α],Sin[α]},{-Sin[α],Cos[α]}}.({-((Sqrt[(11/5)])/4),0}+#)&/@x]
}],AspectRatio->Automatic]

Show[Graphics[net={piece1,
piece2/.Line[x_]:>Line[{2-1/4,-1/4}+#&/@x],
piece2/.Line[x_]:>Line[{2,-1/4}+{{-1,0},{0,1}}.#&/@x]
}],AspectRatio->Automatic]

net2=Map[ToExact,Flatten[net],{3}];

v=Union[Flatten[First/@net2,1]];

Drop[First[#],-1]&/@net2/.Thread[v->Range[Length[v]]]

v//InputForm

<<Platonic`

Show[Graphics[Net[Dodecahedron5Compound]],AspectRatio->Automatic]

Show[Graphics[NetDiagram[Dodecahedron5Compound]],AspectRatio->Automatic]

<<Simplify`

s=SqrtSimplify/@ToExact/@NetEdgeLengths[Dodecahedron5Compound]

sides=Together//@FullSimplify/@Sort[Union[s],Less]

sides//N

lengths=Sort[Transpose[{s/.Thread[sides->Range[Length[sides]]],NetEdges[Dodecahedron5Compound]}]]

NetSurfaceArea[Dodecahedron5Compound]//FullSimplify

N[%]

{"DodecahedronFiveCompound", 2} as rotation about C3

dodec=PolyhedronData[{"Dodecahedron","C3"},"Polyhedron"]

Graphics3D[{dodecs=Table[Polyhedron[RotationMatrix[2Pi i/5,{0,0,1}].#&/@dodec[[1]],dodec[[2]]],{i,0,4}]}]

v0=RootReduce@Flatten[dodecs[[All,1]],1];

v=DeleteDuplicates@v0;

PolyhedronData["Dodecahedron","V"]

f=Flatten[Table[20(i-1)+dodecs[[i,2]],{i,5}],1]/.i_Integer:>v0[[i]]/.Thread[v->Range[Length[v]]]

Length[v]

5PolyhedronData["Dodecahedron","V"]-2 4

Graphics3D[{Point[v],Opacity[.2],compound=Polyhedron[v,f]}]

{"DodecahedronFiveCompound", 3} as rotation about C2

dodec=PolyhedronData[{"Dodecahedron","C2"},"Polyhedron"]

Graphics3D[{dodecs=Table[Polyhedron[RotationMatrix[2Pi i/5,{0,0,1}].#&/@dodec[[1]],dodec[[2]]],{i,0,4}]}]

v0=RootReduce@Flatten[dodecs[[All,1]],1];

v=DeleteDuplicates@v0;

PolyhedronData["Dodecahedron","V"]

f=Flatten[Table[20(i-1)+dodecs[[i,2]],{i,5}],1]/.i_Integer:>v0[[i]]/.Thread[v->Range[Length[v]]]

Length[v]

5PolyhedronData["Dodecahedron","V"]-2 4

Graphics3D[{Point[v],Opacity[.2],compound=Polyhedron[v,f]}]

PolyhedronData

<<MathWorld`Polyhedra`

PolyhedronDataString

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

WriteString[file,With[
{
base="Dodecahedron",
n=5,
facecnt=PolyhedronFaceCount[compound],
ind=3
},
PolyhedronDataString[compound,
"StandardName"->{base<>StringJoin@@(Capitalize/@StringSplit[IntegerName[n],"\[Hyphen]"])<>"Compound",ind},
"AlternateStandardNames"->{},
"Name"->IntegerName[ind,"Ordinal"]<>" "<>ToLowerCase[base]<>" "<>ToString[n]<>"\[Hyphen]compound",
"Information"->base<>ToString[n]<>"-Compound",
"PolyhedronIndices"->"Partition[Range["<>ToString[facecnt]<>"], "<>ToString[facecnt/n]<>"]",
"Classes"->{"Compound"},
TimeConstraint->10
]]]

Close[file]