Small Ditrigonal Icosidodecahedron

Author

Eric W. Weisstein
October 5, 2023

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

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

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

Hull variants

variants={"SmallDitrigonalIcosidodecahedron","SmallDitrigonalIcosidodecahedronHull"};

PolyhedronData/@variants

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

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

Polyhedron: "SmallDitrigonalIcosidodecahedron"

PolyhedronData[stdname="SmallDitrigonalIcosidodecahedron","Orientations"]

PolyhedronData[stdname]

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

Polyhedron

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

Region

PolyhedronData[stdname,"Region"]

Solid and Dual

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

UniformPolyhedron

uniform=UniformPolyhedron[stdname="SmallDitrigonalIcosidodecahedron"]

PolyhedronFaceTally[uniform]

indices=UniformPolyhedronIndex[stdname]

UniformPolyhedron/@{
stdname,
Lookup[indices,"Wenninger"],
Sequence@@(List@@@Normal[indices]/."Maeder"->"Uniform")
}

SameQ@@%

Graphics3D/@(polys=Polygon[uniform[[1]],#]&/@uniform[[2]])

Graphics3D[#,Boxed->False]&/@{uniform,polys}

Bulatov

BulatovUniformName[UniformPolyhedronIndex[stdname,"Kaleido"]]

BulatovUniformGraphics3D[UniformPolyhedronIndex[stdname,"Kaleido"],Boxed->False]

bulatov=BulatovUniformPolyhedron[UniformPolyhedronIndex[stdname,"Kaleido"]]

Graphics3D/@(polys=Polygon[bulatov[[1]],#]&/@bulatov[[2]])

PolyhedronFaceTally[bulatov]

Graphics3D[#,Boxed->False]&/@{bulatov,polys}

Maeder

MaederUniformName[UniformPolyhedronIndex[stdname,"Maeder"]]

wythoff=MaederWythoffSymbol[UniformPolyhedronIndex[stdname,"Maeder"]]

With[{n=UniformPolyhedronIndex[stdname,"Maeder"]},Import["https://www.mathconsult.ch/static/unipoly/"<>If[n<10,"0",""]<>ToString[n]<>".html","Images"]][[1]]

maeder=MaederUniformPolyhedron[UniformPolyhedronIndex[stdname,"Maeder"]]

Graphics3D/@(polys=Polygon[maeder[[1]],#]&/@maeder[[2]])

PolyhedronFaceTally[maeder]

Graphics3D[#,Boxed->False]&/@{maeder,polys}

Polyhedron: "SmallDitrigonalIcosidodecahedronHull"

PolyhedronData[stdname="SmallDitrigonalIcosidodecahedronHull","Orientations"]

PolyhedronData[stdname]

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

Polyhedron

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

bug(440667): Polyhedron fails to render all faces

Region

PolyhedronData[stdname,"Region"]

Solid and Dual

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

Properties: "SmallDitrigonalIcosidodecahedron"

Initialization

<<MathWorld`Polyhedra`

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

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

sphere=Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Graphics3D[{{Opacity[.3],Green,sphere},Blue,p},Boxed->False]

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

Concave

PolyhedronData[pname,"Concave"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]

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[convexhull=ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]

v=PolyhedronCoordinates[convexhull]

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

Find scale

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhull]]//Tally//FullSimplify

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

FullSimplify[%-1/GoldenRatio]

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

DehnInvariant

PolyhedronData[pname,"DehnInvariant"]

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

ToConwayBasis[dehn]

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

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->TextCell[Style[PolyhedronData[dname,"Name"],style],PageWidth->200,TextAlignment->Center]],
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[PolyhedronEdgeLengths[p]]

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

FaceCountRules

PolyhedronData[pname,"FaceCountRules"]

PolyhedronFaceTally[p]

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

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

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

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

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

Graphics3D/@PolyhedronData[pname,"Polygons"]

Show[%]

Graphics3D[{EdgeForm[None],WindingPolygon[p[[1]][[#]],"NonzeroRule"]&/@p[[2]]},Boxed->False]

Graphics3D[{EdgeForm[None],WindingPolygon[p[[1]][[#]],"NonzeroRule"]&/@p[[2]]},Boxed->False,Method->{"RelieveDPZFighting"->False}]

Polyhedra

PolyhedronData[pname,"Polyhedra"]

Graphics3D[%]

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

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

g=PolyhedronGraph[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]

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

SurfaceArea[PolyhedronData[pname,"Region"]]

Uniform

PolyhedronData[pname,"Uniform"]

With[{rules=PolyhedronData[pname,"NotationRules"]},{
UniformPolyhedron[Lookup[rules,"WenningerIndex"]],
UniformPolyhedron[{"Coxeter",Lookup[rules,"CoxeterIndex"]}],
UniformPolyhedron[{"Kaleido",Lookup[rules,"KaleidoIndex"]}],
UniformPolyhedron[{"Uniform",Lookup[rules,"MaederIndex"]}],
UniformPolyhedron[{"Wenninger",Lookup[rules,"WenningerIndex"]}]
}]

SameQ@@%

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

Volume[p]

PolyhedronVolume[p]

Volume[PolyhedronData[pname,"Region"]]

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Properties: "SmallDitrigonalIcosidodecahedronHull"

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

AdjacentFaceIndices

adj1=PolyhedronData[pname,"AdjacentFaceIndices"]

adj2=AdjacentFaceIndices[p]

adj1===adj2

Centroid

PolyhedronData[pname,"Centroid"]

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

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p]//FullSimplify//Quiet

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

MyCircumsphere[N[p,50]]

(sphere=MyCircumsphere[p])//Timing

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

Concave

PolyhedronData[pname,"Concave"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]//Timing

ConvexHull

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

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

N[%]

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

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

Counts[SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhull]]]

Keys[%]//N

{
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//ToRadicals

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

{Graphics3D[{Polyhedron[(rot.#)&/@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]

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

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

{Graphics3D[{Opacity[.5],Red,p}],Graphics3D[{Opacity[.5],Blue,PolyhedronData[pname,"Hull"][[1]]}]}

Show[%]

HullOf

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

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

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

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

PolyhedronInertiaTensor[p]//Timing

Insphere

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]

MyInsphere[N[p,50]]

sphere=MyInsphere[p]

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

((NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/vol)

ClosestMeanCylindricalRadius[%]

Integrate over polyhedron

(rxy=((Integrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/vol)//FullSimplify)//Timing

N[rxy]

Divergence theorem [unevaluated integral]

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

N[rxy]

LogSimplify[rxy]//FullSimplify

CAD

cad=CylindricalDecomposition[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z},"Function"]

((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxy=((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

CAD over  1/10

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&0<y<Tan[Pi/5]x]

((Volume[ImplicitRegion[reg,{x,y,z}]])/vol)

cad=CylindricalDecomposition[reg,{x,y,z},"Function"]

10((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxy=10((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxy]

LogSimplify[rxy]//FullSimplify

Boole Integrate doing z integral first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}==CoordinateBounds[p]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)]),{z,zmin,zmax}])//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}])//Timing

MeanInteriorLineSegmentLength

PolyhedronData[pname,"MeanInteriorLineSegmentLength"]

GlobalAdaptive numerical integration

ineq=PolyhedronData[pname,"RegionFunction"]

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=RegionBounds[ImplicitRegion[ineq[x,y,z],{x,y,z}]]

(1/(vol^2)) NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax}]

(1/(vol^2)) NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax},
Method->{"GlobalAdaptive","MaxErrorIncreases"->1*^4}]//Timing

Integration

ineq=PolyhedronData[pname,"RegionFunction"]

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=RegionBounds[ImplicitRegion[ineq[x,y,z],{x,y,z}]]

cad=CylindricalDecomposition[ineq[x1,y1,z1]&&ineq[x2,y2,z2],{x1,y1,z1,x2,y2,z2},"Function"]

(1/(vol^2)) Integrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[cad],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax}]

Monte Carlo

reg=PolyhedronData[pname,"Region"]

Length[lines=Partition[RandomPoint[N@reg,10^7],2]]//Timing

Graphics3D[{{Opacity[.2],EdgeForm[],BoundaryDiscretizeRegion[reg]},Red,Line/@Take[lines,UpTo@1000]},AspectRatio->Automatic]

lengths=Norm/@Subtract@@@lines;//Timing

Histogram[lengths,{.01}]

Mean[lengths]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/vol)

ClosestMeanSphericalRadius[%]

Integrate over polyhedron

(rxyz=((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/vol))//Timing

N[rxyz]

Divergence theorem

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

N[rxyz]

LogSimplify[rxyz]//FullSimplify

CAD

cad=CylindricalDecomposition[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z},"Function"]

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxyz=((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxyz,20]

rxysimp1=ResourceFunction["LogSimplify"][rxy]//FullSimplify

CAD over  1/10

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&0<y<Tan[Pi/5]x]

((Volume[ImplicitRegion[reg,{x,y,z}]])/vol)

cad=CylindricalDecomposition[reg,{x,y,z},"Function"]

10((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxyz=10((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxyz,20]

rxysimp1=LogSimplify[rxy]//FullSimplify

Boole Integrate doing z integral first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=CoordinateBounds[p]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)+(z^2)]),{z,zmin,zmax}])//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}])//Timing

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

N[%]

((NIntegrate[(x^2)+(y^2),{x,y,z}∈p])/vol)

Integrate over Polyhedron

(rxy2=((Integrate[(x^2)+(y^2),{x,y,z}∈p])/vol)//FullSimplify)

N[rxy2]

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

((NIntegrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/vol)

Integrate over polyhedron

(rxy2=((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/vol)//FullSimplify)

N[rxy2]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

Midsphere[N[p,50]]

(sphere=Midsphere[p])//Timing

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

Net

PolyhedronData[pname,"Net"]

NotationRules

PolyhedronData[pname,"NotationRules"]

Orientations

PolyhedronData[pname,"Orientations"]

PolyhedronData[pname,"DefaultOrientation"]

Polygons

PolyhedronData[pname,"FaceCount"]

PolyhedronFaceTally[p]

Graphics3D/@PolyhedronData[pname,"Polygons"]

Show[%]

Polyhedra

polyhedra=PolyhedronData[pname,"Polyhedra"]

Length[polyhedra]

bug(440667): Polyhedron fails to render all faces

Graphics3D[polyhedra]

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

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

{RegionPlot3D[ImplicitRegion[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]],
Graphics3D[p]}

Collect[#,{x,y,z},RootReduce]&/@PolyhedronInequalities[p,{x,y,z}]

ineq=FullSimplify[%]

ineq/.{x->#,y->#2,z->#3}

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

SimplePolyhedron

PolyhedronData[pname,"Simple"]

SimplePolyhedronQ[p]//Timing

Skeleton

PolyhedronData[pname,"Skeleton"]

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

g=PolyhedronGraph[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]//FullSimplify

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

SurfaceArea[PolyhedronData[pname,"Region"]]//FullSimplify

Uniform

PolyhedronData[pname,"Uniform"]

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

pname

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

Volume[p]//FullSimplify

PolyhedronVolume[p]//FullSimplify

Volume[PolyhedronData[pname,"Region"]]//FullSimplify

Volume[ImplicitRegion[Evaluate@PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]]//FullSimplify

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Construction

"SmallDitrigonalIcosidodecahedron"

v=((bulatov[[1]])/(Mean[PolyhedronEdgeLengths[bulatov]]))

vexact=Map[RootApproximant,Chop[v],{2}]

orientations=With[{tri=vexact[[Take[#,3]]]},If[RegionDistance[InfinitePlane[tri],{0,0,0}]==0.,"Origin",!PositivelyOrientedPoints[Append[tri,{0,0,0}]]]]&/@bulatov[[2]]

orientedfaces=Sort/@Prepend[Function[flip,Switch[#,
False,Reverse[#2],
True,#2,
_,flip@#2]&@@@Transpose[{orientations,bulatov[[2]]}]]/@If[FreeQ[orientations,"Origin"],{Identity},{Identity,Reverse}],bulatov[[2]]]

Graphics3D[{FaceForm[Green,Red],Polyhedron[vexact,#]}]&/@orientedfaces

p=Polyhedron[vexact,orientedfaces[[2]]]

"SmallDitrigonalIcosidodecahedronHull"

<<MathWorld`Polyhedra`

pentagrams=Select[PolyhedronData["SmallDitrigonalIcosidodecahedron","Polygons"],Length[#[[1]]]==5&]

Graphics3D[{FaceForm[Green,Red],filledstars=FilledPolygram/@pentagrams}]

Length[filledstars]

Length/@filledstars[[All,1]]

starv=RootReduce[filledstars[[All,1]]];

v=DeleteDuplicates[Flatten[starv,1]]

f=starv/.Thread[v->Range@Length@v]

Length[f]

Graphics3D[Polygon[v,#],ImageSize->Tiny]&/@f

bug(440667): Polyhedron fails to render all faces

Graphics3D[#,Boxed->False,ImageSize->Medium]&/@{Polygon[v,#]&/@f,Polyhedron[v,f]}

Graphics3D[{FaceForm[Green,Red],Polygon[v,#]&/@f,MapIndexed[Text[#2[[1]],#,Background->White]&,v]},Boxed->False]

edges=Flatten[Partition[#,2,1,1]&/@f,1];

neighboringstars=Select[Subsets[f,{2}],Intersection@@#=!={}&];

SquaredEuclideanDistance@@v[[{28,39}]]//FullSimplify

{tips=Intersection@@#}&/@neighboringstars

Graphics3D[{FaceForm[Green,Red],Polygon[v,#]&/@(allf=Sort@Join[f,{{30,29,34},{30,34,1},{27,46,28},{46,29,28},{40,69,41},{40,27,69},{42,41,79},{79,43,42},{63,80,68},{80,41,68},{43,73,44},{73,36,44},{78,74,43},{78,56,74},{45,35,29},{45,36,35},{77,58,57},{57,56,77},{56,55,75},{55,50,75},{50,54,51},{54,11,51},{53,13,12},{12,11,53},{61,59,58},{61,13,59},{60,15,14},{60,14,13},{76,63,62},{62,58,76},{67,64,63},{67,19,64},{15,65,25},{25,65,19},{16,15,24},{24,7,16},{52,11,18},{18,5,52},{50,49,71},{49,38,71},{37,72,38},{37,36,72},{70,27,26},{21,70,26},{19,66,20},{20,66,21},{6,5,17},{17,7,6},{47,4,3},{47,5,4},{38,48,39},{48,3,39},{33,3,2},{2,1,33},{1,10,31},{31,10,9},{32,9,22},{21,32,22},{9,8,23},{8,7,23}}]),MapIndexed[Text[#2[[1]],#,Background->White]&,v]},Boxed->False]

allf

Graphics3D[p=Polyhedron[v,allf]]

PolyhedronData

PolyhedronDataString

<<MathWorld`Polyhedra`

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

wythoff=MaederWythoffSymbol[maederindex=UniformPolyhedronIndex[stdname,"Maeder"]]

WriteString[file,PolyhedronDataString[p,
"StandardName"->stdname,
"AlternateStandardNames"->{"U"<>ToString[maederindex],{"Uniform",maederindex}},
"Name"->StringTrim[StringReplace[stdname,RegularExpression["([A-Z])"]:>" "<>ToLowerCase["$1"]]],
"Information"->stdname,
"WythoffSymbol"->wythoff/.{w2[p_,q_,r_]:>{{p,q},{r}},w3[p_,q_,r_]:>{{p,q,r}}},
"Classes"->{"Uniform"},
"NotationRules"->(Normal[UniformPolyhedronIndex[stdname]]/.s_String:>s<>"Index")
]]

WriteString[file,PolyhedronDataString[p,
"StandardName"->"SmallDitrigonalIcosidodecahedronHull",
"Name"->"small ditrigonal icosidodecahedron hull",
"Information"->"SmallDitrigonalIcosidodecahedron"
]]

Close[file]