Dodecahedron Stellations

Author

Eric W. Weisstein
November 15, 2024

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

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

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

List

TextGrid[
stellations=Cases[
{#,PolyhedronData[#,"NotationRules","Stellation"]}&/@PolyhedronData[All],
{_,{"Dodecahedron",_}}],
Dividers->All]

GraphicsRow[Graphics3D[{Opacity[.8],PolyhedronData[#,"Polyhedron"]},PlotLabel->PolyhedronData[#,"Name"],Boxed->False]&/@stellations[[All,1]],BaseStyle->InsetBoxOptions->{BaseStyle->Directive[FontFamily->"Times",Black,15,Italic]}]

Diagram

pname="Dodecahedron";

Construction

Graphics3D[{PolyhedronData[pname,"Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,PolyhedronData[pname,"Vertices"]]}]

zmax=PolyhedronData[pname,"VertexCoordinates"][[All,-1]]//Max

N[%]

pos=Position[And@@@Map[#==zmax&,PolyhedronData[pname,"Faces","Coordinates"][[All,All,-1]],{2}],True][[1,1]]

Length[faces=Take[#,3]&/@PolyhedronData[pname,"Polygons"][[All,1]]]

Graphics3D[
{
{Opacity[.7],PolyhedronData[pname,"Polyhedron"]},
DiscretizeRegion[RegionIntersection[Sphere[{0,0,0},6],N@InfinitePlane[#]],MeshCellStyle->0->None]&/@faces
},
Boxed->False]

Length[lines3D=
DeleteCases[
With[{planeindx=pos},
RegionIntersection[InfinitePlane[faces[[planeindx]]],InfinitePlane[#]]&/@Drop[faces,{planeindx}]],
_EmptyRegion
]//RootReduce//FullSimplify]//Timing

Graphics3D[{Red,#},PlotRange->2]&/@lines3D

Show[%]

Graphics3D[{Black,AbsoluteThickness[2],lines3D}]

Binomial[Length@lines3D,2]

indx=Subsets[Range@Length@lines3D,{2}];
Length[intersections3D=Cases[{#,FullSimplify@RootReduce[RegionIntersection@@lines3D[[#]]]}&/@indx,{i_,Point[p_]}:>{i,p}]]//Timing

Length[pts3D=intersections3D[[All,2]]//Union]

radius=Max[Norm[Most[#]]&/@pts3D]//FullSimplify//Quiet

N[%]

Equal@@(#[[-1]]&/@pts3D)

indexedintersections=intersections3D/.Thread[pts3D->Range[Length[pts3D]]]

clines=Table[Union@Select[indexedintersections,MemberQ[#[[1]],i]&][[All,-1]],{i,Length[lines3D]}]

longestlines=OrderedPointsOnLineSegment[pts3D,#]&/@clines

g1=Graphics3D[{{Opacity[.8],PolyhedronData[pname,"Polyhedron"]},AbsoluteThickness[.1]},Boxed->False,ViewPoint->{0,0,2},ViewVertical->{1,0,0}]

g2=Graphics3D[{Disk3DGraphics@@regionIntersection[Ball[{0,0,0},9],N[InfinitePlane[#],20]]&/@faces},Boxed->False,ViewPoint->{0,0,2},ViewVertical->{1,0,0}]

g3=Graphics3D[{Opacity[.2],Disk3DGraphics@@regionIntersection[Ball[{0,0,0},9],N[InfinitePlane[#],20]]&/@faces},Boxed->False,ViewPoint->{0,0,2},ViewVertical->{1,0,0}]

g4=Graphics3D[
{{Opacity[.1],EdgeForm[Dashed],Disk3DGraphics@@regionIntersection[Ball[{0,0,0},9],N[InfinitePlane[#],20]]&/@faces},{Black,AbsoluteThickness[2],lines3D}},Boxed->False,ViewPoint->{0,0,2},ViewVertical->{1,0,0}]

g5=Graphics3D[
{{Opacity[.2],Disk3DGraphics[##,500]&@@regionIntersection[Ball[{0,0,0},9],N[InfinitePlane[#],20]]&/@Delete[faces,{pos}]}/.Polygon[x_]:>Polygon[DeleteCases[x,{_,_,_?(GreaterThan[zmax])}]],
{Black,AbsoluteThickness[2],Line[pts3D[[#]]]&/@longestlines}},Boxed->False,ViewPoint->{0,0,2},ViewVertical->{1,0,0}]

g6=Graphics3D[linesgr={Black,AbsoluteThickness[2],Line[pts3D[[#]]]&/@longestlines[[All,{-1,1}]]},ViewPoint->{0,0,2.7},ViewVertical->{1,0,0},Boxed->False]

GraphicsGrid[Partition[{g1,g2,g3,g4,g5,g6},UpTo[3]],ImageSize->800]

Figure

GraphicsGrid[Partition[StellationFigure[PolyhedronData["Dodecahedron","Polyhedron"]],UpTo[3]]]//Quiet

Labels

Graphics3D[{
Thickness[.005],lines3D,
{Darker@Green,MapIndexed[Text[#2[[1]],Mean[pts3D[[#[[{1,-1}]]]]],Background->White]&,longestlines]},
{Red,Sphere[pts3D,.15 #/2.5]}
},
PlotRange->#,ImageSize->Medium,ViewPoint->{0,0,2}
]&/@{2.5,6}

v=RotationMatrix[Pi/2].#&/@(Most/@pts3D);

Max[Norm/@v]//FullSimplify//Quiet

N[%]

Clear[text]

text[text_,indx_,style___]:=Module[{p=Mean[v[[indx]]]},
Style[If[p=={0.,0.},Text[text,p],Table[Text[text,RotationMatrix[2Pi i/5].p],{i,0,4}]],Directive[style]]]

Graphics[
{
Line[v[[#]]]&/@longestlines[[All,{-1,1}]],
{Darker@Green,MapIndexed[Text[#2[[1]],Mean[v[[#]]],Background->White]&,longestlines]},
{Red,PointSize[.015],Point[v]},
Blue,MapIndexed[Text[#2[[1]],#,{0,-1.3},Background->White]&,v]
},BaseStyle->Directive[FontFamily->"Times",16,Bold]]

Graphics[
{
Line[v[[#]]]&/@longestlines[[All,{-1,1}]],
{Red,PointSize[.015],Point[v]},
text[0,{1,2,9,14,15}],
text[1,{12,15,9}],
text[2,{12,11,9}],
text[3,{3,5,6}]
},
BaseStyle->Directive[FontFamily->"Times",16,Bold]]

Properties: {"DodecahedronStellation", 1}

<<MathWorld`PolyhedronOperations`

p=PolyhedronData[pname={"DodecahedronStellation",1},"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//Quiet//Timing

PolyhedronCentroid[p]

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

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[p]

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

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

N[i]

r=RootApproximant[N[i,1000],32]//FullSimplify

N[i-r,10^4]

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

N[i]

r=RootApproximant[N[i,1000],32]//FullSimplify

N[i-r,10^4]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

(sphere=Midsphere[p])//Timing

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

SimplePolyhedron

SimplePolyhedronQ[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]//FullSimplify//Timing

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

VertexSubsetHulls

PolyhedronData[pname,"VertexSubsetHulls"]

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify//Timing

PolyhedronVolume[p]//FullSimplify//Timing

Properties: {"DodecahedronStellation", 2}

<<MathWorld`PolyhedronOperations`

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

Centroid

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

PolyhedronData[pname,"Centroid"]

(xbar=RegionCentroid[p])//Quiet//Timing

Map[RootApproximant[N[#,1000],8]&,xbar,{2}]//Quiet

N[%-xbar,10^4]//Quiet

PolyhedronCentroid[p]

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

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[p]

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

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

N[i]

r=RootApproximant[N[i,1000],32]//FullSimplify

N[i-r,10^4]

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

N[i]

r=RootApproximant[N[i,1000],32]//FullSimplify

N[i-r,10^4]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

(sphere=Midsphere[p])//Timing

SimplePolyhedron

SimplePolyhedronQ[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

RootReduce[%]

SurfaceArea[p]//RootReduce//FullSimplify//Timing

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

VertexSubsetHulls

PolyhedronData[pname,"VertexSubsetHulls"]

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p]//FullSimplify

Properties: {"DodecahedronStellation", 3}

<<MathWorld`PolyhedronOperations`

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

Centroid

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

PolyhedronData[pname,"Centroid"]

(xbar=RegionCentroid[p]//FullSimplify)//Timing

PolyhedronCentroid[p]

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

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

PolyhedronInertiaTensor[p]//Timing

Insphere

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[p]

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

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

N[i]

r=RootApproximant[N[i,1000],32]//FullSimplify

N[i-r,10^4]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

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

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

SimplePolyhedron

SimplePolyhedronQ[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]//RootReduce//FullSimplify//Timing

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

VertexSubsetHulls

PolyhedronData[pname,"VertexSubsetHulls"]

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p]//FullSimplify