Dodecahedron-Small Triambic Icosahedron Compound

Author

Eric W. Weisstein
September 28, 2023

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polyhedra/Dodecahedron-SmallTriambicIcosahedronCompound.nb.

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

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

Hull variants

variants={"DodecahedronSmallTriambicIcosahedronCompound","DodecahedronSmallTriambicIcosahedronCompoundHull"};

PolyhedronData/@variants

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

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

Variants

<<MathWorld`Polyhedra`

variants=Most@PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound*"]

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

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

Polyhedra

GraphicsGrid[Identity[{
Graphics3D[{PolyhedronData[#,"Polyhedron"]},Boxed->False],
With[{poly=PolyhedronData[#,"Polyhedra"]},Graphics3D[Table[{Hue[(i/(Length[poly]))],poly[[i]]},{i,Length[poly]}],Boxed->False]]
}&/@variants],Dividers->All,ImageSize->400]

Solids and duals

GraphicsGrid[
Table[
With[
{
s={Yellow,PolyhedronData[pname,"Midsphere"]},
dname=PolyhedronData[pname,"Dual","Name"],
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]]
}],
{pname,variants}
],
Dividers->All,ImageSize->800,Alignment->Top
]

Interior and convex hull

GraphicsGrid[
With[{style=Directive[Black,Italic,FontFamily->"Times",16]},
Table[{
Graphics3D[PolyhedronData[pname,"Polyhedron"],PlotLabel->TextCell[Style[PolyhedronData[pname,"Name"],style],PageWidth->200,TextAlignment->Center],Boxed->False],
Graphics3D[{AbsoluteThickness[.5],PolyhedronData[pname,"Lines"],Opacity[.8],PolyhedronData[pname,"CompoundInterior","Polyhedron"]},PlotLabel->Style["interior",style],Boxed->False],
Graphics3D[{
{EdgeForm[None],PolyhedronData[pname,"Polyhedron"]},
{Opacity[.7],EdgeForm[Thickness[.005]],PolyhedronData[pname,"ConvexHull","Polyhedron"]}},PlotLabel->Style["convex hull",style],Boxed->False]
},
{pname,variants}]
],
Dividers->All,ImageSize->700]

TextGrid[
Prepend[
Table[{
pname,
RecognizeGraph@PolyhedronGraph@PolyhedronData[pname,"CompoundInterior","Polyhedron"],
RecognizeGraph@PolyhedronGraph@PolyhedronData[pname,"ConvexHull","Polyhedron"]
},
{pname,variants}],
Thread[Style[{"compound","interior","convex hull"},Bold]]],
Dividers->All]

Properties: "DodecahedronSmallTriambicIcosahedronCompound"

Initialization

<<MathWorld`Polyhedra`

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

AdjacenctFaceIndices

AdjacentFaceIndices[p]

Classes

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Classes"]

Circumsphere

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Circumsphere"]

Norm/@PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","VertexCoordinates"]//FullSimplify//Union

Circumsphere[PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","VertexCoordinates"]]//Head//Quiet

CompoundInterior

intname=PolyhedronData[pname,"CompoundInterior","Name"]

PolyhedronData[pname,"CompoundInterior","Scale"]

rot=PolyhedronData[pname,"CompoundInterior","RotationMatrix"]

PolyhedronData[pname,"CompoundInterior"]

Graphics3D[{
AbsoluteThickness[1],PolyhedronData[pname,"Lines"],
Opacity[.8],interior=PolyhedronData[pname,"CompoundInterior","Polyhedron"]},Boxed->False]

Graphics3D[{{Opacity[.2],p},Red,interior},Boxed->False]

Graphics3D[{
AbsoluteThickness[1],PolyhedronData[pname,"Lines"],
Opacity[.8],PolyhedronPolygons@interior},Boxed->False]

Construction

Graphics3D[int=RegionIntersection[Sequence@@PolyhedronData[pname,"Polyhedra"],PerformanceGoal->"Quality"]]

Graphics3D[PolyhedronData[{"Uniform",30},"Polygons"]/.Polygon[p__]:>WindingPolygon[p,"NonzeroRule"]]

Graphics3D[LabelPolyhedron@PolyhedronData[{"Uniform",30},"Polyhedron"]]

v=PolyhedronData[{"Uniform",30},"VertexCoordinates"];

rot=RotationMatrix[Pi/5,{0,0,1}].RotationMatrix[{Mean[v[[{10,9,3,2,13}]]],Mean[v[[{2,13}]]]}]//FullSimplify

rot={{(Sqrt[(1/4)+(1/(2 (Sqrt[5])))]),(NumericalApproximation[Root, (RowDefault["-0.588", FEExpressionsNumericalApproximationElider]), Root[5-20 ((#1)^2)+16 ((#1)^4)&,2], ]),(NumericalApproximation[Root, (RowDefault["-0.425", FEExpressionsNumericalApproximationElider]), Root[1-20 ((#1)^2)+80 ((#1)^4)&,1], ])},{(1/2),(1/4) (1+(Sqrt[5])),(1/4) (1-(Sqrt[5]))},{(NumericalApproximation[Root, (RowDefault["0.526", FEExpressionsNumericalApproximationElider]), Root[1-5 ((#1)^2)+5 ((#1)^4)&,3], ]),0,(Sqrt[(1/10) (5+(Sqrt[5]))])}};

((Max[Norm/@PolyhedronData["SmallDitrigonalIcosidodecahedronHull","VertexCoordinates"]])/(Max[Norm/@int[[1]]]))

{Graphics3D[{Opacity[.2],Red,int}],Graphics3D[{Opacity[.2],Blue,p1=Polyhedron[1/(Sqrt[2])rot.#&/@PolyhedronData["SmallDitrigonalIcosidodecahedronHull","VertexCoordinates"],PolyhedronData["SmallDitrigonalIcosidodecahedronHull","FaceIndices"]]}]}

Show[%]

1/(Sqrt[2])rot.#&/@PolyhedronData["SmallDitrigonalIcosidodecahedronHull","VertexCoordinates"]//FullSimplify

Sort[PolyhedronData["SmallDitrigonalIcosidodecahedronHull","FaceIndices"]]

Convex

ConvexPolyhedronQ[p]//Timing

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Convex"]

ConvexHull

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

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

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

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

Counts[SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhull]]]

Keys[%]//N

RecognizeGraph@PolyhedronGraph@convexhull

PolyhedronData["PentakisDodecahedron","EdgeLengths"]

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

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

ArcTan@@(Most@Mean[newv[[{7,29}]]])//FullSimplify

rot2=RotationMatrix[Pi/2+2Pi/5,{0,0,1}].rot//FullSimplify

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

DihedralAngles

SimplifyNumericallyDistinct[DihedralAngles[p]]

EdgeCount

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","E"]

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Edges"]//Length

FaceCount

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","F"]

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","FaceIndices"]//Length

Faces

Union@@PolyhedronData[#,"FaceCountRules"]&/@{"SmallTriambicIcosahedron","Dodecahedron"}

GeneralizedDiameter

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

Hull

((Max[Norm/@PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","VertexCoordinates"]])/(Max[Norm/@PolyhedronData["DodecahedronSmallTriambicIcosahedronCompoundHull","VertexCoordinates"]]))//FullSimplify

N[%]

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Hull",#]&/@{"Name","Scale"}

With[{p="DodecahedronSmallTriambicIcosahedronCompound"},{
Graphics3D[{Opacity[.5],Red,PolyhedronData[p,"Polyhedron"]},Axes->True],
Graphics3D[{Opacity[.5],Green,PolyhedronData[p,"Hull","Polyhedron"]},Axes->True]
}]

Show[%]

Insphere

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Insphere"]

Insphere[PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","VertexCoordinates"]]//Head//Quiet

Midsphere

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Midsphere"]

Midsphere[p]//Timing

Oriented

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

Polyhedra

Graphics3D/@PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Polyhedra"]

Graphics3D[{FaceForm[Green,Red],PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Polyhedra"]}]

Simple

SimplePolyhedronQ[p]

Skeleton

g=PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Skeleton"]

r=RecognizeGraph[g]

SurfaceArea

Total[PolyhedronSurfaceArea/@PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Polyhedra"]]//RootReduce//FullSimplify

N[%]

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","SurfaceArea"]

N[%]

VertexCount

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","V"]

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Vertices"]//Length

VertexSubsetHulls

VertexSubsetHulls[p,"Platonic"]

Volume

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Volume"]

Total[Volume/@PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Polyhedra"]]//FullSimplify

N[%]

Total[PolyhedronVolume/@PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Polyhedra"]]//N

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

Properties: "DodecahedronSmallTriambicIcosahedronCompoundHull"

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Faces

Pieces

a={(1/2) (Sqrt[(1/10) (373-161 (Sqrt[5])-4 (Sqrt[10-2 (Sqrt[5])]))]),(Sqrt[(363/40)-(159/(8 (Sqrt[5])))]),(Sqrt[(2/5)]),(1/10) (5+(Sqrt[5]))};

a//N

h=Sqrt[a[[2]]^2-a[[4]]^2/4];
x=a[[4]]/2;

Show[Graphics[{
Line[{{-x,0},{0,h},{x,0},{0,-h},{-x,0},{x,0}}]
},AspectRatio->Automatic]
]

soln=NSolve[{xx^2+yy^2==a[[3]]^2,(xx-a[[1]])^2+yy^2==a[[2]]^2},{xx,yy}][[1]]

solns=Map[RootReduce,{xx,yy}/.Solve[{xx^2+yy^2==a[[3]]^2,(xx-a[[1]])^2+yy^2==a[[2]]^2},{xx,yy}],{2}]

N[solns]

soln=solns[[2]]

Show[Graphics[net={
Line[{0,1/10}+#&/@{{0,0},{xx,yy},{a[[1]],0},{0,0}}],
Line[{0,-1/10}+#&/@{{0,0},{xx,-yy},{a[[1]],0},{0,0}}],Line[{1,0}+#&/@{{-x,0},{0,h},{x,0},{0,-h},{-x,0},{x,0}}]
}/.Thread[{xx,yy}->soln],AspectRatio->Automatic,PlotRange->All]]

net2=Map[RootReduce,net,{3}]

InputForm[v=Union[Flatten[First/@net2,1]]]

Drop[First[#],-1]&/@net2/.Thread[v->Range[Length[v]]]

<<MiscPolyhedra`

Show[Graphics[Net[DodecahedronSmallTriambicIcosahedronCompound,Labeled->True]],AspectRatio->Automatic]

Show[Graphics[NetDiagram[DodecahedronSmallTriambicIcosahedronCompound]],AspectRatio->Automatic]

s=Simplify/@ToExact/@NetEdgeLengths[DodecahedronSmallTriambicIcosahedronCompound]

sides=ToRadicals/@Sort[Union[s],Less]

sides//N

lengths=Sort[Transpose[{s/.Thread[sides->Range[Length[sides]]],NetEdges[DodecahedronSmallTriambicIcosahedronCompound]}]]

Stars

Show[Graphics3D[poly[[2]]],Boxed->False]

Show[Graphics3D[poly[[2,5]]],Boxed->False]

Show[Graphics3D[poly[[2,5,1]]],Boxed->False]

Centroid

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompoundHull","Centroid"]

((RegionCentroid[p//N])/vol)

PolyhedronCentroid[p//N,PolyhedronData[pname,"Volume"]]

bug(410184): RegionCentroid[PolyhedronData["Echidnahedron", "Polyhedron"]] gives incorrect non-zero coordinates

(i=((RegionCentroid[p])/vol))//Quiet//Timing

N[i,20]

(i=ToAlgebraicRoot/@PolyhedronCentroid[p])//Quiet//Timing

Circumsphere

Circumsphere[p]

MyCircumsphere[p]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]

DihedralAngles

Tally[PolyhedronData["DodecahedronSmallTriambicIcosahedronCompoundHull","DihedralAngles"]]

di=SimplifyNumericallyDistinct[DihedralAngles[p],"Simplification"->RootReduce,Debug->True]

Length[di]

dis=RootReduce//@di;//Timing

dis

Union[N[dis],SameTest->(Abs[#1-#2]<10^-5&)]

dihedralAngles[poly_]:=Module[{adj=AdjacentFaceIndices[Flatten[poly]],v=PolyhedronVertices[poly],rules},rules=Thread[Range[Length[v]]->v];
(Pi-dihedralAngle@@(N@Polygon/@PolyhedronFaces[poly][[#]]/.rules))&/@adj]

Numerical

di=DihedralAngles[N[Flatten[Normal[PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Faces"]]],200]];

Take[di,10]//N

Union[N[di,100]]

EdgeLengths

a=Sort[PolyhedronEdgeLengths[poly]//FullSimplify,Less]

N[a]

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","EdgeLengths"]//FullSimplify

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

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

(i=PolyhedronInertiaTensor[N[p,1000]])//Timing

Map[ToAlgebraicRoot,i,{2}]

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[p,"Simplification"->FullSimplify]

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

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

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

N[i]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

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

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

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

ToAlgebraicRoot[%]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

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

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

N[i]

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

N[%]

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

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

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

ToAlgebraicRoot[rxyz2]//Timing

Midsphere

PolyhedronData[pname,"Midsphere"]

Midsphere[p,"Simplification"->Simplify,Debug->True]//Timing

Orientation

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

SurfaceArea

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompoundHull","SurfaceArea"]

SurfaceArea[p]//N

SurfaceArea[p]//ToAlgebraicRoot//Timing

PolyhedronSurfaceArea[p]//ToAlgebraicRoot//Timing

Volume

PolyhedronData["DodecahedronSmallTriambicIcosahedronCompoundHull","Volume"]

Volume[p]//N

Volume[p]//FullSimplify//Timing

PolyhedronVolume[p]//N

PolyhedronVolume[p]//ToAlgebraicRoot//Timing

Convex Hull

hull=ConvexHull3D[PolyhedronVertices[poly]];

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

FullSimplify[PolyhedronEdgeLengths[hull]]

pd=1/19(18Sqrt[5]-9)/(3/2(Sqrt[5]-1));
hu=Sqrt[2/5]/((5+Sqrt[5])/10);

N[{pd,hu},20]

So it's not quite a pentakis dodecahedron

Construction: Split

FullSimplify[PolyhedronEdgeLengths[Polyhedron[SmallTriambicIcosahedron]]]

Show[Graphics3D[Polyhedron[SmallTriambicIcosahedron]],Boxed->False]

addn[n_,k_,m_]:=Mod[n+k-1,m]+1

unit[v_List]:=v/norm[v]

pentagram[{apex_,v0_List}]:=Module[{v=OrientPolygon[Convexify[Polygon[v0]]/.Polygon:>Identity]/.Polygon:>Identity,plpt,i},plpt=Table[(v[[i]]+v[[addn[i,1,5]]])/2+(Sqrt[5]-2)unit[v[[addn[i,-2,5]]]-(v[[i]]+v[[addn[i,1,5]]])/2],{i,5}];
Table[Polygon[Reverse[#]]&/@{{plpt[[i]],v[[addn[i,1,5]]],v[[i]]},{v[[i]],apex,plpt[[i]]},{v[[addn[i,1,5]]],plpt[[i]],apex}},{i,5}]]

norm[a_List,b_List]:=norm[a-b]

norm[v_List]:=Sqrt[v.v]

normsq[a_List,b_List]:=normsq[a-b]

normsq[v_List]:=v.v

(*Dodecahedron Small Triambic Icosahedron Compound*)DodecahedronSmallTriambicIcosahedronExact:=Module[{v=PolyhedronVertices[Polyhedron[SmallTriambicIcosahedron]],i,eps=.01},pentagram/@Select[Table[{v[[i]],Select[v,Abs[normsq[#-v[[i]]]-2/5]<eps&]},{i,Length[v]}],Length[#[[2]]]==5&]]

Show[Graphics3D[dst=DodecahedronSmallTriambicIcosahedronExact],Boxed->False]

poly=Flatten[dst];
FullSimplify[v=PolyhedronVertices[poly]]//InputForm
First/@poly/.Thread[v->Range[Length[v]]]

v[[5]]//FullSimplify

Map[RootReduce,v,{2}]//InputForm

Construction: Compound  (Original)

dodv=FullSimplify[ Normalize/@PolyhedronData["Dodecahedron","VertexCoordinates"]];

Graphics3D[{MapIndexed[Text[#2[[1]],#,Background->White]&,dodv],dod=Polyhedron[dodv,PolyhedronData["Dodecahedron","FaceIndices"]]}]

d1=dodv[[11]]

Graphics3D[{dod,MapIndexed[Text[#2[[1]],#,Background->White]&,stv=PolyhedronData["SmallTriambicIcosahedron","VertexCoordinates"]],PolyhedronData["SmallTriambicIcosahedron","Polyhedron"]}]

d2=stv[[12]]

d2/d1//FullSimplify

%//FullSimplify

dodv2=FullSimplify[(1/4) (Sqrt[21+9 (Sqrt[5])]) Normalize/@PolyhedronData["Dodecahedron","VertexCoordinates"]];

Graphics3D[{MapIndexed[Text[#2[[1]],#,Background->White]&,dodv2],dod2=Polyhedron[dodv2,PolyhedronData["Dodecahedron","FaceIndices"]]}]

d3=dodv2[[11]]

d2

d3-d2

Graphics3D[{dod2,PolyhedronData["SmallTriambicIcosahedron","Polyhedron"]}]

PolyhedronData["SmallTriambicIcosahedron","EdgeLengths"]

N[%]

PolyhedronData["Dodecahedron","EdgeIndices"]

EuclideanDistance@@dodv2[[{1,14}]]//FullSimplify

N[%]

v=Join[dodv2,PolyhedronData["SmallTriambicIcosahedron","VertexCoordinates"]]//FullSimplify

Length[v]

DeleteDuplicates[v]//Length

FullSimplify[v]//Union//Length

commonrules=Rule@@@Reverse/@Select[SplitBy[SortBy[MapIndexed[{#,#2[[1]]}&,v],First],First],Length[#]>1&][[All,All,-1]]

Length[commonrules]

Graphics3D[Polyhedron[PolyhedronData[#,"VertexCoordinates"],PolyhedronData[#,"FaceIndices"]]]&/@{"Dodecahedron","SmallTriambicIcosahedron"}

PolyhedronData["Dodecahedron","V"]

faces0=Join[PolyhedronData["Dodecahedron","FaceIndices"],20+PolyhedronData["SmallTriambicIcosahedron","FaceIndices"]]/.commonrules

Flatten[faces0]//Union//Length

Flatten[faces0]//Max

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

faces=SmallestRotation/@(faces0/.Thread[Union[Flatten[faces0]]->Range[38]])

DeleteDuplicates[v]

Length[%185]

Length[faces]

Union[Flatten[faces]]===Range[38]

p=Polyhedron[DeleteDuplicates[v],faces]

Graphics3D[p]

<<MathWorld`PolyhedronOperations`

AdjacentFaceIndices[p]

SimplifyNumericallyDistinct[DihedralAngles[p],Debug->True]

Construction: Compound (fix duplicated vertices that don't FullSimplify to each other)

v=PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","Vertices"];

DeleteDuplicates[v]===v

DeleteDuplicates[N[v,20]]===N[v,20]

v//Length

FullSimplify[v]//Union//Length

FullSimplify[RootReduce[v]]//Union//Length

EqualDistancePointSets[v_]:=sets={#[[1,1]],Length[#],#[[All,2]]}&/@SplitBy[SortBy[MapIndexed[{#,#2[[1]]}&,FullSimplify[RootReduce[Norm/@v]]],First],First]

sets=EqualDistancePointSets[v]

unique=SortBy[SplitBy[SortBy[MapIndexed[{#2[[1]],FullSimplify[RootReduce[#]]}&,v],Last],Last][[All,All,1]],First]

v[[unique[[All,1]]]]

rules=MapIndexed[Thread[Rule[#,#2[[1]]]]&,unique]//Flatten

Length@unique

rules

newfaces=PolyhedronData["DodecahedronSmallTriambicIcosahedronCompound","FaceIndices"]/.rules

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

f2=Sort[SmallestRotation/@newfaces]

DeleteDuplicates[f2]===f2

Length[f2]

Union[Sort/@Flatten[Partition[#,2,1,1]&/@f2,1]]//Length

Graphics3D[p=Polyhedron[v[[unique[[All,1]]]],f2]]