Snub Dodecahedron

Author

Eric W. Weisstein
January 5, 2024

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

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

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

Figure

PolyhedronData["SnubDodecahedron","DefaultOrientation"]

With[{pname="SnubDodecahedron"},
GraphicsRow[{
Graphics3D[{Opacity[.8],PolyhedronData[pname,"Polyhedron"]},Boxed->False],
Graphics3D[{PolyhedronData[pname,"Lines"]},Boxed->False],
PolyhedronData[pname,"Net"]
},ImageSize->700]]

Solid

Orientations

PolyhedronData["SnubDodecahedron","Orientations"]

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

Mirror image compound

Show[PolyhedronData[{"SnubDodecahedron",#}],Boxed->False]&/@{"Dextro","Laevo"}

Show[%]

Polyhedron

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

Region

PolyhedronData["SnubDodecahedron","Region"]

Solid and dual

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

Graphics3D[{Opacity[.6],
Red,PolyhedronData["SnubDodecahedron","Polyhedron"],
Green,PolyhedronData["SnubDodecahedron","Dual","Polyhedron"],
Yellow,PolyhedronData["SnubDodecahedron","Midsphere"]},Boxed->False]

Dextro

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

Show[Most@%]

Laevo

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

Show[Most@%]

UniformPolyhedron

uniform=UniformPolyhedron[stdname="SnubDodecahedron"]

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}

Net

PolyhedronData["SnubDodecahedron","Net"]

PolyhedronData["SnubDodecahedron","Net","Colored"]

NetPrintout[PolyhedronData["SnubDodecahedron","Polyhedron"],"Cuboctahedron.pdf"]

Properties

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData["SnubDodecahedron","Centroid"]

ToAlgebraicRoot/@RegionCentroid[PolyhedronData["SnubDodecahedron","Polyhedron"]]//Timing//Quiet

ToAlgebraicRoot/@PolyhedronCentroid[PolyhedronData["SnubDodecahedron","Polyhedron"]]//Timing//Quiet

Circumsphere

PolyhedronData["SnubDodecahedron","Circumsphere"]

Circumsphere[PolyhedronData["SnubDodecahedron","Polyhedron"]]//RootReduce//Timing

(sphere=MyCircumsphere[PolyhedronData["SnubDodecahedron","Polyhedron"]]//RootReduce)//Timing

Graphics3D[{{Opacity[.2],Yellow,sphere},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"]

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

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

PolyhedronData[pname,"ConvexHull"]

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

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhull]]//Tally//Quiet//Timing

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

"Dextro"

dextro={pname,"Dextro"}

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

PolyhedronData[dextro,"ConvexHull","Scale"]

{Graphics3D[{Red,Opacity[.5],PolyhedronData[dextro,"Polyhedron"]}],Graphics3D[{Blue,Opacity[.5],PolyhedronData[dextro,"ConvexHull","Polyhedron"]}]}

Show[%]

"Laevo"

laevo={pname,"Laevo"}

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

PolyhedronData[laevo,"ConvexHull","Scale"]

{Graphics3D[{Red,Opacity[.5],PolyhedronData[laevo,"Polyhedron"]}],Graphics3D[{Blue,Opacity[.5],PolyhedronData[laevo,"ConvexHull","Polyhedron"]}]}

Show[%]

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

dih=PolyhedronData["SnubDodecahedron","DihedralAngles"]

DihedralAngles[p//N]-dih//Abs//Max

SimplifyNumericallyDistinct[DihedralAngles[p],"Simplification"->Function[FullSimplify[RootReduce[#]]],Debug->True]//Timing

{3,3}

Show[Graphics3D[p=poly[[{62,68}]]],Boxed->False]

FullSimplify[π-DihedralAngle@@p]

InputForm[%]

N[%]180/Pi

{3,5}

Show[Graphics3D[p=poly[[{52,88}]]],Boxed->False]

FullSimplify[π-DihedralAngle@@p]

RootReduce[π-ArcCos[4 (Sqrt[(2/(3 (5+(Sqrt[5]))))]) Root[209+964 #1-1952 ((#1)^2)-7360 ((#1)^3)+1536 ((#1)^4)+9216 ((#1)^5)+4096 ((#1)^6)&,4]]]

InputForm[%]

N[%]180/Pi

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]

Faces

PolyhedronFaceList[poly]

Show[GraphicsArray[partition[PolyhedronFaces[poly//N],15]]]

Triangular Faces

RootReduce[Norm[Centroid[Select[poly,Length[#[[1]]]==3&][[1,1]]][[1]]]]

N[%,20]

Pentagonal Faces

RootReduce[Norm[Centroid[Select[poly,Length[#[[1]]]==4&][[1,1]]][[1]]]]

N[%,20]

EdgeLengths

PolyhedronData["SnubDodecahedron","EdgeLengths"]

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

Inradius

PolyhedronData["SnubDodecahedron","Inradius"]

TimeConstrained[Insphere[PolyhedronData["SnubDodecahedron","Polyhedron"]],60]//Timing

MyInsphere[PolyhedronData["SnubDodecahedron","Polyhedron"]]//RootReduce//Timing

InertiaTensor

PolyhedronData["SnubDodecahedron","InertiaTensor"]

((MomentOfInertia[PolyhedronData["SnubDodecahedron","Polyhedron"]])/(Volume[PolyhedronData["SnubDodecahedron","Polyhedron"]]))//RootReduce//Timing

PolyhedronInertiaTensor[PolyhedronData["SnubDodecahedron","Polyhedron"]]//Timing

MeanCylindricalRadius

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

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

N[i]

MeanCylindricalSquareRadius

((NIntegrate[(x^2)+(y^2),{x,y,z}∈PolyhedronData["SnubDodecahedron","Polyhedron"]])/(PolyhedronData["SnubDodecahedron","Volume"]))//FullSimplify

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

N[i]

r=RootApproximant[N[i,1000],64]

N[i-r,5000]

MeanSphericalRadius

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

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

N[i]

MeanSphericalSquareRadius

((NIntegrate[(x^2)+(y^2)+(z^2),{x,y,z}∈PolyhedronData["SnubDodecahedron","Polyhedron"]])/(PolyhedronData["SnubDodecahedron","Volume"]))

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

N[i]

r=RootApproximant[N[i,2000],64]

N[i-r,5000]

Midradius

PolyhedronData["SnubDodecahedron","Midradius"]

Midsphere[PolyhedronData["SnubDodecahedron","Polyhedron"]]//RootReduce//Timing

Surface Area

PolyhedronData["SnubDodecahedron","SurfaceArea"]

RootReduce[%]

SurfaceArea[PolyhedronData["SnubDodecahedron","Polyhedron"]]//RootReduce//Timing

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

Vertex subset hulls

(h=VertexSubsetHulls[Polyhedron["SnubDodecahedron","Polyhedron"],"Platonic","Icosahedra"->False])//Timing

Volume

PolyhedronData["SnubDodecahedron","Volume"]

Volume[PolyhedronData["SnubDodecahedron","Polyhedron"]]//RootReduce//Timing

PolyhedronVolume[PolyhedronData["SnubDodecahedron","Polyhedron"]]//RootReduce//Timing

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Perspective projections

Manipulate[PolyhedronProjectionGraph[PolyhedronData["SnubDodecahedron","Polyhedron"],{a,b,c}],{a,-1,1},{b,-1,1},{c,-1,1}]

{1,(Sqrt[(3/5)]),-(2/(Sqrt[5])),-ArcTan[(1/2) (-7+3 (Sqrt[5]))]}

{.43,.325,-.38}/.43

g=PolyhedronProjectionGraph[PolyhedronData["SnubDodecahedron","Polyhedron"],{1,(Sqrt[(3/5)]),-(2/(Sqrt[5])),-ArcTan[(1/2) (-7+3 (Sqrt[5]))]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[14]]-v[[17]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["SnubDodecahedron","Polyhedron"],{1,x,-y},VertexLabels->"Name"]

v=GraphEmbedding[g];

eqn1=FullSimplify[v[[25]]+v[[17]],x>0&&y>0]

Solve[eqn1==0,{x,y}]//FullSimplify

N[%]

{(1/(Sqrt[3])),-1,-(NumericalApproximation[Root, (RowDefault["0.221", FEExpressionsNumericalApproximationElider]), Root[1-21 ((#1)^2)+9 ((#1)^4)&,3], ]),-ArcCot[(Sqrt[13+(22/(Sqrt[5]))])]}

{.055,-.095,-.02}/.095

<<MathWorld`Graphs`

g=PolyhedronProjectionGraph[PolyhedronData["SnubDodecahedron","Polyhedron"],{(1/(Sqrt[3])),-1,-(NumericalApproximation[Root, (RowDefault["0.221", FEExpressionsNumericalApproximationElider]), Root[1-21 ((#1)^2)+9 ((#1)^4)&,3], ]),-ArcCot[(Sqrt[13+(22/(Sqrt[5]))])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[32]]-v[[49]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["SnubDodecahedron","Polyhedron"],{x,-1,-y},VertexLabels->"Name"];

v=GraphEmbedding[g];

eqn=FullSimplify[#.#&/@v[[{7,32,58}]],x>0&&y>0]

NSolve[Equal@@eqn,{x,y},PositiveReals]

eqn2=FullSimplify[Subtract@@@Partition[eqn,2,1]]

eqn3=Numerator[eqn2]

NSolve[eqn3,{x,y},PositiveReals]

(gbx=GroebnerBasis[eqn3,x,y,MonomialOrder->EliminationOrder])//Timing

RootReduce[gbx]

FindInstance[%[[1]]==0,x,PositiveReals]

xsoln=(NumericalApproximation[Root, (RowDefault["0.577", FEExpressionsNumericalApproximationElider]), Root[{2771534068103509428752697362743296+4875218738582837403702864642048 #1-4091998751617749884354691072 ((#1)^2)-579331606175175267717120 ((#1)^3)+42430253385417984 ((#1)^4)-326265408 ((#1)^5)+((#1)^6)&,220024550806326739553716870220599380255175398012605294109639901328518938624-13920720140009609423794984028119208659410569879206061927513116901376 ((#2)^2)+229907996138302290407956881936939327124791020627913313615872 ((#2)^4)-326002040400748053008179673860665871384424057143296 ((#2)^6)+48796055539738787061179432979922944 ((#2)^8)+396755078845427712 ((#2)^10)+((#2)^12)&,«1»&,«1»&,-22461797925142320464455117307904-142256442275270258317562216448 #5-81388499581154720587972608 ((#5)^2)+63203238051947807330304 ((#5)^3)+4698766569629952 ((#5)^4)+118459584 ((#5)^5)+((#5)^6)&,#5+#4 #6+#3 ((#6)^2)+#2 ((#6)^3)+#1 ((#6)^4)&},«1»], ]);

xapprox=RootApproximant[N[xsoln,1000],64]

N[xapprox-xsoln,2000]

InputForm[%33]

(gby=GroebnerBasis[eqn3,y,x,MonomialOrder->EliminationOrder])//Timing

RootReduce[gby]

FindInstance[%[[1]]==0,y,PositiveReals]

InputForm[%37]

ysoln=Root[{2771534068103509428752697362743296+4875218738582837403702864642048*#1-4091998751617749884354691072*#1^2-579331606175175267717120*#1^3+42430253385417984*#1^4-326265408*#1^5+#1^6&,6137828258716118504490977610297527844939892513527751655639444619264-131710062912970456285958993998537282782264523932469998020198400*#2^2+7573535617807711902039617360111916031215250931126894592*#2^4-15088981544722373911168285015766608968633286656*#2^6+1810954248612494051958587532509184*#2^8+44179859466187776*#2^10+#2^12&,16561588375644630160890720707149824+28310129142840132980393946120192*#3+8019437130483411669656666112*#3^2+425230010493202261721088*#3^3+16450317975518208*#3^4+218105136*#3^5+#3^6&,133129438607673158612715868877325291118843548139145343921096228864-222744987158415779420199337291589270666239026500288448036864*#4^2+24449311489935433642549954005481223088209548434997248*#4^4-184903190017325239836089500580428383214632960*#4^6-929978761207008549113240223744*#4^8-934105733784576*#4^10+#4^12&,505771949792974993631125438464-737424874888464661632516096*#5+342406244939548083093504*#5^2-49462229962063687680*#5^3+43586256909312*#5^4-15349824*#5^5+#5^6&,#5+#4*#6+#3*#6^2+#2*#6^3+#1*#6^4&},{4,8,1,1,4,3}];

yapprox=RootApproximant[N[ysoln,1000],64]

N[yapprox-ysoln,2000]

FindInstance[gby[[1]]==0,y,PositiveReals]

InputForm[%40]

RootReduce[%38]

{(NumericalApproximation[Root, (RowDefault["0.372", FEExpressionsNumericalApproximationElider]), Root[2627641-31451802 ((#1)^2)+102899511 ((#1)^4)-94533804 ((#1)^6)+15347799 ((#1)^8)-746010 ((#1)^10)+729 ((#1)^12)&,5], ]),1,(NumericalApproximation[Root, (RowDefault["0.402", FEExpressionsNumericalApproximationElider]), Root[4096-113664 ((#1)^2)+1271808 ((#1)^4)-5318784 ((#1)^6)+5360256 ((#1)^8)-1395792 ((#1)^10)+729 ((#1)^12)&,5], ]),ArcTan[(NumericalApproximation[Root, (RowDefault["0.192", FEExpressionsNumericalApproximationElider]), Root[1289-49527 ((#1)^2)+462331 ((#1)^4)-1941444 ((#1)^6)+4223588 ((#1)^8)-4681549 ((#1)^10)+2105401 ((#1)^12)&,5], ])]}

g=PolyhedronProjectionGraph[PolyhedronData["SnubDodecahedron","Polyhedron"],{(NumericalApproximation[Root, (RowDefault["0.372", FEExpressionsNumericalApproximationElider]), Root[2627641-31451802 ((#1)^2)+102899511 ((#1)^4)-94533804 ((#1)^6)+15347799 ((#1)^8)-746010 ((#1)^10)+729 ((#1)^12)&,5], ]),1,(NumericalApproximation[Root, (RowDefault["0.402", FEExpressionsNumericalApproximationElider]), Root[4096-113664 ((#1)^2)+1271808 ((#1)^4)-5318784 ((#1)^6)+5360256 ((#1)^8)-1395792 ((#1)^10)+729 ((#1)^12)&,5], ]),ArcTan[(NumericalApproximation[Root, (RowDefault["0.192", FEExpressionsNumericalApproximationElider]), Root[1289-49527 ((#1)^2)+462331 ((#1)^4)-1941444 ((#1)^6)+4223588 ((#1)^8)-4681549 ((#1)^10)+2105401 ((#1)^12)&,5], ])]},VertexLabels->"Name"]

v=GraphEmbedding[g];

ArcTan@@(v[[50]]-v[[33]])//FullSimplify

g=PolyhedronProjectionGraph[PolyhedronData["SnubDodecahedron","Polyhedron"],{x,1,y},VertexLabels->"Name"]

v=GraphEmbedding[g];

eqn=FullSimplify[v[[12]]-v[[35]],x>0&&y>0]

Solve[Thread[eqn==0],{x,y}]//FullSimplify

Construction

From Uniform

Numeric

Show[Graphics3D[UniformPolyhedron[29]],Boxed->False]

poly=N[Flatten[UniformPolyhedron[29]]]/.Polygon[l_List]:>Polygon[l/e];
FullSimplify[v=(PolyhedronVertices[poly])]//InputForm
First/@poly/.Thread[v->Range[Length[v]]]

Recognize

<<MiscPolyhedra`;
<<Simplify`;
<<PolyhedronOperations`;

p=UniformPolyhedron[29,500];

Map[ToExact[#,16,500,500,10^3]&,p[[1]],{3}]

Map[ToExact[#,8,500,500,10^5]&,p[[1]],{3}]

Map[ToExact[#,8,400,400,10^5]&,N[p[[1]],400],{3}]

Map[ToExact[#,8,500,500,10^5]&,N[p[[1]],500],{3}]

From the Icosahedral Group

v=RootReduce[{1,Root[-1-7 #1-14 #1^2-9 #1^3-7 #1^4+6 #1^5+#1^6&,4],Root[-1+#1+2 #1^2+#1^3-#1^4-2 #1^5+#1^6&,4]}/Root[4096-1024 ((#1)^2)+4096 ((#1)^4)-4672 ((#1)^6)+1392 ((#1)^8)-128 ((#1)^10)+((#1)^12)&,5]];
Show[Graphics3D[poly=ConvexHull3D[#.v&/@HalfIcosahedralGroup],Boxed-> False]]

RootReduce[Sqrt[#.#]&[Subtract@@Take[poly[[1,1]],2]]]

poly2=Map[FullSimplify,poly,{3}];//Timing

(v=PolyhedronVertices[poly2])//InputForm
First/@poly2/.Thread[v->Range[Length[v]]]

Via Snubification

Laevo

v=Select[Flatten[Polyhedron[SnubDodecahedron]],Length[#[[1]]]==5&];
c=Centroid/@v;
axes=Select[KSubsets[c,2],Norm[Cross@@#]<.01&];

RootReduce[Root[961-20600 ((#1)^2)+53040 ((#1)^4)+424000 ((#1)^6)-460800 ((#1)^8)-1920000 ((#1)^10)+512000 ((#1)^12)&,8]-Inradius[Dodecahedron]]

r=Root[630125-51896000 ((#1)^2)+1325073600 ((#1)^4)-15468736000 ((#1)^6)+95108400640 ((#1)^8)-330140037120 ((#1)^10)+674629492736 ((#1)^12)-850532761600 ((#1)^14)+704411402240 ((#1)^16)-397017088000 ((#1)^18)+143602483200 ((#1)^20)-31457280000 ((#1)^22)+2097152000 ((#1)^24)&,15];

Show[Graphics3D[{v,Line/@axes}],Boxed->False]

l={Centroid[#],#[[1,1]]}&/@v[[{10,4}]];

Show[Graphics3D[{ClosedLine@@@v[[{10,4}]],Line/@{axes[[3]]},Hue[0],Line/@l}],Boxed->False]

Show[Graphics3D[{ClosedLine@@@v[[{10,4}]],Line/@{axes[[3]]},Hue[0],Line/@l}],Boxed->False,ViewPoint->{-2,-1.2,0}]

Show[Graphics[{Line[{{1,0},{0,0},Through[{Cos,Sin}[θ]]}]}],AspectRatio->Automatic]

f2[x_?NumericQ]:=f2[x]=(
Print[x];
Max[Abs[PolyhedronEdgeLengths[Snubify[Polyhedron[Dodecahedron],r,x]]-1]]
)

FindMinimum[f2[x],{x,.2,.3},WorkingPrecision->20]

θ=ArcCos[N[Dot@@(Unit/@(Subtract@@@l))]]

θ/2

a=Pi/2-Table[0.22874989202203283+2Pi i/10,{i,-5,5}]

((3 π)/10)-ArcCos[Dot@@(Unit/@(Subtract@@@l))]/2.

<<Utilities`Simplify`

ToExact[Dot@@(Unit/@(Subtract@@@l)),WorkingPrecision->500,CheckPrecision->1000,Weight->10]

N[Dot@@(Unit/@(Subtract@@@l))-Root[59-306 #1-800 ((#1)^2)+240 ((#1)^3)+800 ((#1)^4)+64 ((#1)^5)+64 ((#1)^6)&,3],2000]

FullSimplify[FullSimplify[TrigExpand[Cos[3Pi/10-ArcCos[x]/2]],0<x<1]/.Sin[y_/2]:>Sqrt[(1-Cos[y])/2]]

{(1/4) ((Sqrt[3+(Sqrt[5])]) (Sqrt[1-x])+(Sqrt[-(-5+(Sqrt[5])) (1+x)])),Cos[3Pi/10-ArcCos[x]/2]}/.x->Root[59-306 #1-800 ((#1)^2)+240 ((#1)^3)+800 ((#1)^4)+64 ((#1)^5)+64 ((#1)^6)&,3]//N

RootReduce[(1/4) ((Sqrt[3+(Sqrt[5])]) (Sqrt[1-x])+(Sqrt[-(-5+(Sqrt[5])) (1+x)]))/.x->Root[59-306 #1-800 ((#1)^2)+240 ((#1)^3)+800 ((#1)^4)+64 ((#1)^5)+64 ((#1)^6)&,3]]

θ=Root[1-2996 ((#1)^2)+9520 ((#1)^4)-3840 ((#1)^6)-7680 ((#1)^8)+1024 ((#1)^10)+4096 ((#1)^12)&,8]

N[ArcCos[θ],30]

Show[Graphics3D[p=Snubify[Polyhedron[Dodecahedron],r,ArcCos[θ]]],Boxed->False]//Timing

PolyhedronVertices[p]//Length//Timing

ToExact[#,WorkingPrecision->100,CheckPrecision->200]&/@PolyhedronEdgeLengths[p]//Timing

<<Utilities`Simplify`

poly1=Map[ExactRoot[#,12]&,N[p,100],{4}];//Timing

poly=Orient[poly1];//Timing

And@@OrientedQ[poly]

(v=PolyhedronVertices[poly])//InputForm
First/@poly/.Thread[v->Range[Length[v]]]

Dextro

Show[Graphics3D[p=Snubify[Polyhedron[Dodecahedron],r,-ArcCos[θ]]],Boxed->False]//Timing

ToExact[#,WorkingPrecision->100,CheckPrecision->200]&/@PolyhedronEdgeLengths[p]//Timing

poly2=Orient[Map[ExactRoot[#,12]&,N[p,100],{4}]];//Timing

poly=poly2;

And@@(OrientedQ/@poly)

(v=PolyhedronVertices[poly])//InputForm
First/@poly/.Thread[v->Range[Length[v]]]