Chamfered Dodecahedron

Author

Eric W. Weisstein
October 5, 2022

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

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

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

Graphics

PolyhedronData["*ChamferedDodecahedron"]

PolyhedronData/@{"CanonicalChamferedDodecahedron","EquilateralChamferedDodecahedron"}

Graphics3D[{Opacity[.7],PolyhedronData["EquilateralChamferedDodecahedron","Polyhedron"]},Boxed->False]

Varying chamfering ratios

With[{p=Dodecahedron[]},GraphicsRow[Graphics3D[{Opacity[.8],#},Boxed->False]&/@Prepend[Table[ResourceFunction["ChamferedPolyhedron"][p,r],{r,.2,.99,.2}],p]]]

BuckyballGraph

BuckyballGraph20=BuckyballGraph[1,"I"]

IsomorphicGraphQ[PolyhedronData["EquilateralChamferedDodecahedron","Skeleton"],BuckyballGraph[1,"I"]]

PolyhedronData["EquilateralChamferedDodecahedron","Edges","Line"]/.Line[x_]:>EuclideanDistance@@x//Quiet

RecognizeGraph[BuckyballGraph20]

Options[BuckyballGraph20]

BuckyballGraph20//InputForm

e=EdgeLengths[BuckyballGraph20]

small=Position[e,_?(LessThan[1.2])]//Flatten

v=GraphEmbedding[BuckyballGraph20];

g=Annotate[BuckyballGraph20,{VertexCoordinates->v,AspectRatio->1}]

EdgeList[BuckyballGraph20][[1]]

EuclideanDistance@@v[[{1,2}]]

big=Position[e,_?(GreaterThan[5])]//Flatten

EdgeList[BuckyballGraph20][[34]]

EuclideanDistance@@v[[{19,58}]]

HighlightGraph[Annotate[BuckyballGraph20,VertexLabels->"Name"],EdgeList[BuckyballGraph20][[#]]&/@{small,big}]

"CanonicalChamferedDodecahedron"

Graphics3D[CanonicalChamferedDodecahedron=PolyhedronData[{"Goldberg",{2,0}},"Polyhedron"]]

SkeletonGraph[CanonicalChamferedDodecahedron]//RecognizeGraph

RootReduce[PolyhedronEdgeLengths[CanonicalChamferedDodecahedron]]//Quiet//Union//Timing

SimplePolyhedronQ[CanonicalChamferedDodecahedron]

Midsphere[CanonicalChamferedDodecahedron//N]

Midsphere[CanonicalChamferedDodecahedron,Method->"PointLineDistance","Simplification"->Function[RootReduce[Numerator[Together[#]]]]]//Timing

Solid and Dual

PolyhedronData["CanonicalChamferedDodecahedron","Dual","Name"]

solidandduals=PolyhedronData["CanonicalChamferedDodecahedron",#]&/@{"Graphics3D","Dual","DualCompound"}

pname="CanonicalChamferedDodecahedron";
Graphics3D[{Opacity[.5],
{Red,PolyhedronData[pname,"Polyhedron"]},
{Green,PolyhedronData[pname,"Dual","Polyhedron"]},
{Yellow,PolyhedronData[pname,"Midsphere"]}
}]

Properties: "CanonicalChamferedDodecahedron"

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

vol=PolyhedronData[pname,"Volume"]

Centroid

RegionCentroid[poly]//RootReduce//Timing

DualScale

dualrho=PolyhedronData[pname,"Midradius"];
polyrho=PolyhedronData[PolyhedronData[pname,"Dual","Name"],"Midradius"];

1/(polyrho/dualrho)//RootReduce//FullSimplify

N[%]

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

((PolyhedronData[pname,"EdgeLengths"])/(PolyhedronData[pname,"Midradius"]))//FullSimplify

Graphics3D[{Opacity[.5],Yellow,PolyhedronData[pname,"Midsphere"],Red,p},Boxed->False,ImageSize->200]

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[poly]//FullSimplify//Quiet

InertiaTensor

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

Map[ToAlgebraicRoot,i,{2}]//Quiet//Timing

RootReduce[(({{(NumericalApproximation[Root, (RowDefault["312.", FEExpressionsNumericalApproximationElider]), Root[54571890421-5830704016320 #1-19245479889600 ((#1)^2)-2982528000 ((#1)^3)+207360000 ((#1)^4)&,4], ]),0,0},{0,(NumericalApproximation[Root, (RowDefault["312.", FEExpressionsNumericalApproximationElider]), Root[54571890421-5830704016320 #1-19245479889600 ((#1)^2)-2982528000 ((#1)^3)+207360000 ((#1)^4)&,4], ]),0},{0,0,(NumericalApproximation[Root, (RowDefault["312.", FEExpressionsNumericalApproximationElider]), Root[54571890421-5830704016320 #1-19245479889600 ((#1)^2)-2982528000 ((#1)^3)+207360000 ((#1)^4)&,4], ])}})/vol)]//FullSimplify

N[%]

(i=PolyhedronInertiaTensor[poly,vol])//Timing

MeanSquareCylindricalRadius

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

RootReduce@rxy2//Timing

ToAlgebraicRoot[rxy2]//Timing

MeanSquareSphericalRadius

(rxyz2=((Integrate[x^2+y^2+(z^2),{x,y,z}∈poly])/vol))//Timing

RootReduce@rxyz2//Timing

ToAlgebraicRoot[rxyz2]//Timing

Net

PolyhedronData[pname,"Net"]

Total[Area/@Flatten[PolyhedronData[pname,"Net","Polygon"]]]//ToAlgebraicRoot//Timing

PolyhedronData[pname,"SurfaceArea"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

ineq=Collect[#,{x,y,z},RootReduce]&/@PolyhedronInequalities[poly,{x,y,z}]

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

FullSimplify/@%148

FullSimplify@%

Skeleton

PolyhedronData[pname,"Skeleton"]

SurfaceArea

SurfaceArea[poly]//ToAlgebraicRoot//Quiet//Timing

PolyhedronSurfaceArea[poly]//RootReduce//Timing

Volume

Volume[poly]//RootReduce//Timing

PolyhedronVolume[poly]//ToAlgebraicRoot//Quiet//Timing

Volume[PolyhedronData[pname,"Region"]]//RootReduce//Timing

Volume[PolyhedronData[pname,"Region"]]//ToAlgebraicRoot//Timing

Construction

Graphics3D[GraphData[{"Fullerene",{80,6877}},"Polyhedron"]]

RecognizeGraph@BuckyballGraph[1,"I"]

can=Polyhedron[];

can2=FindCanonicalPolyhedron[can,WorkingPrecision->150,PrecisionGoal->100,MaxIterations->50000,Debug->True]

can3=FindCanonicalPolyhedron[can2,WorkingPrecision->500,PrecisionGoal->200,MaxIterations->50000,Debug->True,"ProgressInterval"->1000]

Graphics3D[{Opacity[.5],Red,can3,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can3]],Abs[#1-#2]<1.*^-10&])//N

ToAlgebraicRoot/@N[lens,95]//FullSimplify

v=PolyhedronCoordinates[can3];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

r=ToAlgebraicRoot[N[Divide@@lens,95]]

ToRadicals[r]//FullSimplify

N[Divide@@lens-r,200]

<<MathWorld`Graphs`

Graphics3D[{Thick,MapIndexed[Text[#2[[1]],#,Background->White]&,v],Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False,Axes->True,AxesOrigin->{0,0,0}]

pentagon={77,71,73,76,79};

mat=RotationMatrix[{Mean[v[[pentagon]]],{0,0,1}}];

Mean[v]//N

v2=mat.#&/@v;

q=ArcTan@@(Most@Normalize[v2[[77]]-Mean[v2[[pentagon]]]])

mat2=RotationMatrix[-q,{0,0,1}];

v3=mat2.#&/@v2;

e=Line[v3[[#]]]&/@PolyhedronEdges[can3];

Graphics3D[{Thick,Arrow[{{0,0,0},{0,0,1}}],MapIndexed[Text[#2[[1]],#,Background->White]&,v3],e},Boxed->False,Axes->True,AxesOrigin->{0,0,0}]

vexact=Map[ToAlgebraicRoot[#,"MaxDegree"->16]&,Chop@N[v3,150],{2}]

g=Graph[Range[Length[vexact]],UndirectedEdge@@@PolyhedronEdges[can3],VertexCoordinates->vexact]

EdgeLengths[g]//RootReduce//Quiet//Union

Divide@@%//RootReduce

f

faces=Reverse/@PlanarFaceList[Graph[EdgeList[g]]]

Graphics3D[{FaceForm[Green,Red],poly=Polyhedron[vexact,faces]}]

SimplePolyhedronQ[poly]

(sphere=Midsphere[poly//N])//Timing

1/(NumericalApproximation[Root, (RowDefault["0.345", FEExpressionsNumericalApproximationElider]), Root[1-4 #1+((#1)^2)+6 ((#1)^3)+((#1)^4)&,3], ])//RootReduce

g=PolyhedronGraph[Polyhedron[]]

Net Construction

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

pentagon={77,71,73,76,79};
hexagon={76,74,70,72,78,79};

ind=Union[pentagon,hexagon]

Graphics3D[{Polygon[v[[#]]]&/@{pentagon,hexagon},Cases[MapIndexed[Text[#2[[1]],#,Background->White]&,v],Text[Alternatives@@ind,__]]},Boxed->False]

Pentagon and short irregular hexagon sides:

EuclideanDistance@@v[[{77,79}]]//RootReduce

Long hexagon sides:

EuclideanDistance@@v[[{78,79}]]//RootReduce

Asymmetric hexagon angle (big):

VectorAngle[v[[76]]-v[[79]],v[[78]]-v[[79]]]//RootReduce

Symmetric hexagon angle (small):

VectorAngle[v[[72]]-v[[78]],v[[79]]-v[[78]]]//RootReduce

N[{ArcCos[(NumericalApproximation[Root, (RowDefault["-0.526", FEExpressionsNumericalApproximationElider]), Root[1-5 ((#1)^2)+5 ((#1)^4)&,2], ])],ArcCos[-(1/(Sqrt[5]))]}]

ArcCos[ToAlgebraicRoot/@Cos[PolygonAngle[Polygon@pentagon]]]//Quiet//Union//FullSimplify

ArcCos[ToAlgebraicRoot/@Cos[PolygonAngle[Polygon@hexagon]]]//Quiet//FullSimplify

Tally[%95]

N[%]

Import["https://upload.wikimedia.org/wikipedia/commons/2/25/Truncated_rhombic_triacontahedron_net.png"]

pentagons have unit edge length
irregular hexagons have two opposite sides of unit edge lengths and the rest of length a > 1

{big=ArcCos[(NumericalApproximation[Root, (RowDefault["-0.526", FEExpressionsNumericalApproximationElider]), Root[1-5 ((#1)^2)+5 ((#1)^4)&,2], ])],small=ArcSec[-(Sqrt[5])]};
a=(1/4) (5-(Sqrt[5])+2 (Sqrt[5-2 (Sqrt[5])]));
α=3Pi/5;
m=RotationMatrix;
v=CirclePoints[{Csc[Pi/5]/2,-Pi/2},5];
v=Join[v,{v[[3]]+a m[-big].{-1,0},v[[4]]+a m[big].{1,0}}];
v=Join[v,{{v[[3,1]],y=v[[6,2]]+(v[[6,2]]-v[[3,2]])},{v[[4,1]],y}}];
v=Join[v,{v[[8]]+m[-α].{-1,0},v[[9]]+m[α].{1,0}}];
v=Join[v,{v[[11]]+m[α].(v[[9]]-v[[11]]),v[[1]]+a m[-big].(v[[2]]-v[[1]]),v[[1]]+a m[big].(v[[5]]-v[[1]]),v[[2]]+a m[big].(v[[1]]-v[[2]])}];
v=Join[v,{v[[13]]+m[-small].(v[[1]]-v[[13]]),v[[15]]+m[small].(v[[2]]-v[[15]])}];
v=Join[v,{v[[3]]+a m[big].(v[[2]]-v[[3]]),v[[2]]+a m[-big].(v[[3]]-v[[2]])}];
v=Join[v,{v[[18]]+m[small].(v[[3]]-v[[18]]),v[[19]]+m[-small].(v[[2]]-v[[19]])}];
v=Join[v,{-#,#2}&@@@v[[{18,20,21,19,15,17,16}]]];
v=Join[v,{v[[20]]+m[α].(v[[21]]-v[[20]]),v[[21]]+m[-α].(v[[20]]-v[[21]])}];
v=Join[v,{v[[29]]+m[α].(v[[20]]-v[[29]])}];
v=Join[v,{-#,#2}&@@@v[[{29,31,30,21}]]];
v=Join[v,{v[[12]]+a m[-big].(v[[11]]-v[[12]]),v[[11]]+a m[big].(v[[12]]-v[[11]])}];
v=Join[v,{v[[37]]+m[small].(v[[11]]-v[[37]]),v[[36]]+m[-small].(v[[12]]-v[[36]])}];
v=Join[v,{v[[39]]+m[-α].(v[[38]]-v[[39]]),v[[38]]+m[α].(v[[39]]-v[[38]])}];
v=Join[v,{v[[41]]+m[α].(v[[38]]-v[[41]])}];
v=Join[v,{v[[17]]+m[α].(v[[16]]-v[[17]]),v[[16]]+m[-α].(v[[17]]-v[[16]])}];
v=RootReduce@Join[v,{v[[44]]+m[-α].(v[[16]]-v[[44]])}];

v=Join[v,{-#,#2}&@@@v[[{43,45,44}]]];
v=Join[v,{v[[45]]+a m[-big].(v[[43]]-v[[45]]),v[[43]]+a m[big].(v[[45]]-v[[43]])}];
v=Join[v,{v[[50]]+m[small].(v[[43]]-v[[50]]),v[[49]]+m[-small].(v[[45]]-v[[49]])}];
v=Join[v,{v[[51]]+m[α].(v[[52]]-v[[51]]),v[[52]]+m[-α].(v[[51]]-v[[52]])}];
v=Join[v,{v[[53]]+m[α].(v[[51]]-v[[53]])}];
v=Join[v,{v[[47]]+a m[-big].{1,0},v[[48]]+a m[big].(v[[47]]-v[[48]])}];
v=Join[v,{v[[56]]+m[-small].(v[[47]]-v[[56]]),v[[57]]+m[small].(v[[48]]-v[[57]])}];
v=Join[v,{v[[58]]+m[-α].(v[[59]]-v[[58]]),v[[59]]+m[α].{-1,0}}];
v=Join[v,{v[[60]]+m[-α].(v[[58]]-v[[60]])}];
v=Join[v,{v[[18]]+m[small].(v[[20]]-v[[18]])}];
v=Join[v,{v[[63]]+m[big].(v[[18]]-v[[63]])/a,v[[20]]+m[-big].(v[[18]]-v[[20]])/a}];
v=Join[v,{v[[64]]+a m[big].(v[[63]]-v[[64]])}];
v=Join[v,{v[[66]]+m[-small].(v[[64]]-v[[66]]),v[[64]]+m[big].(v[[66]]-v[[64]])/a}];
v=Join[v,{v[[68]]+a m[big].(v[[64]]-v[[68]]),v[[67]]+m[-big].(v[[66]]-v[[67]])/a}];
v=Join[v,{v[[69]]+m[small].(v[[70]]-v[[69]]),v[[70]]+m[-big].(v[[69]]-v[[70]])/a,v[[66]]+m[small].(v[[65]]-v[[66]]),v[[65]]+m[-big].(v[[66]]-v[[65]])/a}];
v=Join[v,{v[[74]]+m[-big].(v[[65]]-v[[74]])a,v[[73]]+m[big].(v[[66]]-v[[73]])/a}];
v=Join[v,{v[[71]]+m[big].(v[[69]]-v[[71]])/a,v[[72]]+a m[-big].(v[[70]]-v[[72]])}];
v=Join[v,{v[[73]]+m[α].(v[[76]]-v[[73]]),v[[76]]+m[-α].(v[[73]]-v[[76]])}];
v=Join[v,{v[[79]]+m[α].(v[[73]]-v[[79]])}];
v=Join[v,{v[[9]]+m[-big].(v[[7]]-v[[9]])/a,v[[7]]+m[small].(v[[9]]-v[[7]])}];
v=RootReduce@Join[v,{v[[83]]+m[big].(v[[7]]-v[[83]])/a,v[[82]]+m[-big].(v[[9]]-v[[82]])a}];

v=Join[v,{v[[85]]+m[-small].(v[[84]]-v[[85]]),v[[84]]+m[big].(v[[85]]-v[[84]])/a}];
v=Join[v,{v[[87]]+m[big].(v[[84]]-v[[87]])a,v[[86]]+m[-big].(v[[85]]-v[[86]])/a}];
v=Join[v,{v[[17]]+m[-big].(v[[15]]-v[[17]])/a,v[[15]]+m[small].(v[[17]]-v[[15]])}];
v=Join[v,{v[[91]]+m[big].(v[[15]]-v[[91]])/a,v[[90]]+m[-big].(v[[17]]-v[[90]])a}];
v=Join[v,{v[[92]]+m[big].(v[[93]]-v[[92]])/a,v[[93]]+m[-small].(v[[92]]-v[[93]])}];
v=Join[v,{v[[94]]+m[big].(v[[92]]-v[[94]])a,v[[95]]+m[-big].(v[[93]]-v[[95]])/a}];
v=Join[v,{v[[96]]+m[small].(v[[97]]-v[[96]]),v[[97]]+m[-big].(v[[96]]-v[[97]])/a}];
v=Join[v,{v[[98]]+m[big].(v[[96]]-v[[98]])/a,v[[99]]+m[-big].(v[[97]]-v[[99]])a}];
v=Join[v,{v[[101]]+m[-small].(v[[100]]-v[[101]]),v[[100]]+m[big].(v[[101]]-v[[100]])/a}];
v=Join[v,{v[[103]]+m[big].(v[[100]]-v[[103]])a,v[[102]]+m[-big].(v[[101]]-v[[102]])/a}];
v=Join[v,{v[[26]]+m[-small].(v[[27]]-v[[26]]),v[[27]]+m[big].(v[[26]]-v[[27]])/a}];
v=Join[v,{v[[106]]+m[-big].(v[[26]]-v[[106]])/a,v[[107]]+m[big].(v[[27]]-v[[107]])a}];
v=RootReduce@Join[v,{v[[108]]+m[-big].(v[[109]]-v[[108]])/a,v[[109]]+m[small].(v[[108]]-v[[109]])}];

v=Join[v,{v[[110]]+m[-big].(v[[108]]-v[[110]])a,v[[111]]+m[big].(v[[109]]-v[[111]])/a}];
v=Join[v,{v[[113]]+m[-α].(v[[111]]-v[[113]]),v[[111]]+m[α].(v[[113]]-v[[111]])}];
v=Join[v,{v[[114]]+m[-α].(v[[113]]-v[[114]])}];
v=Join[v,{v[[112]]+m[-small].(v[[113]]-v[[112]]),v[[113]]+m[big].(v[[112]]-v[[113]])/a}];
v=Join[v,{v[[118]]+m[big].(v[[113]]-v[[118]])a,v[[117]]+m[-big].(v[[112]]-v[[117]])/a}];
v=Join[v,{v[[118]]+m[big].(v[[119]]-v[[118]])/a,v[[119]]+m[-small].(v[[118]]-v[[119]])}];
v=Join[v,{v[[122]]+m[-big].(v[[119]]-v[[122]])/a,v[[121]]+a m[big].(v[[118]]-v[[121]])}];
v=Join[v,{v[[120]]+m[-big].(v[[119]]-v[[120]])/a,v[[119]]+m[small].(v[[120]]-v[[119]])}];
v=Join[v,{v[[126]]+m[big].(v[[119]]-v[[126]])/a,v[[125]]+m[-big].(v[[120]]-v[[125]])a}];
v=Join[v,{v[[127]]+m[-α].(v[[126]]-v[[127]]),v[[126]]+m[α].(v[[127]]-v[[126]])}];
v=RootReduce@Join[v,{v[[129]]+m[-α].(v[[127]]-v[[129]])}];

v=Join[v,{v[[107]]+m[big].(v[[109]]-v[[107]])/a,v[[109]]+m[-small].(v[[107]]-v[[109]])}];
v=Join[v,{v[[133]]+m[-big].(v[[109]]-v[[133]])/a,v[[132]]+m[big].(v[[132]]-v[[107]])/a}];
v=Join[v,{v[[134]]+m[-big].(v[[133]]-v[[134]])a}];
v=Join[v,{v[[134]]+m[-big].(v[[136]]-v[[134]])/a,v[[136]]+m[2small].(v[[132]]-v[[136]])}];
v=Join[v,{v[[138]]+m[big].(v[[136]]-v[[138]])/a,v[[137]]+m[-big].(v[[134]]-v[[137]])a}];
v=Join[v,{v[[139]]+m[big].(v[[140]]-v[[139]])/a,v[[140]]+m[-small].(v[[139]]-v[[140]])}];
v=Join[v,{v[[142]]+m[-big].(v[[140]]-v[[142]])/a}];
v=RootReduce@Join[v,{v[[141]]+m[big].(v[[139]]-v[[141]])a}];

rot=RootReduce@RotationMatrix[-Subtract@@@{v[[{17,15}]],v[[{28,14}]]}];//Timing

v=RootReduce@Join[v,(v[[28]]+rot.(v[[#]]-v[[17]]))&/@Range[90,105]];

v

Length[v]

f={Range[5],{3,6,8,9,7,4},{8,10,12,11,9},{2,1,13,16,17,15},{18,3,2,19,21,20},{4,22,23,24,25,5},{5,26,27,28,14,1},{21,30,31,29,20},{23,32,33,34,35},{12,36,39,38,37,11},{39,40,42,41,38},{17,16,44,45,43},{27,46,47,48,28},{50,43,45,49,52,51},{51,52,54,55,53},{47,56,58,59,57,48},{58,60,62,61,59},{66,64,63,18,20,65},{70,69,68,64,66,67},{73,66,65,74,75,76},{78,77,71,69,70,72},{81,79,73,76,80},{82,85,84,83,7,9},{85,86,89,88,87,84},{91,15,17,90,93,92},{94,92,93,95,97,96},{98,96,97,99,101,100},{103,100,101,102,105,104},{26,106,108,109,107,27},{108,110,112,113,111,109},{113,114,116,115,111},{112,117,120,119,118,113},{119,122,123,124,121,118},{120,125,128,127,126,119},{127,129,131,130,126},
{109,133,134,136,132,107},{134,137,140,139,138,136},{140,142,143,144,141,139},{28,145,148,147,146,14},{147,148,150,152,151,149},{151,152,154,156,155,153},{156,157,160,159,158,155}
};

Sort[f]

vn=N[v];
e=Union[Sort/@Flatten[Partition[#,2,1,1]&/@f,1]];
Length[edges=SplitBy[Sort[{Round[EuclideanDistance@@vn[[#]]1000],#}&/@e],First][[All,All,2]]]

Graphics[{Transpose[{{Red,Hue[.5]},Map[Line[vn[[#]]]&,edges,{2}]}],MapIndexed[Text[#2[[1]],#,Background->White]&,vn]}]

Length[f]

PolyhedronData[{"Goldberg",{2,0}},"F"]

<<MathWorld`Graphs`

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

PolyhedronData[{"Goldberg",{2,0}},"SurfaceArea"]

PolyhedronDataString

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

WriteString[file,PolyhedronDataString[poly,
"StandardName"->"CanonicalChamferedDodecahedron",
"Name"->"(2,0) Goldberg polyhedron",
"NotationRules"->{"Goldberg"->{2,0}},
"Classes"->{"Goldberg"}
]]

Close[file]

Properties: "EquilateralChamferedDodecahedron"

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

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

ToAlgebraicRoot/@PolyhedronCentroid[p]//Quiet//Timing

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[poly]//Timing

MyCircumsphere[poly]//Timing

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[poly]]//Quiet//Union

PolyhedronEdgeLengths[poly]//RootReduce//Union//Quiet//Timing

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[poly]//FullSimplify//Quiet

RootReduce[%]

FullSimplify[%]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

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

(ii=Map[ToAlgebraicRoot,i,{2}])//Quiet//Timing

iii=RootReduce[(ii/vol)]//FullSimplify

N[iii]

Equal@@Tr[iii,List]

(i=PolyhedronInertiaTensor[poly,vol])//Timing

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[poly]//Timing

MyInsphere[poly]//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

Integrate over polyhedron

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

Integrate

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

Divergence theorem

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

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)

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

Inequalities

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=MinMax/@Transpose[PolyhedronCoordinates[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

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

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

Integrate

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

Divergence theorem

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

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)

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

Integrate over z first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=MinMax/@Transpose[PolyhedronCoordinates[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"]

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

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

RootReduce@rxy2//Timing

ToAlgebraicRoot[rxy2]//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

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

(rxyz2=((Integrate[x^2+y^2+(z^2),{x,y,z}∈poly])/vol))//Timing

RootReduce@rxyz2//Timing

ToAlgebraicRoot[rxyz2]//Timing

Midsphere

PolyhedronData[pname,"Midsphere"]

Midsphere[poly]//Timing

Midsphere[poly,Method->"PointLineDistance","SolveMethod"->"NSolve"]//Timing

Net

PolyhedronData[pname,"Net"]

Total[Area/@Flatten[PolyhedronData[pname,"Net","Polygon"]]]//ToAlgebraicRoot//FullSimplify//Timing

PolyhedronData[pname,"SurfaceArea"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

ineq=Collect[#,{x,y,z},RootReduce]&/@PolyhedronInequalities[poly,{x,y,z}]

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

FullSimplify/@%

FullSimplify@%

Skeleton

PolyhedronData[pname,"Skeleton"]

PolyhedronData[pname,"Skeleton"]//RecognizeGraph

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[poly]//ToAlgebraicRoot//Quiet//Timing

PolyhedronSurfaceArea[poly]//RootReduce//Timing

Volume

PolyhedronData[pname,"Volume"]

Volume[poly]//RootReduce//Timing

Volume[poly]//RootReduce//FullSimplify

PolyhedronVolume[poly]//ToAlgebraicRoot//Quiet//Timing

Volume[PolyhedronData[pname,"Region"]]//RootReduce//Timing

Volume[PolyhedronData[pname,"Region"]]//ToAlgebraicRoot//Timing

Construction

"EquilateralChamferedDodecahedron"

Mangaldan

from Jan Mangaldan, Jun 2022

Graphics3D[EquilateralChamferedDodecahedron=Polyhedron[]]

SkeletonGraph[EquilateralChamferedDodecahedron]//RecognizeGraph

RootReduce[PolyhedronEdgeLengths[EquilateralChamferedDodecahedron]]//Union//Timing

SimplePolyhedronQ[EquilateralChamferedDodecahedron]

Midsphere[EquilateralChamferedDodecahedron]//Timing

Midsphere[EquilateralChamferedDodecahedron,Method->"PointLineDistance","Simplification"->Function[RootReduce[Numerator[Together[#]]]]]//Timing

Weisstein

f[p_,r_?NumericQ]:=Module[{e=PolyhedronEdgeLengths[ChamferedPolyhedron[p,r]]},Divide@@MinMax[e]]

data=Table[{r,f[N@CanonicalizePolyhedron@Dodecahedron[],r]},{r,.1,.9,.01}]//Quiet

ListPlot[data]

peakpos=FindPeaks[data[[All,2]]]

peaks=data[[peakpos[[All,1]]]]

ListLinePlot[
{data,peaks},
Joined->{True,False},
PlotStyle->{Automatic,PointSize[.03]}
]

can=N[CanonicalizePolyhedron[Dodecahedron[]],1000]

({r}=FindArgMax[f[can,r],{r,58/100,60/100},WorkingPrecision->150])//Quiet//Timing

rexact=ToAlgebraicRoot[N[r,50]]//FullSimplify

Graphics3D[p=ChamferedPolyhedron[N[CanonicalizePolyhedron[Dodecahedron[]],1000],N[rexact,1000]]]//Quiet

v2=Map[ToAlgebraicRoot,Chop[p[[1]]],{2}]

Graphics3D[p2=Polyhedron[v2,p[[2]]]]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p2]]//Union

Net Construction

"EquilateralChamferedDodecahedron"

PolyhedronEdgeLengths[PolyhedronData["EquilateralChamferedDodecahedron","Polyhedron"]]//RootReduce//Union//Quiet//Timing

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

pentagon={48,49,50,46,47};
hexagon={47,46,6,27,26,2};

ind=Union[pentagon,hexagon]

Graphics3D[{Polygon[v[[#]]]&/@{pentagon,hexagon},Cases[MapIndexed[Text[#2[[1]],#,Background->White]&,v],Text[Alternatives@@ind,__]]},Boxed->False]

Pi ToAlgebraicRoot/@(PolygonAngle[Polygon[v[[pentagon]]]]/Pi)//Union//Quiet//Timing

ArcCos[ToAlgebraicRoot/@(Cos[PolygonAngle[Polygon[v[[hexagon]]]]])]//Quiet//Timing

N[%[[-1]]]

Pentagon and short irregular hexagon sides:

EuclideanDistance@@v[[{77,79}]]//RootReduce

Long hexagon sides:

EuclideanDistance@@v[[{78,79}]]//RootReduce

Asymmetric hexagon angle (big):

VectorAngle[v[[76]]-v[[79]],v[[78]]-v[[79]]]//RootReduce

Symmetric hexagon angle (small):

VectorAngle[v[[72]]-v[[78]],v[[79]]-v[[78]]]//RootReduce

N[{ArcCos[(NumericalApproximation[Root, (RowDefault["-0.526", FEExpressionsNumericalApproximationElider]), Root[1-5 ((#1)^2)+5 ((#1)^4)&,2], ])],ArcCos[-(1/(Sqrt[5]))]}]

ArcCos[ToAlgebraicRoot/@Cos[PolygonAngle[Polygon@pentagon]]]//Quiet//Union//FullSimplify

ArcCos[ToAlgebraicRoot/@Cos[PolygonAngle[Polygon@hexagon]]]//Quiet//FullSimplify

Tally[%95]

N[%]

Import["https://upload.wikimedia.org/wikipedia/commons/2/25/Truncated_rhombic_triacontahedron_net.png"]

pentagons and irregular hexagons have unit edge length

{big=ArcCos[(NumericalApproximation[Root, (RowDefault["-0.526", FEExpressionsNumericalApproximationElider]), Root[1-5 ((#1)^2)+5 ((#1)^4)&,2], ])],small=ArcCos[-(1/(Sqrt[5]))]};
a=1;
α=3Pi/5;
m=RotationMatrix;
v=CirclePoints[{Csc[Pi/5]/2,-Pi/2},5];
v=Join[v,{v[[3]]+a m[-big].{-1,0},v[[4]]+a m[big].{1,0}}];
v=Join[v,{{v[[3,1]],y=v[[6,2]]+(v[[6,2]]-v[[3,2]])},{v[[4,1]],y}}];
v=Join[v,{v[[8]]+m[-α].{-1,0},v[[9]]+m[α].{1,0}}];
v=Join[v,{v[[11]]+m[α].(v[[9]]-v[[11]]),v[[1]]+a m[-big].(v[[2]]-v[[1]]),v[[1]]+a m[big].(v[[5]]-v[[1]]),v[[2]]+a m[big].(v[[1]]-v[[2]])}];
v=Join[v,{v[[13]]+m[-small].(v[[1]]-v[[13]]),v[[15]]+m[small].(v[[2]]-v[[15]])}];
v=Join[v,{v[[3]]+a m[big].(v[[2]]-v[[3]]),v[[2]]+a m[-big].(v[[3]]-v[[2]])}];
v=Join[v,{v[[18]]+m[small].(v[[3]]-v[[18]]),v[[19]]+m[-small].(v[[2]]-v[[19]])}];
v=Join[v,{-#,#2}&@@@v[[{18,20,21,19,15,17,16}]]];
v=Join[v,{v[[20]]+m[α].(v[[21]]-v[[20]]),v[[21]]+m[-α].(v[[20]]-v[[21]])}];
v=Join[v,{v[[29]]+m[α].(v[[20]]-v[[29]])}];
v=Join[v,{-#,#2}&@@@v[[{29,31,30,21}]]];
v=Join[v,{v[[12]]+a m[-big].(v[[11]]-v[[12]]),v[[11]]+a m[big].(v[[12]]-v[[11]])}];
v=Join[v,{v[[37]]+m[small].(v[[11]]-v[[37]]),v[[36]]+m[-small].(v[[12]]-v[[36]])}];
v=Join[v,{v[[39]]+m[-α].(v[[38]]-v[[39]]),v[[38]]+m[α].(v[[39]]-v[[38]])}];
v=Join[v,{v[[41]]+m[α].(v[[38]]-v[[41]])}];
v=Join[v,{v[[17]]+m[α].(v[[16]]-v[[17]]),v[[16]]+m[-α].(v[[17]]-v[[16]])}];
v=RootReduce@Join[v,{v[[44]]+m[-α].(v[[16]]-v[[44]])}];

v=Join[v,{-#,#2}&@@@v[[{43,45,44}]]];
v=Join[v,{v[[45]]+a m[-big].(v[[43]]-v[[45]]),v[[43]]+a m[big].(v[[45]]-v[[43]])}];
v=Join[v,{v[[50]]+m[small].(v[[43]]-v[[50]]),v[[49]]+m[-small].(v[[45]]-v[[49]])}];
v=Join[v,{v[[51]]+m[α].(v[[52]]-v[[51]]),v[[52]]+m[-α].(v[[51]]-v[[52]])}];
v=Join[v,{v[[53]]+m[α].(v[[51]]-v[[53]])}];
v=Join[v,{v[[47]]+a m[-big].{1,0},v[[48]]+a m[big].(v[[47]]-v[[48]])}];
v=Join[v,{v[[56]]+m[-small].(v[[47]]-v[[56]]),v[[57]]+m[small].(v[[48]]-v[[57]])}];
v=Join[v,{v[[58]]+m[-α].(v[[59]]-v[[58]]),v[[59]]+m[α].{-1,0}}];
v=Join[v,{v[[60]]+m[-α].(v[[58]]-v[[60]])}];
v=Join[v,{v[[18]]+m[small].(v[[20]]-v[[18]])}];
v=Join[v,{v[[63]]+m[big].(v[[18]]-v[[63]])/a,v[[20]]+m[-big].(v[[18]]-v[[20]])/a}];
v=Join[v,{v[[64]]+a m[big].(v[[63]]-v[[64]])}];
v=Join[v,{v[[66]]+m[-small].(v[[64]]-v[[66]]),v[[64]]+m[big].(v[[66]]-v[[64]])/a}];
v=Join[v,{v[[68]]+a m[big].(v[[64]]-v[[68]]),v[[67]]+m[-big].(v[[66]]-v[[67]])/a}];
v=Join[v,{v[[69]]+m[small].(v[[70]]-v[[69]]),v[[70]]+m[-big].(v[[69]]-v[[70]])/a,v[[66]]+m[small].(v[[65]]-v[[66]]),v[[65]]+m[-big].(v[[66]]-v[[65]])/a}];
v=Join[v,{v[[74]]+m[-big].(v[[65]]-v[[74]])a,v[[73]]+m[big].(v[[66]]-v[[73]])/a}];
v=Join[v,{v[[71]]+m[big].(v[[69]]-v[[71]])/a,v[[72]]+a m[-big].(v[[70]]-v[[72]])}];
v=Join[v,{v[[73]]+m[α].(v[[76]]-v[[73]]),v[[76]]+m[-α].(v[[73]]-v[[76]])}];
v=Join[v,{v[[79]]+m[α].(v[[73]]-v[[79]])}];
v=Join[v,{v[[9]]+m[-big].(v[[7]]-v[[9]])/a,v[[7]]+m[small].(v[[9]]-v[[7]])}];
v=RootReduce@Join[v,{v[[83]]+m[big].(v[[7]]-v[[83]])/a,v[[82]]+m[-big].(v[[9]]-v[[82]])a}];

v=Join[v,{v[[85]]+m[-small].(v[[84]]-v[[85]]),v[[84]]+m[big].(v[[85]]-v[[84]])/a}];
v=Join[v,{v[[87]]+m[big].(v[[84]]-v[[87]])a,v[[86]]+m[-big].(v[[85]]-v[[86]])/a}];
v=Join[v,{v[[17]]+m[-big].(v[[15]]-v[[17]])/a,v[[15]]+m[small].(v[[17]]-v[[15]])}];
v=Join[v,{v[[91]]+m[big].(v[[15]]-v[[91]])/a,v[[90]]+m[-big].(v[[17]]-v[[90]])a}];
v=Join[v,{v[[92]]+m[big].(v[[93]]-v[[92]])/a,v[[93]]+m[-small].(v[[92]]-v[[93]])}];
v=Join[v,{v[[94]]+m[big].(v[[92]]-v[[94]])a,v[[95]]+m[-big].(v[[93]]-v[[95]])/a}];
v=Join[v,{v[[96]]+m[small].(v[[97]]-v[[96]]),v[[97]]+m[-big].(v[[96]]-v[[97]])/a}];
v=Join[v,{v[[98]]+m[big].(v[[96]]-v[[98]])/a,v[[99]]+m[-big].(v[[97]]-v[[99]])a}];
v=Join[v,{v[[101]]+m[-small].(v[[100]]-v[[101]]),v[[100]]+m[big].(v[[101]]-v[[100]])/a}];
v=Join[v,{v[[103]]+m[big].(v[[100]]-v[[103]])a,v[[102]]+m[-big].(v[[101]]-v[[102]])/a}];
v=Join[v,{v[[26]]+m[-small].(v[[27]]-v[[26]]),v[[27]]+m[big].(v[[26]]-v[[27]])/a}];
v=Join[v,{v[[106]]+m[-big].(v[[26]]-v[[106]])/a,v[[107]]+m[big].(v[[27]]-v[[107]])a}];
v=RootReduce@Join[v,{v[[108]]+m[-big].(v[[109]]-v[[108]])/a,v[[109]]+m[small].(v[[108]]-v[[109]])}];

v=Join[v,{v[[110]]+m[-big].(v[[108]]-v[[110]])a,v[[111]]+m[big].(v[[109]]-v[[111]])/a}];
v=Join[v,{v[[113]]+m[-α].(v[[111]]-v[[113]]),v[[111]]+m[α].(v[[113]]-v[[111]])}];
v=Join[v,{v[[114]]+m[-α].(v[[113]]-v[[114]])}];
v=Join[v,{v[[112]]+m[-small].(v[[113]]-v[[112]]),v[[113]]+m[big].(v[[112]]-v[[113]])/a}];
v=Join[v,{v[[118]]+m[big].(v[[113]]-v[[118]])a,v[[117]]+m[-big].(v[[112]]-v[[117]])/a}];
v=Join[v,{v[[118]]+m[big].(v[[119]]-v[[118]])/a,v[[119]]+m[-small].(v[[118]]-v[[119]])}];
v=Join[v,{v[[122]]+m[-big].(v[[119]]-v[[122]])/a,v[[121]]+a m[big].(v[[118]]-v[[121]])}];
v=Join[v,{v[[120]]+m[-big].(v[[119]]-v[[120]])/a,v[[119]]+m[small].(v[[120]]-v[[119]])}];
v=Join[v,{v[[126]]+m[big].(v[[119]]-v[[126]])/a,v[[125]]+m[-big].(v[[120]]-v[[125]])a}];
v=Join[v,{v[[127]]+m[-α].(v[[126]]-v[[127]]),v[[126]]+m[α].(v[[127]]-v[[126]])}];
v=RootReduce@Join[v,{v[[129]]+m[-α].(v[[127]]-v[[129]])}];

v=Join[v,{v[[107]]+m[big].(v[[109]]-v[[107]])/a,v[[109]]+m[-small].(v[[107]]-v[[109]])}];
v=Join[v,{v[[133]]+m[-big].(v[[109]]-v[[133]])/a,v[[132]]+m[big].(v[[132]]-v[[107]])/a}];
v=Join[v,{v[[134]]+m[-big].(v[[133]]-v[[134]])a}];
v=Join[v,{v[[134]]+m[-big].(v[[136]]-v[[134]])/a,v[[136]]+m[2small].(v[[132]]-v[[136]])}];
v=Join[v,{v[[138]]+m[big].(v[[136]]-v[[138]])/a,v[[137]]+m[-big].(v[[134]]-v[[137]])a}];
v=Join[v,{v[[139]]+m[big].(v[[140]]-v[[139]])/a,v[[140]]+m[-small].(v[[139]]-v[[140]])}];
v=Join[v,{v[[142]]+m[-big].(v[[140]]-v[[142]])/a}];
v=RootReduce@Join[v,{v[[141]]+m[big].(v[[139]]-v[[141]])a}];

(rot=Map[ToAlgebraicRoot,RotationMatrix[RootReduce[-Subtract@@@{v[[{17,15}]],v[[{28,14}]]}]],{2}])//Timing

v=RootReduce@Join[v,(v[[28]]+rot.(v[[#]]-v[[17]]))&/@Range[90,105]];

v

Length[v]

f=Sort[{Range[5],{3,6,8,9,7,4},{8,10,12,11,9},{2,1,13,16,17,15},{18,3,2,19,21,20},{4,22,23,24,25,5},{5,26,27,28,14,1},{21,30,31,29,20},{23,32,33,34,35},{12,36,39,38,37,11},{39,40,42,41,38},{17,16,44,45,43},{27,46,47,48,28},{50,43,45,49,52,51},{51,52,54,55,53},{47,56,58,59,57,48},{58,60,62,61,59},{66,64,63,18,20,65},{70,69,68,64,66,67},{73,66,65,74,75,76},{78,77,71,69,70,72},{81,79,73,76,80},{82,85,84,83,7,9},{85,86,89,88,87,84},{91,15,17,90,93,92},{94,92,93,95,97,96},{98,96,97,99,101,100},{103,100,101,102,105,104},{26,106,108,109,107,27},{108,110,112,113,111,109},{113,114,116,115,111},{112,117,120,119,118,113},{119,122,123,124,121,118},{120,125,128,127,126,119},{127,129,131,130,126},
{109,133,134,136,132,107},{134,137,140,139,138,136},{140,142,143,144,141,139},{28,145,148,147,146,14},{147,148,150,152,151,149},{151,152,154,156,155,153},{156,157,160,159,158,155}
}]

vn=N[v];
e=Union[Sort/@Flatten[Partition[#,2,1,1]&/@f,1]];
Length[edges=SplitBy[Sort[{Round[EuclideanDistance@@vn[[#]]1000],#}&/@e],First][[All,All,2]]]

Graphics[{Transpose[{{Red},Map[Line[vn[[#]]]&,edges,{2}]}],MapIndexed[Text[#2[[1]],#,Background->White]&,vn]}]

Length[f]

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

PolyhedronData["EquilateralChamferedDodecahedron","SurfaceArea"]

GraphData

GraphDataString

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

WriteString[file,PolyhedronDataString[EquilateralChamferedDodecahedron,
"StandardName"->"EquilateralChamferedDodecahedron",
"Name"->"equilateral chamfered dodecahedron",
"AlternateStandardNames"->{"EquilateralTruncatedRhombicTriacontahedron"},
"SymmetryGroup"->"Icosahedral",
"SymmetryGroupString"->"Ih"
]]