Triaugmented Truncated Dodecahedron

Author

Eric W. Weisstein
October 3, 2022

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

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

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

Graphics

Solid

PolyhedronData["TriaugmentedTruncatedDodecahedron","Orientations"]

PolyhedronData["TriaugmentedTruncatedDodecahedron"]

PolyhedronData["TriaugmentedTruncatedDodecahedron","VertexCoordinates"]

Region

PolyhedronData["TriaugmentedTruncatedDodecahedron","Region"]

PolyhedronData (V12.1)

PolyhedronData["TriaugmentedTruncatedDodecahedron"]

PolyhedronData["TriaugmentedTruncatedDodecahedron","VertexCoordinates"]

Netlib

PolyhedronName[JohnsonSolid[71]]

Show[Graphics3D[Polyhedron[JohnsonSolid[71]]],Boxed->False]

Net

PolyhedronData

PolyhedronData["TriaugmentedTruncatedDodecahedron","Net"]

PolyhedronData["TriaugmentedTruncatedDodecahedron","Net","Colored"]

Netlib

Show[Graphics[Net[JohnsonSolid[71]]],AspectRatio->Automatic]

Properties

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

p2=Polyhedron[ToRadicals[PolyhedronData[pname,"VertexCoordinates"]],PolyhedronData[pname,"FaceIndices"]]

AdjacentFaceIndices

AdjacentFaceIndices[p]

Centroid

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

PolyhedronData[pname,"Centroid"]

hangs:

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

ByteCount[dih=SimplifyNumericallyDistinct[DihedralAngles[p],Debug->True]]//Timing

SortBy[dih,N]-SortBy[dihn,N]//Chop//Union

dih

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

PolyhedronData[pname,"Lines"]/.Line[l_]:>EuclideanDistance@@l//FullSimplify//Union//Quiet

Faces

GeneralizedDiameter

PolyhedronData["TriaugmentedTruncatedDodecahedron","GeneralizedDiameter"]

GeneralizedDiameter[p]//Quiet//FullSimplify

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

hangs:

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

(i=PolyhedronInertiaTensor[p2,PolyhedronData[pname,"Volume"],Identity,Identity,Debug->True])//Quiet//Timing

