Tetrahedron 2-Compound

Author

Eric W. Weisstein
October 5, 2023

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polyhedra/Tetrahedron2-Compound.nb.

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

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

Variants

variants=PolyhedronData["TetrahedronTwoCompound*"]

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

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

Polyhedra

GraphicsGrid[Transpose[{
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]

Polyhedron: {"TetrahedronTwoCompound", 1}

Orientations

PolyhedronData[{"TetrahedronTwoCompound",1},"Orientations"]

PolyhedronData[{"TetrahedronTwoCompound",1},"DefaultOrientation"]

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

Polyhedron

Graphics3D[{Opacity[.8],PolyhedronData[{"TetrahedronTwoCompound",1},"Polyhedron"]}]

Face orientation

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

Region

PolyhedronData[{"TetrahedronTwoCompound",1},"Region"]

Solid and dual

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

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

Polyhedron: {"TetrahedronTwoCompound", 2}

Orientations

PolyhedronData[{"TetrahedronTwoCompound",2},"Orientations"]

PolyhedronData[{"TetrahedronTwoCompound",2},"DefaultOrientation"]

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

Polyhedron

Graphics3D[{Opacity[.8],PolyhedronData[{"TetrahedronTwoCompound",2},"Polyhedron"]}]

Face orientation

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

Region

PolyhedronData[{"TetrahedronTwoCompound",2},"Region"]

Solid and dual

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

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

Properties: {"TetrahedronTwoCompound", 1}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"TetrahedronTwoCompound",1},"Polyhedron"]

AdjacentFaceIndices

adj1=PolyhedronData[pname,"AdjacentFaceIndices"]

adj2=AdjacentFaceIndices[p]

adj1===adj2

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Graphics3D[{{Opacity[.2],Yellow,sphere},p},Boxed->False]

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

CompoundInterior

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

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

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

PolyhedronData[pname,"CompoundInterior"]

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

MyCircumsphere[interior]//Quiet

Insphere[interior]//Quiet

Midsphere[interior]

Construction

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

Graphics3D[int]

Graphics3D[{{Opacity[.3],p},Red,int},Boxed->False]

Union[Chop@int[[1]]]//Length

Exactify

vexact=DeleteDuplicates[RootApproximant[Chop[int[[1]]]]]

Length[vexact]

inthull=ConvexHullRegion[Union@vexact]

v=inthull[[1]]

faces=inthull[[2]]

gname=RecognizeGraph@PolyhedronGraph[inthull]

GraphData[gname,"PolyhedralEmbeddings"]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[inthull]]//Counts//Quiet

Find scale

intname="Octahedron";

