Equilateral Augmented Tetrahedron

Author

Eric W. Weisstein
March 15, 2024

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

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

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

Solid

PolyhedronData["EquilateralAugmentedTetrahedron","Orientations"]

v=PolyhedronData["EquilateralAugmentedTetrahedron","VertexCoordinates"]

Graphics3D[{Opacity[.8],PolyhedronData["EquilateralAugmentedTetrahedron","Polyhedron"]},Boxed->False,ViewPoint->3v[[1]],Method->{"ShrinkWrap"->True},ImageSize->400]

PolyhedronData["EquilateralAugmentedTetrahedron",{"V","E","F"}]

Net

PolyhedronData["EquilateralAugmentedTetrahedron","Net"]

PolyhedronData["EquilateralAugmentedTetrahedron","Net","Colored"]

NetPrintout[PolyhedronData["EquilateralAugmentedTetrahedron","Polyhedron"],"EquilateralAugmentedTetrahedron.pdf"]

Properties

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p]

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

MyCircumsphere[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//FullSimplify//Tally

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

Faces

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

MyInsphere[p]

Graphics3D[{{Opacity[.5],p},{Red,MyInsphere[p]}},Boxed->False]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

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

PolyhedronInertiaTensor[p]

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

Integrate over polyhedron

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

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

Divergence theorem [spurious imaginary part]

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

N[rxy]

ResourceFunction["LogSimplify"][rxy]//FullSimplify

Divergence theorem

(rxy=MeanCylindricalRadius[p,"IntegrationIntervals"->{0,1/3,1/2,2/3,1},"Simplification"->FullSimplify,Debug->True])//Timing

N[rxy]

ResourceFunction["LogSimplify"][rxy]

N[%15]

N[expr=(29/(76 (Sqrt[3])))-((225 (Sqrt[(3/19)]) Log[3])/1064)+((225 (Sqrt[(3/19)]) Log[5])/1064)+(1/168) Log[2+(Sqrt[3])]+((225 (Sqrt[(3/19)]) )/1064)(Log[7+2 (Sqrt[19])]-Log[-1+2 (Sqrt[19])])]

FullSimplify[expr]

ResourceFunction["LogSimplify"][%]//Expand

TrigToExp[%]//Expand

(29/(76 (Sqrt[3])))-((225 (Sqrt[(3/19)]) Log[3])/1064)+((225 (Sqrt[(3/19)]) Log[5])/1064)+(1/168) Log[2+(Sqrt[3])]+((225 (Sqrt[(3/19)]) Log[((7+2 (Sqrt[19]))/(-1+2 (Sqrt[19])))])/1064)//N

FullSimplify[((7+2 (Sqrt[19]))/(-1+2 (Sqrt[19])))]

(expr=(29/(76 (Sqrt[3])))-((225 (Sqrt[(3/19)]) Log[3])/1064)+((225 (Sqrt[(3/19)]) Log[5])/1064)+(1/168) Log[2+(Sqrt[3])]+((225 (Sqrt[(3/19)]) (Log[(83+16 (Sqrt[19]))]-Log[3]-2Log[5]))/1064))//N

ResourceFunction["LogSimplify"][expr]//Expand

ResourceFunction["LogSimplify"][%]

Select[Flatten[Table[{u+v Sqrt[34],N[Log[u+v Sqrt[34],41847233+7176736 Sqrt[34]],20]},{u,-100,100},{v,-100,100}],1],Im[#[[2]]]==0&&#[[2]]-Round[#[[2]]]==0&]//Quiet

Select[Flatten[Table[{u+v Sqrt[19],N[Log[u+v Sqrt[19],Log[83+16 (Sqrt[19])]],20]},{u,-100,100},{v,-100,100}],1],Im[#[[2]]]==0&&#[[2]]-Round[#[[2]]]==0&]//Quiet

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])/(PolyhedronData[pname,"Volume"])))//Timing

N[i]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

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

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

N[i]

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

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

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

N[i]

Midsphere

PolyhedronData[pname,"Midsphere"]

Midsphere[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]//RootReduce

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

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,Method->"GaussLaw"]//FullSimplify

Perspective projections

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

XXX

PolyhedronProjectionGraph[PolyhedronData["DuererSolid","Polyhedron"],]