Map[RootApproximant[N[#,1000],16]&,i,{2}]//Quiet

MeanCylindricalRadius

bug(407468): RegionCentroid[PolyhedronData["TruncatedDodecahedron", "Polyhedron"]], Integrate[1, {x, y, z} ∈ PolyhedronData["TruncatedDodecahedron", "Polyhedron"]], ... are uninterruptible

bug(409814): Integrate[x^2 + y^2, {x, y, z} ∈ PolyhedronData["TruncatedDodecahedron", "Polyhedron"]] is uninterruptible

hangs:

PolyhedronData[pname,"MeanCylindricalRadius"]

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

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

N[i]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

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

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

N[i]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

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

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

N[i]

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

N[%]

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

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

Total[IntegrateOverPolygon[Function[{x,y,z},{x^3/3+y^2x+z^2x,0,0}],#]&/@PolyhedronData[pname,"Faces","Polygon"]]/vol//ToAlgebraicRoot

N[%]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

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

RegionFunction

reg=PolyhedronData["TriaugmentedTruncatedDodecahedron","RegionFunction"]

bounds=RegionBounds[ImplicitRegion[Evaluate[N[reg[x,y,z]]],{x,y,z}]]

ranges=Flatten/@Transpose[{{x,y,z},.1{-1,1}+#&/@bounds}]

RegionPlot3D[Evaluate[N[reg[x,y,z]]],Evaluate[Sequence@@ranges],BoxRatios->Automatic,PlotPoints->40]

ByteCount[ineq=PolyhedronInequalities[p,{#1,#2,#3}]]

ByteCount[ineq2=FullSimplify[ineq]]//Timing

ineq2

SimplePolyhedron

PolyhedronData[pname,"Simple"]

SimplePolyhedronQ[p]

SkeletonCoordinates

vc=PolyhedronData["TriaugmentedTruncatedDodecahedron","V"]

g=Graph[Range[vc],UndirectedEdge@@@PolyhedronData["TriaugmentedTruncatedDodecahedron","EdgeIndices"]]

r=RecognizeGraph[g]

GraphData[r,"Graph","All"]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

RootReduce[%]

(s=SurfaceArea[p])//Timing

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

N[s-r,10^4]//Quiet

(s=Total[Area/@PolyhedronData[pname,"Polygons"]])//Timing

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

N[s-r,10^4]//Quiet

VertexSubsetHulls

PolyhedronData[pname,"VertexSubsetHulls"]

Platonic

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

Volume

PolyhedronData["TriaugmentedTruncatedDodecahedron","Volume"]

...uninterruptible...

Volume[p]//Timing

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

v=PolyhedronVolume[p,Method->"Pyramids"]

r=RootApproximant[N[v,1000],32]

N[v-r,10^4]

Construction

Construct by adding 2 pentagonal cupolas to {"TruncatedDodecahedron", "C3"}

truncdod=Polyhedron[];

v=PolyhedronCoordinates[truncdod];

Norm/@v//FullSimplify//Union

Graphics3D[truncdod]

ztop=PolyhedronCoordinates[p][[All,3]]//Max//FullSimplify

topfacecenter=Mean[Select[v,Last[#]==ztop&]]//FullSimplify

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

decagons=Select[p[[2]],Length[#]==10&]

triple=SelectFirst[decagons,Length[Intersection[#,{4,37,51}]]>2&]

centeronwhichtoerect=Mean[v[[triple]]]//FullSimplify

h=PolyhedronData["AugmentedTruncatedDodecahedron","VertexCoordinates"][[All,-1]]//Max

topv={#1,#2,h}&@@@CirclePoints[{Csc[Pi/5]/2,0},5]//FullSimplify

mat=RotationMatrix[{{0,0,1},centeronwhichtoerect}]//FullSimplify

rotunda1=mat.#&/@topv//FullSimplify;

rotunda2=RotationMatrix[2π/3,{0,0,1}].#&/@rotunda1//FullSimplify;

rotunda3=RotationMatrix[4π/3,{0,0,1}].#&/@rotunda1//FullSimplify;

vnew=Join[v,rotunda1,rotunda2,rotunda3]

Show[hull=ConvexHullRegion[vnew],Boxed->True]

PolyhedronData["TriaugmentedTruncatedDodecahedron","FaceCountRules"]

Tally[Length/@(f=MeshCells[hull,2][[All,1]])]

SmallestRotation[l_]:=Sort[NestList[RotateRight,l,Length[l]-1]][[1]]

fmin=Sort[SmallestRotation/@f]

PolyhedronData["TriaugmentedTruncatedDodecahedron",{"V","F"}]

p=Polyhedron[vnew,fmin]

Graphics3D[{FaceForm[Green,Red],p}]

Net construction

Recognize in-place

Select[PolyhedronData["AllOrientations"],Min[N[Flatten[Normal[PolyhedronData[#,"NetEdges"]]]/.Line[x_]:>Norm[Subtract@@x]]]≠1.&]

PolyhedronData["TriaugmentedTruncatedDodecahedron","NetImage"]

Select[PolyhedronData["AllOrientations"],!FreeQ[PolyhedronData[#,"NetCoordinates"],_?InexactNumberQ]&]

Select[Flatten[Normal[PolyhedronData["TriaugmentedTruncatedDodecahedron","NetEdges"]]/.Line[x_]:>Norm[Subtract@@x]],N[#]≠1.&]

v=PolyhedronData["TriaugmentedTruncatedDodecahedron","NetCoordinates"];

l=Union[First/@Position[v,_?InexactNumberQ,{1,∞}]]

Show[{PolyhedronData["TriaugmentedTruncatedDodecahedron","NetImage"],Graphics[Point[PolyhedronData["TriaugmentedTruncatedDodecahedron","NetCoordinates"][[l]]]]}]

Show[{PolyhedronData["TriaugmentedTruncatedDodecahedron","NetImage"],Graphics[MapIndexed[Text[#2[[1]],#1,Background->White]&,v]]}]

RootApproximant/@PolyhedronData["TriaugmentedTruncatedDodecahedron","NetCoordinates"][[145]]

N[Norm[v[[147]]-%59],50]

PolyhedronData["TriaugmentedTruncatedDodecahedron","NetFaces"]

From scratch

PolyhedronData["TriaugmentedTruncatedDodecahedron","EdgeLengths"]

{a}//N

PolyhedronData["TriaugmentedTruncatedDodecahedron","FaceCountRules"]

Graphics3D[{poly=PolyhedronData["TriaugmentedTruncatedDodecahedron","Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,v=PolyhedronData["TriaugmentedTruncatedDodecahedron","VertexCoordinates"]]}]

<<MathWorld`Polyhedra`

m=RotationMatrix;
v=CirclePoints[Csc[Pi/10]/2,10]//N[#,10000]&;
v=Join[v,{v[[3]]+RotationMatrix[-Pi/3].(v[[4]]-v[[3]])}];
v=Join[v,SimilarityTransform[v,{{10,1},{8,7}},Range[11]]];
v=Join[v,SimilarityTransform[v,{{10,1},{6,5}},Range[11]]];
v=Join[v,SimilarityTransform[v,{{10,1},{10,9}},Range[11]]];
v=Join[v,SimilarityTransform[v,{{10,1},{2,1}},Range[11]]];
v=Join[v,{
v[[32]]+RotationMatrix[-Pi/3].(v[[12]]-v[[32]]),
v[[21]]+RotationMatrix[-Pi/3].(v[[34]]-v[[21]]),
v[[45]]+RotationMatrix[Pi/3].(v[[43]]-v[[45]]),
v[[3]]+RotationMatrix[Pi/3].(v[[54]]-v[[3]]),
v[[4]]+RotationMatrix[-Pi/3].(v[[23]]-v[[4]]),
v[[11]]+RotationMatrix[-Pi/2].(v[[4]]-v[[11]]),v[[4]]+RotationMatrix[-Pi/2].(v[[4]]-v[[11]])
}];
v=Join[v,{v[[61]]+RotationMatrix[-Pi/3].(v[[62]]-v[[61]]),v[[11]]+RotationMatrix[2Pi/5].(v[[11]]-v[[61]]),v[[61]]+RotationMatrix[-2Pi/5].(v[[61]]-v[[11]])}];
v=Join[v,{v[[65]]+RotationMatrix[-2Pi/5].(v[[65]]-v[[61]])}];
v=Join[v,{v[[61]]+RotationMatrix[Pi/2].(v[[65]]-v[[61]]),v[[65]]+RotationMatrix[-Pi/2].(v[[61]]-v[[65]])}];
v=Join[v,SimilarityTransform[v,{{65,61},{11,64}},{67,68}]];
v=Join[v,SimilarityTransform[v,{{65,61},{64,66}},{67,68}]];
v=Join[v,SimilarityTransform[v,{{65,61},{66,65}},{67,68}]];
v=Join[v,{v[[73]]+RotationMatrix[-Pi/3].(v[[65]]-v[[73]]),v[[69]]+RotationMatrix[-Pi/3].(v[[64]]-v[[69]]),v[[71]]+RotationMatrix[-Pi/3].(v[[66]]-v[[71]])}];
v=Join[v,SimilarityTransform[v,{{10,1},{77,71}},Range[11]]];
v=Join[v,{v[[51]]+RotationMatrix[-Pi/3].(v[[52]]-v[[51]])}];
v=Join[v,{v[[86]]+m[-Pi/3].(v[[87]]-v[[86]])}];
v=Join[v,SimilarityTransform[v,{{43,34},{83,84}},{12,32,56,23,4,60,3,59,54,45,58,43,34,57,21}]];
v=Join[v,SimilarityTransform[v,{{3,4},{100,99}},{3,4,62,63,67,68,75,73,74,87,78,72,76,69,70,11,61,65,66,64}]];
v=Join[v,SimilarityTransform[v,{{32,23},{105,91}},Append[Range[23,32],33]]];
v=Join[v,SimilarityTransform[v,{{45,54},{97,95}},Join[Range[45,54],{55,89}]]];
v=Join[v,SimilarityTransform[v,{{63,62},{92,94}},{63,62,61,4,11,3}]];
v=Join[v,SimilarityTransform[v,{{11,64},{151,153}},{66,65,61,11,67,68,62,4,73,74,72,78}]];
v=Join[v,{v[[161]]+m[Pi/3].(v[[157]]-v[[161]]),v[[160]]+m[Pi/3].(v[[156]]-v[[160]]),v[[155]]+m[-Pi/3].(v[[164]]-v[[155]])}];

f={Range[10],{3,11,4}};
f=Join@@Table[f+11i,{i,0,4}];
f=Join[f,{{32,56,12},{21,57,34},{45,43,58},{59,3,54},{4,60,23},{61,62,4,11},{61,63,62},{66,65,61,11,64},{68,67,61,65},{11,70,69,64},{66,64,72,71},{73,65,66,74},{73,75,65},{64,69,76},{77,66,71},{89,52,51},{85,86,87,78,79,80,81,82,83,84},{81,80,88},{86,90,87},{91,105,103,102,100,99,97,95,94,92},{105,104,103},{102,101,100},{99,98,97},{95,96,94},{92,93,91},{107,106,121},{121,125,124,123,122},{121,120,119,125},{125,119,118},{125,117,116,124},{124,116,115},{123,124,114,113},{108,107,121,122},{108,122,109},{110,122,123,111},{112,123,113},Range[126,135],{128,136,129},Range[137,146],{143,148,144},{139,147,140},{151,149,150},{153,151,150,152},{153,152,154},{153,155,156,157,158},{157,156,160,159},{157,161,162,158},{156,155,164,163},{166,155,153,165},{157,167,161},{168,160,156},{164,155,169}}];
Graphics[{FaceForm[LightYellow,Red],EdgeForm[Black],Polygon[v,f],MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

PolygonAngle[Polygon[v[[{1,3,11,12,4}]]]]//N

PolyhedronData["TriaugmentedTruncatedDodecahedron","SurfaceArea"]//N

Total[Area[Polygon[v,#]]&/@f]//N

rot=RotationMatrix[{v[[87]]-v[[78]],{0,1}}];

v2=(rot.(#-v[[78]]))&/@v;

Graphics[{FaceForm[LightYellow,Red],EdgeForm[Black],Polygon[v2,f]},Axes->True]

vexact=Map[ToAlgebraicRoot[#,WorkingPrecision->1000]&,v2,{2}];//Timing

bug(426316): Area[Polygon[v, f]] returns wrong result

ToAlgebraicRoot@Area[Polygon[vexact,f]]//FullSimplify

ToAlgebraicRoot@Total[Area[Polygon[vexact,#]]&/@f]//FullSimplify

PolyhedronData["TriaugmentedTruncatedDodecahedron","SurfaceArea"]

vfinal=Union[vexact];

ffinal=Sort[vexact[[#]]&/@f/.Thread[vfinal->Range[Length[vfinal]]]]

vfinal//FullSimplify

Graphics[{FaceForm[LightYellow,Red],EdgeForm[Black],Polygon[vfinal,ffinal]},Axes->True]

ToAlgebraicRoot@Total[Area[Polygon[vfinal,#]]&/@ffinal]//FullSimplify