Graphics3D[LabelPolyhedron[#]]&/@({p1,i1}=PolyhedronData[#,"Polyhedron"]&/@{pname,intname})

s=((Norm[Mean[p1[[1,{3,7}]]]])/(Norm[i1[[1,4]]]))//RootReduce//FullSimplify//Quiet

Find rotation matrix

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

rot=RotationMatrix[{basev[[4]],Mean@p1[[1]][[{3,7}]]}]//FullSimplify

Graphics3D[{{Opacity[.5],LabelPolyhedron[p1,Background->LightGreen]},
LabelPolyhedron@Polyhedron[newv=s rot.#&/@basesolid[[1]],basesolid[[2]]]},Boxed->False]

rot2=RotationMatrix[θ,Subtract@@newv[[{4,3}]]]

newv2=rot2.#&/@newv;

p1[[1]][{3,6,7}]

Solve[RegionDistance[InfinitePlane[p1[[1]][[{3,6,7}]]],newv2[[5]]]==0&&0<θ<π,θ]//FullSimplify

rottotal=FullSimplify[rot2/.θ->((5 π)/12)].rot//FullSimplify

Graphics3D[{{Opacity[.5],LabelPolyhedron[p1,Background->LightGreen]},
LabelPolyhedron@Polyhedron[newv2=s rottotal.#&/@basesolid[[1]],basesolid[[2]]]},Boxed->False]

Concave

PolyhedronData[pname,"Concave"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]//Timing

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

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

ConvexHullOf

hullof=DeleteCases[Select[PolyhedronData[All],PolyhedronData[#,"ConvexHullName"]===pname&],pname]

GraphicsGrid[Partition[Graphics3D[{
{Green,Opacity[.7],PolyhedronData[#,"Polyhedron"]},
{Blue,Opacity[.2],PolyhedronData[#,"ConvexHull","Polyhedron"]}},Boxed->False,PlotLabel->Style[PolyhedronData[#,"Name"],Directive[14,Black,Italic,FontFamily->"Times"]]]&/@hullof,UpTo[3]],Dividers->All,ImageSize->800]

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

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

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

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

EdgeCount

PolyhedronData[pname,"EdgeCount"]

EdgeLengths

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

PolyhedronData[pname,"EdgeLengths"]

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

(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"]

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

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

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

Show[%]

Find rotation matrix

Graphics3D[{FaceForm[Green,Red],basesolid=PolyhedronData[hullname,"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"]]]}

HullOf

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===pname&]

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===hullname&]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

Insphere

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]

MyInsphere[N[p,50]]

%/.x_?InexactNumberQ:>FullSimplify@RootApproximant[x]

sphere=MyInsphere[p]

Graphics3D[{{Opacity[.5],p},{Red,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])//Timing

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

Show[%]

Polyhedra

polyhedra=PolyhedronData[pname,"Polyhedra"]

Length[polyhedra]

Graphics3D[polyhedra]

Graphics3D[Table[{Hue[(i/(Length[polyhedra]))],polyhedra[[i]]},{i,Length[polyhedra]}]]

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

SimplePolyhedron

PolyhedronData[pname,"Simple"]

SimplePolyhedronQ[p]//Timing

Skeleton

PolyhedronData[pname,"Skeleton"]

gn=PolyhedronData[pname,"Skeleton","Name"]

GraphData[gn]

emb=GraphData[gn,"PolyhedralEmbeddings"]

GraphData[gn,"Graph",{"3D","All"}]

g=PolyhedronGraph[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]

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

SurfaceArea[PolyhedronData[pname,"Region"]]

Uniform

PolyhedronData[pname,"Uniform"]

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

subsethulls=PolyhedronData[pname,"VertexSubsetHulls"]

v=PolyhedronData[pname,"Vertices"];

Rule[#,Length[#2]]&@@@subsethulls

Rule[#,Graphics3D[Function[f,ConvexHullRegion[v[[f]]]]/@#2]]&@@@subsethulls

subsethulls2=Flatten[Function[{pn,l},Rule[pn,#]&/@l]@@@subsethulls]

Rule[#,Graphics3D[{{Opacity[.3],{Green,p}},Blue,ConvexHullRegion[v[[#2]]]}]]&@@@subsethulls2

Convex hull

Graphics3D[convexhullreg=ConvexHullRegion[v=PolyhedronData[pname,"Vertices"]]]

v=PolyhedronCoordinates[convexhullreg]

Flatten[(convexhullreg[[2]]/.i_Integer:>v[[i]])/.Thread[PolyhedronData[pname,"Vertices"]->Range[PolyhedronData[pname,"V"]]]]//Union

%===Range@Length@v

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

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p]//FullSimplify

Volume[PolyhedronData[pname,"Region"]]//FullSimplify

Volume[ImplicitRegion[Evaluate@PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]]//FullSimplify

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Properties: {"TetrahedronTwoCompound", 2}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"TetrahedronTwoCompound",2},"Polyhedron"]

AdjacentFaceIndices

adj1=PolyhedronData[pname,"AdjacentFaceIndices"]

adj2=AdjacentFaceIndices[p]

adj1===adj2

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Graphics3D[{{Opacity[.2],Yellow,sphere},p},Boxed->False]

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

CompoundInterior

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

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

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]

MyCircumsphere[interior]//Quiet

Insphere[interior]//RootReduce//Quiet

Midsphere[interior]

Construction

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

Graphics3D[int]

Graphics3D[{{Opacity[.3],p},Red,int},Boxed->False]

Union[Chop@int[[1]]]//Length

Exactify: RootApproximant

vexact=DeleteDuplicates[RootApproximant[Chop[int[[1]]]]]

Length[vexact]

Exactify: ToAlgebraicRoot

vexact=DeleteDuplicates[Map[ToAlgebraicRoot[SetPrecision[#,15],"MaxDegree"->4]&,Chop[int[[1]]],{2}]]

Length[vexact]

Plane intersection

pname

polygons=PolyhedronData[pname,"Polygons"]

Length@polygons

Binomial[8,3]

intersections=RegionIntersection@@@Subsets[InfinitePlane@@@polygons,{3}];//Timing

Length[pts=Cases[intersections,Point[x_]:>Flatten[x]]]

pts[[1]]

Graphics3D[{AbsolutePointSize[10],Point[pts],Opacity[.2],p}]

Length[pts2=Select[pts,Norm[#]<.4&]]

vexact=Map[ToAlgebraicRoot,pts2,{2}]//FullSimplify

vexact={{-(1/(8 (Sqrt[3]))),-((Sqrt[5])/8),-(1/(2 (Sqrt[6])))},{-(1/8) (Sqrt[(1/6) (23-3 (Sqrt[5]))]),(1/16) (1+(Sqrt[5])),-(1/(2 (Sqrt[6])))},{(1/8) (Sqrt[(1/6) (23+3 (Sqrt[5]))]),(1/16) (-1+(Sqrt[5])),-(1/(2 (Sqrt[6])))},{-(1/(4 (Sqrt[3]))),-(1/4),(1/(2 (Sqrt[6])))},{(NumericalApproximation[Root, (RowDefault["-0.178", FEExpressionsNumericalApproximationElider]), Root[1-36 ((#1)^2)+144 ((#1)^4)&,2], ]),(1/4) (1-(Sqrt[5])),(1/2) (Sqrt[(5/6) (9-4 (Sqrt[5]))])},{-(1/(4 (Sqrt[3]))),(1/4),(1/(2 (Sqrt[6])))},{(NumericalApproximation[Root, (RowDefault["-0.178", FEExpressionsNumericalApproximationElider]), Root[1-36 ((#1)^2)+144 ((#1)^4)&,2], ]),(1/4) (-1+(Sqrt[5])),(1/2) (Sqrt[(5/6) (9-4 (Sqrt[5]))])},{-(1/4) (Sqrt[7-((8 (Sqrt[5]))/3)]),(1/4),-(1/2) (Sqrt[(5/6) (9-4 (Sqrt[5]))])},{(1/(2 (Sqrt[3]))),0,(1/(2 (Sqrt[6])))},{(Sqrt[(1/6) (3-(Sqrt[5]))]),0,(1/2) (Sqrt[(5/6) (9-4 (Sqrt[5]))])},{-(1/4) (Sqrt[(1/6) (3-(Sqrt[5]))]),(1/8) (-5+(Sqrt[5])),-(1/2) (Sqrt[(5/6) (9-4 (Sqrt[5]))])},{(1/4) (Sqrt[(9/2)-((7 (Sqrt[5]))/6)]),(1/8) (3-(Sqrt[5])),-(1/2) (Sqrt[(5/6) (9-4 (Sqrt[5]))])}};

N[vexact-pts2,100]//Abs//Max

Graphics3D[{AbsolutePointSize[10],Point[vexact],Opacity[.2],p}]

Exact interior

inthull=ConvexHullRegion[Union@vexact]

v=inthull[[1]]

faces=Sort[inthull[[2]]]

gname=RecognizeGraph@PolyhedronGraph[inthull]

GraphData[gname,"PolyhedralEmbeddings"]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[inthull]]//Counts//Quiet

lengths=Keys[%]

(lengths/(Min[lengths]))//FullSimplify

Numerically group

Union[Chop@int[[1]]]//Length

Length[grouped=SplitBy[SortBy[{#,Round[1*^12#]}&/@Chop[int[[1]]],Last],Last][[All,All,1]]]

Max[EuclideanDistance@@@Flatten[Subsets[#,{2}]&/@grouped,1]]

grouped//Column

rules=Flatten[Function[l,Rule[#,Mean[l]]&/@l]/@grouped,1];

newi=ConvexHullRegion[DeleteDuplicates[Chop[int[[1]]]/.rules]]

Graphics3D[LabelPolyhedron@newi]

Midsphere[newi]

RecognizeGraph@PolyhedronGraph@newi

lengths=PolyhedronEdgeLengths[newi]

Divide@@MinMax[%lengths]

Round[10^12lengths]/10^12.//Counts

newi[[1]]

MinMax[Norm/@newi[[1]]]

Sort[newi[[2]]]

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

Find scale

intname=XXX;

PolyhedronData/@{pname,intname}

xyratio=((Max[Norm/@vexact[[All,;;2]]])/(Max[Norm/@PolyhedronData[intname,"VertexCoordinates"][[All,;;2]]]))//RootReduce//FullSimplify//Quiet

zratio=((Max[vexact[[All,3]]])/(Max[PolyhedronData[intname,"VertexCoordinates"][[All,3]]]))//RootReduce//FullSimplify

{xyratio,xyratio,zratio}

Find rotation matrix

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

Graphics3D[{{Opacity[.5],LabelPolyhedron[p,Background->LightGreen]},
LabelPolyhedron@Polyhedron[newv=s rot.#&/@basesolid[[1]],basesolid[[2]]]},Boxed->False]

rot=RotationMatrix[{basev[[4]],Mean@p[[1]][[{3,7}]]}]//FullSimplify

rot2=RotationMatrix[θ,Subtract@@newv[[{4,3}]]]

newv2=rot2.#&/@newv;

p1[[1]][{3,6,7}]

Solve[RegionDistance[InfinitePlane[p1[[1]][[{3,6,7}]]],newv2[[5]]]==0&&0<θ<π,θ]//FullSimplify

rottotal=FullSimplify[rot2/.θ->((5 π)/12)].rot//FullSimplify

Graphics3D[{{Opacity[.5],LabelPolyhedron[p1,Background->LightGreen]},
LabelPolyhedron@Polyhedron[newv2=s rottotal.#&/@basesolid[[1]],basesolid[[2]]]},Boxed->False]

Concave

PolyhedronData[pname,"Concave"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]//Timing

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

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

ConvexHullOf

hullof=DeleteCases[Select[PolyhedronData[All],PolyhedronData[#,"ConvexHullName"]===pname&],pname]

GraphicsGrid[Partition[Graphics3D[{
{Green,Opacity[.7],PolyhedronData[#,"Polyhedron"]},
{Blue,Opacity[.2],PolyhedronData[#,"ConvexHull","Polyhedron"]}},Boxed->False,PlotLabel->Style[PolyhedronData[#,"Name"],Directive[14,Black,Italic,FontFamily->"Times"]]]&/@hullof,UpTo[3]],Dividers->All,ImageSize->800]

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

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

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

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

EdgeCount

PolyhedronData[pname,"EdgeCount"]

EdgeLengths

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

PolyhedronData[pname,"EdgeLengths"]

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

(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"]

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

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

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

Show[%]

Find rotation matrix

Graphics3D[{FaceForm[Green,Red],basesolid=PolyhedronData[hullname,"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"]]]}

HullOf

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===pname&]

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===hullname&]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

Insphere

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[p]

Graphics3D[{{Opacity[.5],p},{Red,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])//Timing

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

Show[%]

Polyhedra

polyhedra=PolyhedronData[pname,"Polyhedra"]

Length[polyhedra]

Graphics3D[polyhedra]

Graphics3D[Table[{Hue[(i/(Length[polyhedra]))],polyhedra[[i]]},{i,Length[polyhedra]}]]

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

SimplePolyhedron

PolyhedronData[pname,"Simple"]

SimplePolyhedronQ[p]//Timing

Skeleton

PolyhedronData[pname,"Skeleton"]

gn=PolyhedronData[pname,"Skeleton","Name"]

GraphData[gn]

emb=GraphData[gn,"PolyhedralEmbeddings"]

GraphData[gn,"Graph",{"3D","All"}]

g=PolyhedronGraph[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]

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

SurfaceArea[PolyhedronData[pname,"Region"]]

Uniform

PolyhedronData[pname,"Uniform"]

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

subsethulls=PolyhedronData[pname,"VertexSubsetHulls"]

v=PolyhedronData[pname,"Vertices"];

Rule[#,Length[#2]]&@@@subsethulls

Rule[#,Graphics3D[Function[f,ConvexHullRegion[v[[f]]]]/@#2]]&@@@subsethulls

subsethulls2=Flatten[Function[{pn,l},Rule[pn,#]&/@l]@@@subsethulls]

Rule[#,Graphics3D[{{Opacity[.3],{Green,p}},Blue,ConvexHullRegion[v[[#2]]]}]]&@@@subsethulls2

Convex hull

Graphics3D[convexhullreg=ConvexHullRegion[v=PolyhedronData[pname,"Vertices"]]]

v=PolyhedronCoordinates[convexhullreg]

Flatten[(convexhullreg[[2]]/.i_Integer:>v[[i]])/.Thread[PolyhedronData[pname,"Vertices"]->Range[PolyhedronData[pname,"V"]]]]//Union

%===Range@Length@v

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

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p]//FullSimplify

Volume[PolyhedronData[pname,"Region"]]//FullSimplify

Volume[ImplicitRegion[Evaluate@PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]]//FullSimplify

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Construction

{"TetrahedronTwoCompound", 1}  dual

tets=PolyhedronData[{"TetrahedronTwoCompound", 1} ,"Polyhedra"]

Graphics3D[tets]

duals=PlatonicDual["Tetrahedron",#]&/@tets

Graphics3D[duals]

{"TetrahedronTwoCompound", 2}  dual

tets=PolyhedronData[{"TetrahedronTwoCompound", 2} ,"Polyhedra"]

Graphics3D[tets]

duals=PlatonicDual["Tetrahedron",#]&/@tets

Graphics3D[duals]

Graphics3D[{tets,duals}]

{"TetrahedronTwoCompound", 2} pieces

inpt[v_List]:=v[[2]]+l2 Unit[v[[3]]+Unit[v[[1]]-v[[3]]]s1-v[[2]]];
hook[l_List]:={Line[Append[l,l[[1]]]],EdgeForm[],Polygon[l[[{1,2,5}]]],Polygon[l[[{3,4,5}]]]};
pyr2[l_List]:=LinePlaneIntersection[v[[{2,4,16}]],l][[1]];
pyr2v={pyr2[v[[{9,20}]]],pyr2[v[[{11,20}]]],pyr2[v[[{3,20}]]]};

Show[Graphics3D[{
tet[v[[{2,17,4,16}]]],
hook[{v[[9]],i1,i2,i3,v[[11]]}],
hook[{v[[11]],i3,i4,i5,v[[3]]}],
hook[{v[[3]],i5,i6,i1,v[[9]]}],
Polygon[{v[[20]],pyr2v[[1]],pyr2v[[2]]}],
Polygon[{v[[20]],pyr2v[[1]],pyr2v[[3]]}],
Polygon[{v[[20]],pyr2v[[2]],pyr2v[[3]]}],
{EdgeForm[],
Polygon[{v[[9]],v[[3]],inpt[v[[{9,3,11}]]]}],
Polygon[{v[[3]],v[[11]],inpt[v[[{3,11,9}]]]}],Polygon[{v[[11]],v[[9]],inpt[v[[{11,9,3}]]]}]
},
Line[inpt/@{v[[{9,3,11}]],v[[{3,11,9}]],v[[{11,9,3}]],v[[{9,3,11}]]}]
}],
ViewPoint->{1.7414236510730456,-4.704027555287888,6.621145552438465},ViewVertical->{-0.43195716962602515,-0.8010820450058473,-0.5554456849634057},Boxed->False]

Unit[v_]:=v/Sqrt[v.v]

e1=(Sqrt[3-(Sqrt[5])]);
e2=(1/2) (5-(Sqrt[5]));
s=Sqrt[3+Sqrt[5]];

v1={0,0};
v2=e1{Cos[Pi/3],-Sin[Pi/3]};
v5={s,0};
v3=v2+e2 Unit[v5-v2];
v4=v5-e1 {Cos[Pi/3],Sin[Pi/3]};

Show[Graphics[Line[hook={v1,v2,v3,v4,v5,v1}]],AspectRatio->Automatic]

FullSimplify[Unit[v2-v1].Unit[v3-v2]]

ArcCos[%]180./Pi

FullSimplify[Unit[v2-v3].Unit[v4-v3]]

FullSimplify[Unit[v3-v4].Unit[v5-v4]]

ArcCos[%239]180./Pi

ToExact[ArcCos[(1/8) (-1+3 (Sqrt[5]))]]

Hook Pieces

i1=Together//@ToRadicals[RootReduce[LinePlaneIntersection[v[[{2,16,17}]],v[[{9,20}]]][[1]]]];
i2=Together//@ToRadicals[RootReduce[LinePlaneIntersection[v[[{9,11,20}]],v[[{16,17}]]][[1]]]];
i3=Together//@ToRadicals[RootReduce[LinePlaneIntersection[v[[{4,16,17}]],v[[{11,20}]]][[1]]]];
i4=Together//@ToRadicals[RootReduce[LinePlaneIntersection[v[[{11,3,20}]],v[[{17,4}]]][[1]]]];
i5=Together//@ToRadicals[RootReduce[LinePlaneIntersection[v[[{2,4,17}]],v[[{3,20}]]][[1]]]];
i6=Together//@ToRadicals[RootReduce[LinePlaneIntersection[v[[{3,9,20}]],v[[{2,17}]]][[1]]]];
i6=Together//@ToRadicals[RootReduce[LinePlaneIntersection[v[[{2,16,17}]],v[[{4,9}]]][[1]]]];

i5=Together//@ToRadicals[RootReduce[LinePlaneIntersection[v[[{4,2,17}]],v[[{3,20}]]][[1]]]]

i5

{i1,i2,i3,i4,i5,i6}

e1=FullSimplify[ToRadicals[RootReduce[Norm[v[[9]]-i1]]]]

e2=ToRadicals[RootReduce[Norm[i2-i1]]]

e3=FullSimplify[ToRadicals[RootReduce[Norm[i2-i3]]]]

e4=FullSimplify[ToRadicals[RootReduce[Norm[v[[11]]-i3]]]]

e5=FullSimplify[ToRadicals[RootReduce[Norm[v[[11]]-v[[9]]]]]]

{e1,e2,e3,e4,e5}

N[{e1,e2,e3,e4}]/s

Center Piece

<<PlaneGeometry`;
<<PolyhedronOperations`;

aa1={0,0};
bb1={s,0};
cc1={1,Sqrt[3]}Sqrt[3+Sqrt[5]]/2;

pc={Sqrt[23-3Sqrt[5]],Sqrt[3(3+Sqrt[5])]}/8;

s=Sqrt[3+Sqrt[5]];
bb2=First[Intersections@@(Line/@{{aa1,cc1},{bb1,pc}})];
s1=Norm[aa1-bb2];
s2=s-s1;

aa2=cc1+Unit[bb1-cc1]Sqrt[10]/5;
cc2=bb1-{Sqrt[10]/5,0};

pa=First[Intersections@@(Line/@{{bb1,bb2},{cc1,cc2}})];
pb=First[Intersections@@(Line/@{{cc1,cc2},{aa1,aa2}})];

?ClosedLine

dr={{0,0},{1/2,Sqrt[3]/2},{1,0}}s;
Show[Graphics[center={
{GrayLevel[.8],Polygon[{pa,pb,pc}]},
ClosedLine[{pa,pb,pc}],
Triangle[{aa1,bb1,cc1}],
Line/@Table[{{Cos[#],Sin[#]},{-Sin[#],Cos[#]}}&[2Pi i/3].#+dr[[i+1]]&/@hook,{i,0,2}]
}],AspectRatio->Automatic]

Show[Graphics[pyramid={
Line[s{{0,0},{1,0},{3/4,Sqrt[3]/4},{1/4,Sqrt[3]/4},{0,0}}],
Line[s{{1/4,Sqrt[3]/4},{1/2,0},{3/4,Sqrt[3]/4}}]
}],AspectRatio->Automatic]

Show[Graphics[{center,pyramid/.Line[x_]:>Line[{3,0}+#&/@x]}],AspectRatio->Automatic]

pts={pa,"(Subscript[P, A])",pb,"(Subscript[P, B])",pc,"(Subscript[P, C])",
aa,"A'",bb,"B'",cc,"C'",
a,"A",b,"B",c,"C"};

Show[Graphics[{
{GrayLevel[.5],Polygon[{pa,pb,pc}]},
Triangle[{a,b,c}],
Line/@{{b,bb},{a,aa},{c,cc}},
PointLabels[pts]
}],AspectRatio->Automatic]

Face Distances

dapc=Together//@ToRadicals[RootReduce[Norm[int-v[[9]]]]]

dbpc=Together//@ToRadicals[RootReduce[Norm[int-v[[11]]]]]

s=Together//@ToRadicals[RootReduce[Norm[v[[9]]-v[[11]]]]]

s1=Together//@ToRadicals[RootReduce[Norm[a-bb]]]

s2=Together//@FullSimplify[s-s1]

FullSimplify[Solve[{x^2+y^2==1/2,(Sqrt[3+Sqrt[5]]-x)^2+y^2==(7+3Sqrt[5])/4},
{x,y}]]

N[%]

Face Angles

α=FullSimplify[ArcCos[Unit[b-a].Unit[pc-a]]]/2

N[180./Pi α]

FullSimplify[Unit[v[[9]]-v[[11]]].Unit[i1-v[[11]]]]

α=ArcCos[(3Sqrt[2]+Sqrt[10])/8]

N[α]

ArcSec[2/11(1+3Sqrt[5])]/2//N

N[% 180/Pi]

<<PolyhedronOperations`

ToExact[ArcSec[2/11(1+3Sqrt[5])]/2,20,200,300]

Edge Distances

int=Together//@ToRadicals[RootReduce[PointPlaneIntersection[v[[{9,3,11}]],v[[{2,17}]]][[1]]]]

Norm[a-bb]

Together//@FullSimplify[Norm[c-bb]]

l1=Together//@FullSimplify[Norm[bb-pc]]

l2=FullSimplify[Norm[a-pc]]

l3=FullSimplify[Norm[pc-pa]]

N[{l1,l2,l3}]

Interior

<<Platonic`

Show[Graphics3D[Polyhedron[Tetrahedron2Compound]]]

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

<<Platonic`;
<<PolyhedronOperations`;

p=Polyhedron[Tetrahedron5Compound];

v=PolyhedronVertices[Take[p,8]]

Show[Graphics3D[{Take[p,8],
MapIndexed[Text[#2[[1]],#1+{0,0,.1},Background->White]&,v]},Boxed->False]]

ToExact[Sqrt[#.#]&[Subtract@@v[[{2,7}]]]]

s=ToExact[Sqrt[#.#]&[Subtract@@Take[p[[1,1]],2]]]

h=ToExact[Sqrt[#.#]&[v[[1]]-v[[2]]]]

R=Sqrt[6]/4;

FullSimplify[Solve[2(R+x)==h/s,x]]

α=ArcCos[(3Sqrt[2]+Sqrt[10])/8];

θ=-(Pi/3-2α)

tet2=Polyhedron[TetrahedronZ]/.Polygon[l_]:>Polygon[Append[{{Cos[θ],Sin[θ]},{-Sin[θ],Cos[θ]}}.{#[[1]],#[[2]]},-#[[3]]]&/@Reverse[l]];

tet2e=Map[ToExact,tet2,{4}];

v1=PolyhedronVertices[Polyhedron[TetrahedronZ]];

v2=PolyhedronVertices[tet2e];

Show[Graphics3D[{Polyhedron[TetrahedronZ],tet2,
MapIndexed[Text[#2[[1]],#1+{0,0,.1},Background->White]&,v1],
MapIndexed[Text[#2[[1]],#1+{0,0,.1},Background->White]&,v2]}],
Boxed->False,ViewPoint->{5,0,2}]

ToExact[Sqrt[#.#]&[v1[[1]]-v2[[4]]]s]

<<Platonic`
<<PolyhedronOperations`
<<VertexEnum`

ineqs=({x,y,z,1}.#<0)&/@((ToExact/@Append[Coefficient[#[[1]],{x,y,z}],#[[1]]/.{x->0,y->0,z->0}])&/@PolyhedronInequalities[Polyhedron[Tetrahedron2Compound],{x,y,z}])

ineqs//N

ExpandAll[PolyhedronInequalities[Polyhedron[Tetrahedron2Compound],{x,y,z}]//N]

Timing[interior=PolyhedronFromInequalities[List@@ineqs,{x,y,z}];]

<<Graphics`InequalityGraphics`

InequalityPlot3D[ineqs//N,{x},{y},{z}]