Small Triambic Icosahedron

Author

Eric W. Weisstein
September 17, 2023

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

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

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

Polyhedron

Variants

Graphics3D[PolyhedronData[#,"Polyhedron"],Boxed->False]&/@{"SmallTriambicIcosahedron","SmallTriambicIcosahedronHull"}

Properties: "SmallTriambicIcosahedron"

Initialization

<<MathWorld`Polyhedra`

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

AlternateStandardNames

PolyhedronData[pname,"AlternateStandardNames"]

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

Concave

PolyhedronData[pname,"Concave"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]

ConvexHull

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

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

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

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

PolyhedronEdgeLengths[convexhull]//RootReduce//Tally

((Max[Norm/@convexhull[[1]]])/(Max[Norm/@PolyhedronData[PolyhedronData[pname,"ConvexHull","Name"],"Polyhedron"][[1]]]))//FullSimplify//Quiet

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

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

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

dih1-dih2//N

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

PolyhedronData[pname,"EdgeLengths"]

Tally[lens=SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p],"Simplification"->RootReduce]//FullSimplify]//Timing

SimplifyNumericallyDistinct[PolyhedronData[pname,"Lines"]/.Line[l_]:>EuclideanDistance@@l,"Simplification"->RootReduce]//FullSimplify//Tally//Timing

(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//Quiet

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

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

Show[%]

Find rotation matrix

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

v[[9]]

rot=Map[ToAlgebraicRoot,RotationMatrix[{Mean[basev[[{2,3}]]],{0,0,1}}],{2}]

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

newv[[{12,16}]]//N

ArcTan@@(Most@newv[[12]])//FullSimplify

rot2=RotationMatrix[-Pi/10,{0,0,1}]//FullSimplify

rot2.rot//FullSimplify

RotationMatrix[Pi/2,{0,0,1}].{{(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))]),(1/4) (-1+(Sqrt[5])),0},{(NumericalApproximation[Root, (RowDefault["-0.263", FEExpressionsNumericalApproximationElider]), Root[1-20 ((#1)^2)+80 ((#1)^4)&,2], ]),(1/4) (1+(Sqrt[5])),(NumericalApproximation[Root, (RowDefault["0.526", FEExpressionsNumericalApproximationElider]), Root[1-5 ((#1)^2)+5 ((#1)^4)&,3], ])},{(1/2) (Sqrt[1-(2/(Sqrt[5]))]),-(1/2),(Sqrt[(1/10) (5+(Sqrt[5]))])}}//FullSimplify

newv2=Map[ToAlgebraicRoot,rot2.#&/@newv,{2}]

{{0,-((Sqrt[(5/2)])/2),(NumericalApproximation[Root, (RowDefault["-1.28", FEExpressionsNumericalApproximationElider]), Root[25-120 ((#1)^2)+64 ((#1)^4)&,1], ])},{0,((Sqrt[(5/2)])/2),(NumericalApproximation[Root, (RowDefault["1.28", FEExpressionsNumericalApproximationElider]), Root[25-120 ((#1)^2)+64 ((#1)^4)&,4], ])},{0,-((Sqrt[(5/2)])/2),(NumericalApproximation[Root, (RowDefault["1.28", FEExpressionsNumericalApproximationElider]), Root[25-120 ((#1)^2)+64 ((#1)^4)&,4], ])},{((Sqrt[(5/2)])/2),(NumericalApproximation[Root, (RowDefault["1.28", FEExpressionsNumericalApproximationElider]), Root[25-120 ((#1)^2)+64 ((#1)^4)&,4], ]),0},{((Sqrt[(5/2)])/2),(NumericalApproximation[Root, (RowDefault["-1.28", FEExpressionsNumericalApproximationElider]), Root[25-120 ((#1)^2)+64 ((#1)^4)&,1], ]),0},{(NumericalApproximation[Root, (RowDefault["1.28", FEExpressionsNumericalApproximationElider]), Root[25-120 ((#1)^2)+64 ((#1)^4)&,4], ]),0,-((Sqrt[(5/2)])/2)},{(NumericalApproximation[Root, (RowDefault["1.50", FEExpressionsNumericalApproximationElider]), Root[1-144 ((#1)^2)+64 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["-0.572", FEExpressionsNumericalApproximationElider]), Root[1-24 ((#1)^2)+64 ((#1)^4)&,1], ]),0},{(NumericalApproximation[Root, (RowDefault["-1.28", FEExpressionsNumericalApproximationElider]), Root[25-120 ((#1)^2)+64 ((#1)^4)&,1], ]),0,((Sqrt[(5/2)])/2)},{-((Sqrt[(5/2)])/2),(NumericalApproximation[Root, (RowDefault["1.28", FEExpressionsNumericalApproximationElider]), Root[25-120 ((#1)^2)+64 ((#1)^4)&,4], ]),0},{(NumericalApproximation[Root, (RowDefault["-0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,1], ]),(NumericalApproximation[Root, (RowDefault["-0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,1], ]),(NumericalApproximation[Root, (RowDefault["-0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,1], ])},{(NumericalApproximation[Root, (RowDefault["-0.572", FEExpressionsNumericalApproximationElider]), Root[1-24 ((#1)^2)+64 ((#1)^4)&,1], ]),0,(NumericalApproximation[Root, (RowDefault["-1.50", FEExpressionsNumericalApproximationElider]), Root[1-144 ((#1)^2)+64 ((#1)^4)&,1], ])},{(NumericalApproximation[Root, (RowDefault["0.572", FEExpressionsNumericalApproximationElider]), Root[1-24 ((#1)^2)+64 ((#1)^4)&,4], ]),0,(NumericalApproximation[Root, (RowDefault["1.50", FEExpressionsNumericalApproximationElider]), Root[1-144 ((#1)^2)+64 ((#1)^4)&,4], ])},{(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,4], ])},{0,(NumericalApproximation[Root, (RowDefault["-1.50", FEExpressionsNumericalApproximationElider]), Root[1-144 ((#1)^2)+64 ((#1)^4)&,1], ]),(NumericalApproximation[Root, (RowDefault["-0.572", FEExpressionsNumericalApproximationElider]), Root[1-24 ((#1)^2)+64 ((#1)^4)&,1], ])},{(NumericalApproximation[Root, (RowDefault["0.572", FEExpressionsNumericalApproximationElider]), Root[1-24 ((#1)^2)+64 ((#1)^4)&,4], ]),0,(NumericalApproximation[Root, (RowDefault["-1.50", FEExpressionsNumericalApproximationElider]), Root[1-144 ((#1)^2)+64 ((#1)^4)&,1], ])},{(NumericalApproximation[Root, (RowDefault["-0.572", FEExpressionsNumericalApproximationElider]), Root[1-24 ((#1)^2)+64 ((#1)^4)&,1], ]),0,(NumericalApproximation[Root, (RowDefault["1.50", FEExpressionsNumericalApproximationElider]), Root[1-144 ((#1)^2)+64 ((#1)^4)&,4], ])},{0,(NumericalApproximation[Root, (RowDefault["1.50", FEExpressionsNumericalApproximationElider]), Root[1-144 ((#1)^2)+64 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["0.572", FEExpressionsNumericalApproximationElider]), Root[1-24 ((#1)^2)+64 ((#1)^4)&,4], ])},{(NumericalApproximation[Root, (RowDefault["1.28", FEExpressionsNumericalApproximationElider]), Root[25-120 ((#1)^2)+64 ((#1)^4)&,4], ]),0,((Sqrt[(5/2)])/2)},{(NumericalApproximation[Root, (RowDefault["-0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,4], ])},{(NumericalApproximation[Root, (RowDefault["-0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,1], ]),(NumericalApproximation[Root, (RowDefault["-0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,4], ])},{0,(NumericalApproximation[Root, (RowDefault["1.50", FEExpressionsNumericalApproximationElider]), Root[1-144 ((#1)^2)+64 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["-0.572", FEExpressionsNumericalApproximationElider]), Root[1-24 ((#1)^2)+64 ((#1)^4)&,1], ])},{0,(NumericalApproximation[Root, (RowDefault["-1.50", FEExpressionsNumericalApproximationElider]), Root[1-144 ((#1)^2)+64 ((#1)^4)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.572", FEExpressionsNumericalApproximationElider]), Root[1-24 ((#1)^2)+64 ((#1)^4)&,4], ])},{(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["-0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,1], ])},{(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["-0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,1], ]),(NumericalApproximation[Root, (RowDefault["-0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,1], ])},{(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["-0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,4], ])},{(NumericalApproximation[Root, (RowDefault["1.50", FEExpressionsNumericalApproximationElider]), Root[1-144 ((#1)^2)+64 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["0.572", FEExpressionsNumericalApproximationElider]), Root[1-24 ((#1)^2)+64 ((#1)^4)&,4], ]),0},{(NumericalApproximation[Root, (RowDefault["-1.28", FEExpressionsNumericalApproximationElider]), Root[25-120 ((#1)^2)+64 ((#1)^4)&,1], ]),0,-((Sqrt[(5/2)])/2)},{-((Sqrt[(5/2)])/2),(NumericalApproximation[Root, (RowDefault["-1.28", FEExpressionsNumericalApproximationElider]), Root[25-120 ((#1)^2)+64 ((#1)^4)&,1], ]),0},{0,((Sqrt[(5/2)])/2),(NumericalApproximation[Root, (RowDefault["-1.28", FEExpressionsNumericalApproximationElider]), Root[25-120 ((#1)^2)+64 ((#1)^4)&,1], ])},{(NumericalApproximation[Root, (RowDefault["-1.50", FEExpressionsNumericalApproximationElider]), Root[1-144 ((#1)^2)+64 ((#1)^4)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.572", FEExpressionsNumericalApproximationElider]), Root[1-24 ((#1)^2)+64 ((#1)^4)&,4], ]),0},{(NumericalApproximation[Root, (RowDefault["-1.50", FEExpressionsNumericalApproximationElider]), Root[1-144 ((#1)^2)+64 ((#1)^4)&,1], ]),(NumericalApproximation[Root, (RowDefault["-0.572", FEExpressionsNumericalApproximationElider]), Root[1-24 ((#1)^2)+64 ((#1)^4)&,1], ]),0},{(NumericalApproximation[Root, (RowDefault["-0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,1], ]),(NumericalApproximation[Root, (RowDefault["0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,4], ]),(NumericalApproximation[Root, (RowDefault["-0.926", FEExpressionsNumericalApproximationElider]), Root[1-56 ((#1)^2)+64 ((#1)^4)&,1], ])}}//FullSimplify

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

newv2[[12]]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

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

Graphics3D[{{Opacity[.4],Green,p},Yellow,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,"Simplification"->FullSimplify])//Timing

(sphere=Midsphere[p,"Simplification"->FullSimplify,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/@(polys=PolyhedronData[pname,"Polygons"])

Show[polys]

Polygon angles

SimplifyNumericallyDistinct[PolygonAngle[polys[[1]]],"Simplification"->RootReduce]//Quiet

Tally[%]

Subtract@@{ArcCos[(1/8) (1-3 (Sqrt[5]))],ArcCos[(1/4)]+(π/3)}//FullSimplify

N[{ArcCos[-(1/4)],ArcCos[(1/4)]+(π/3)}/Degree,10]//Column

Polygon shape

v=polys[[1,1]]

mv=Mean[v]//FullSimplify

mat=RotationMatrix[{Cross[v[[1]]-mv,v[[2]]-mv],{0,0,1}}]//FullSimplify

v2=mat.(#-mv)&/@v//FullSimplify

v2[[All,-1]]

Graphics[Polygon[v2d=Most/@v2]]

Mean[v2d]//FullSimplify

mat2=RotationMatrix[{v2d[[1]],{0,-1}}]//FullSimplify

v2dup=mat2.#&/@v2d//FullSimplify;

With[{style=Directive[Black,FontFamily->"Times",18]},
Graphics[{EdgeForm[Black],FaceForm[LightYellow],Polygon[v2dup],
Text[Style[Subscript["θ",1],style],#,2#]&/@v2dup[[2;;;;2]],
Text[Style[Subscript["θ",2],style],#,2#]&/@v2dup[[1;;;;2]]
}]]

20Area[Polygon[v2dup]]//FullSimplify

Polyhedra

PolyhedronData[pname,"Polyhedra"]

Graphics3D[%]

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

SimplePolyhedron

bug(439904): SimplePolyhedronQ[SmallTriambicIcosahedron] incorrectly returns True

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

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

SurfaceArea[PolyhedronData[pname,"Region"]]

Uniform

PolyhedronData[pname,"Uniform"]

UniformDual

PolyhedronData[pname,"UniformDual"]

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

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

bug(439904): SimplePolyhedronQ[SmallTriambicIcosahedron] incorrectly returns True

PolyhedronData[pname,"Volume"]

Volume[p]

PolyhedronVolume[p]//RootReduce

Volume[PolyhedronData[pname,"Region"]]

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Properties: "SmallTriambicIcosahedronHull"

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

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

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p]//FullSimplify

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Convex

ConvexPolyhedronQ[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//FullSimplify//Tally

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

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

N[i]

MeanSphericalRadius

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//Timing

(i=((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"])))//Timing

N[i]

MeanSquareSphericalRadius

((NIntegrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//Timing

(i=((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//FullSimplify)//Timing

N[i]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

(sphere=Midsphere[p])//Timing

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

PolyhedronData[pname,"Polyhedra"]

Graphics3D[%]

PolyhedronData[pname,"PolyhedronIndices"]

Simple

PolyhedronData[pname,"Simple"]

SimplePolyhedronQ[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]//RootReduce//Timing

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

VertexSubsetHulls

PolyhedronData[pname,"VertexSubsetHulls"]

Platonic

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

hull=ConvexHull3D[PolyhedronData[p,"VertexCoordinates"]];

Show[Graphics3D[hull],Boxed->False]

PolyhedronEdgeLengths[hull]//FullSimplify

FullSimplify[(((1/19)(18(Sqrt[5])-9))/((3/2)((Sqrt[5])-1)))]

Platonic

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

g=Function[poly,Graphics3D[{
{Gray,Opacity[.2],EdgeForm[],PolyhedronData[p,"Faces"]},ConvexHull3D[N[PolyhedronData[p,"VertexCoordinates"]][[#]]]&/@poly},Boxed->False]]/@h[[All,2]]

GraphicsGrid[{g},Spacings->-100]

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p,Method->"GaussLaw"]//FullSimplify

Vertex clusters for "SmallTriambicIcosahedronHull"

Length[v=PolyhedronData["SmallTriambicIcosahedronHull","VertexCoordinates"]]

ToRadicals/@FullSimplify/@SymbolicUnion[Norm/@v]

N[%]

Length[vs=Split[SortBy[{FullSimplify[Norm[#]],#}&/@v,N],First[#1]==First[#2]&]]//Timing

Length/@vs

ds=ToRadicals[#[[1,1]]&/@vs]//FullSimplify//ToRadicals//Simplify

Together/@{(Sqrt[(5/8)+((Sqrt[5])/8)]),(Sqrt[(21/40)+(9/(8 (Sqrt[5])))])}

N[ds]

chs=ConvexHull3D[#[[All,2]]]&/@vs;//Timing

Graphics3D[{{Opacity[.2],PolyhedronData["SmallTriambicIcosahedronHull","Faces"]},
PointSize[.03],
Transpose[{{Red,Blue},Point[#[[All,2]]]&/@vs}]
},Boxed->False]

GraphicsGrid[{
Graphics3D[#,Boxed->False]&/@chs,
Graphics3D[{{If[#1<9,Directive[Opacity[.4],EdgeForm[]],{}],PolyhedronData["SmallTriambicIcosahedronHull","Faces"]},
If[#1<9,{},Opacity[.5]],#2},Boxed->False]&@@@Transpose[{ds,chs}]
},ImageSize->400,Spacings->-100]

Construction

"SmallTriambicIcosahedronHull" (as cumulation of "Icosahedron")

Graphics3D[Cumulate[PolyhedronData["Icosahedron","Polyhedron"],1/Sqrt[15]]]

"SmallTriambicIcosahedron" (as dual of Kaleido 35)

Graphics3D[bulatov=BulatovUniformDualPolyhedron[35]]

PolyhedronFaceTally[bulatov]

Graphics3D/@PolyhedronPolygons[bulatov]

Solve UD eqns

v=bulatov[[1]]

VectorAngle[v[[10]]-v[[13]],v[[17]]-v[[13]]]/Degree

(ArcCos[1/4]+Pi/3.)/Degree

VectorAngle[v[[13]]-v[[17]],v[[3]]-v[[17]]]/Degree

Dot[Normalize[v[[13]]-v[[17]]],Normalize[v[[3]]-v[[17]]]]

(ArcCos[-1/4])/Degree//N

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

v2=With[{eps=1*^-6},Map[Which[Abs[#]<eps,0,Abs[#-1/Sqrt[3]]<eps,1/(Sqrt[3]),Abs[#+1/Sqrt[3]]<eps,-1/(Sqrt[3]),True,#]&,v,{2}]]

v3=With[{eps=1*^-6},Map[Which[
Abs[#-0.797878448606159`]<eps,x,Abs[#+0.797878448606159]<eps,-x,
Abs[#-0.493116000129643`]<eps,y,Abs[#+0.493116000129643`]<eps,-y,
Abs[#-0.356822089773089`]<eps,z,Abs[#+0.356822089773089`]<eps,-z,
Abs[#-0.934172358962713`]<eps,a,Abs[#+0.934172358962713`]<eps,-a,
True,#]&,v2,{2}]]

eqn=UnitEdgeEquations[(v3/((2/(GoldenRatio^2))(Sqrt[(2/3)]))),UndirectedEdge@@@PolyhedronEdges[bulatov]]//FullSimplify//Union

var=Variables[Subtract@@@eqn]

ang=FullSimplify[Dot[Normalize[v3[[13]]-v3[[17]]],Normalize[v3[[3]]-v3[[17]]]]==-1/4,(x|y|z|a)∈Reals]

Length/@{eqn,var}

soln=Solve[Append[eqn,ang],var,Reals]//RootReduce

vxact

Graphics3D[p=Polyhedron[v3/.soln[[1]],bulatov[[2]]]]

Graphics3D[p=Polyhedron[v3/.soln[[2]],bulatov[[2]]]]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p]]//Union

SimplePolyhedronQ[p]

PolyhedronPolygons[p]

Attempt to refine UD graph

g=Graph[Range@Length@v3,bulatov

bulatov[[2]]

RootApproximant[0.79787844860616`,4]

p=Polyhedron[v2,bulatov[[2]]]

PolyhedronEdgeLengths[p]//Mean//InputForm

N[(2/(GoldenRatio^2))(Sqrt[(2/3)]),20]

p=Polyhedron[(v2/((2/(GoldenRatio^2))(Sqrt[(2/3)]))),bulatov[[2]]]

g=PolyhedronGraph[p]

PolyhedronEdgeLengths[p]

(g2=UnitDistanceEmbeddingRefine[g,WorkingPrecision->100,PrecisionGoal->50,Debug->True])//Timing

(g3=UnitDistanceEmbeddingRefine[g2,WorkingPrecision->200,PrecisionGoal->100,Debug->True])//Timing

(g4=UnitDistanceEmbeddingRefine[g3,WorkingPrecision->500,PrecisionGoal->250,Debug->True])//Timing

Max[Abs[EdgeLengths[g4]-1]]

(g5=UnitDistanceEmbeddingRefine[g4,WorkingPrecision->1000,PrecisionGoal->500,Debug->True])//Timing

Max[Abs[EdgeLengths[g5]-1]]

(g6=UnitDistanceEmbeddingRefine[g5,WorkingPrecision->2000,PrecisionGoal->1000,Debug->True])//Timing

Max[Abs[EdgeLengths[g6]-1]]

vexact=Map[ToAlgebraicRoot,SetPrecision[GraphEmbedding[g5],950],{2}]

vexact=Map[ToAlgebraicRoot,GraphEmbedding[g5],{2}]

N[EdgeLengths[Annotate[g4,VertexCoordinates->vexact]],500]//Union

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

N[N[PolyhedronEdgeLengths[p],200],20]//Union

Tally[SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p]]]//Quiet

PolyhedronData

"SmallTriambicIcosahedronHull"

PolyhedronDataString[
Polyhedron[SmallTriambicIcosahedronHull],
"StandardName"->{"SmallTriambicIcosahedronHull","Split"},
"Name"->"small triambic icosahedron",
"AlternateStandardNames"->{{"IcosahedronStellation",2}},
"AlternateNames"->{"second icosahedron stellation"},
"Information"->"SmallTriambicIcosahedronHull",
"Classes"->{"Concave","IcosahedronStellation"},
"NotationRules"->{"IcosahedronStellation"->2},
"Simplification"->(ToRadicals[RootApproximant[#]]&),
TimeConstraint->300,
Debug->True]

"SmallTriambicIcosahedron"

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

WriteString[file,PolyhedronDataString[
p,
"StandardName"->"SmallTriambicIcosahedron",
"Name"->"small triambic icosahedron",
"AlternateStandardNames"->{{"UniformDual",30}},
"HullName"->"SmallTriambicIcosahedronHull",
"Information"->"SmallTriambicIcosahedron",
"Classes"->{"UniformDual"},
"NotationRules"->{"Maeder"->2},
Debug->True]
]

Close[file]