Isosceles Tetrahedron

Author

Eric W. Weisstein
July 22, 2014

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

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

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

Definitions

reg=Tetrahedron[{{0,0,0},{a,0,0},{(a^2-b^2+c^2)/(2 a),Sqrt[(-a+b+c) (a+b-c) (a-b+c) (a+b+c)]/(2 a),0},{(a^2+b^2-c^2)/(2 a),(-3 a^4+(b^2-c^2)^2+2 a^2 (b^2+c^2))/(2 a Sqrt[(-a+b+c) (a+b-c) (a-b+c) (a+b+c)]),Sqrt[(2 (-a^2+b^2+c^2) (a^2+b^2-c^2) (a^2-b^2+c^2))/((-a+b+c) (a+b-c) (a-b+c) (a+b+c))]}}];

assum=a>0&b>0&&c>0&&d>0;

Graphics

Image

Show[SolidData["SolidIsoscelesTetrahedron","Image"],Method->{"ShrinkWrap"->True},ImageSize->Small]

DiscretizeRegion

Block[{a=3,b=4,c=9/2},Show[DiscretizeRegion[reg],ImageSize->Small]]

Eric’s Package

pts=Table[Random[],{4},{3}]

dist2[x_,y_]:=#.#&[x-y]

IsoscelesTetrahedron[{xa_,xb_,xc_}]:=Module[{xd,x,y,z},
xd={x,y,z};
{xa,xb,xc,#}&/@({x,y,z}/.Solve[{
dist2[xb,xc]==dist2[xd,xa],
dist2[xc,xa]==dist2[xd,xb],
dist2[xa,xb]==dist2[xd,xc]
},{x,y,z}])
]

i=IsoscelesTetrahedron[Take[pts,3]]

dist2@@@{i[[1]][[{2,3}]],i[[1]][[{1,4}]]}

Show[Graphics3D[{Tetrahedron3D[i[[1]]],
MapIndexed[Text[#2[[1]],#1]&,i[[1]]]}],AspectRatio->Automatic]

Show[Graphics[HiddenWireframe[Tetrahedron3D[i[[1]]]]],AspectRatio->Automatic]

Volume

General Tetrahedron

volume=Abs[TetrahedronVolume[pts]]

radius=Circumsphere[pts][[-1]]

Area[Evaluate[Times@@@Transpose[Partition[Sqrt[#.#]&/@Subtract@@@(pts[[#]]&/@{{2,3},{1,3},{1,2},{4,1},{4,2},{4,3}}),3]]]]

6 radius volume

Isosceles Tetrahedron

Refine[((Area[{a^2,b^2, c^2}])/(6 (Sqrt[((((a^2)+(b^2)-(c^2))((a^2)+(c^2)-(b^2))((b^2)+(c^2)-(a^2)))/72)]))),a>0&&b>0&&c>0]

Reduce[8R^2==a^2+b^2+c^2&&R>0&&a>0&&b>0&&c>0,{a,b,c,R},Integers]

Reduce[8R^2==a^2+b^2+c^2&&R>0&&a>0&&b>0&&c>0&&R<100,{a,b,c,R},Integers]

Reduce[8R^2==a^2+b^2+c^2&&R>0&&a>0&&b>0&&c>0&&R<10,{a,b,c,R},Integers]

Experimental`DiophantineInstance[8R^2==a^2+b^2+c^2&&R>0&&a>0&&b>0&&c>0,{a,b,c,R}]

Regular Tetrahedron

Refine[((Sqrt[(a^2)+(b^2)+(c^2)])/(2 (Sqrt[2])))/.{b->a,c->a},a>0]

Congruent-Faced Nonequilateral

solns=FullSimplify[Solve[With[{v1={0,0,0},v2={a,0,0},v3={x3,y3,0},v4={x4,y4,z4}},
{
(v1-v3).(v1-v3)==c^2,
(v1-v4).(v1-v4)==b^2,
(v2-v3).(v2-v3)==b^2,
(v2-v4).(v2-v4)==c^2,
(v3-v4).(v3-v4)==a^2
}],{x3,y3,x4,y4,z4}],a>0&&b>0&&c>0]

solns/.{a->3,b->4,c->4.5}//Chop

vs={{0,0,0},{a,0,0},{x3,y3,0},{x4,y4,z4}}/.solns[[-1]]

vs={{0,0,0},{a,0,0},{(((a^2)-(b^2)+(c^2))/(2 a)),((Sqrt[-(a-b-c) (a+b-c) (a-b+c) (a+b+c)])/(2 a)),0},{(((a^2)+(b^2)-(c^2))/(2 a)),((-3 (a^4)+((((b^2)-(c^2)))^2)+2 (a^2) ((b^2)+(c^2)))/(2 a (Sqrt[-(a-b-c) (a+b-c) (a-b+c) (a+b+c)]))),(((Sqrt[2]) (Sqrt[((a^2)-(b^2)-(c^2)) ((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2))]))/(Sqrt[(a-b-c) (a+b-c) (a-b+c) (a+b+c)]))}};

FullSimplify[Through[{Min,Max}[#]]&/@Transpose[vs],a>0&&b>0&&c>0&&a+b>c&&b+c>a&&c+a>b&&((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2)) (-(a^2)+(b^2)+(c^2))>0]

faces0=Subsets[Range[4],{3}]

Graphics3D[{FaceForm[Red,Blue],tet=GraphicsComplex[vs,Polygon[faces0]]}/.{a->3,b->4,c->4.5}]

Orient:

faces={{1,3,2},{1,2,4},{4,3,1},{2,3,4}};

Graphics3D[{FaceForm[Blue,Red],tet=GraphicsComplex[vs,Polygon[faces]]}/.{a->3,b->4,c->4.5}]

Factor[-3 (a^4)+((((b^2)-(c^2)))^2)+2 (a^2) ((b^2)+(c^2))]//FullSimplify

tet

tet2=GraphicsComplex[{{0,0,0},{a,0,0},{(((a^2)-(b^2)+(c^2))/(2 a)),((Sqrt[(-a+b+c) (a+b-c) (a-b+c) (a+b+c)])/(2 a)),0},{(((a^2)+(b^2)-(c^2))/(2 a)),((-3 (a^4)+((((b^2)-(c^2)))^2)+2 (a^2) ((b^2)+(c^2)))/(2 a (Sqrt[(-a+b+c) (a+b-c) (a-b+c) (a+b+c)]))),(Sqrt[((2 (-(a^2)+(b^2)+(c^2)) ((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2)))/((-a+b+c) (a+b-c) (a-b+c) (a+b+c)))])}},Polygon[{{1,3,2},{1,2,4},{4,3,1},{2,3,4}}]];

Graphics3D[tet2/.{a->3,b->4,c->4.5}]

(ineq=And@@Simplify[PolyhedronInequalities[Flatten[Normal[GraphicsComplex[vs,Polygon[faces]]]],{x,y,z}],a>0&&b>0&&c>0&&a+b>c&&b+c>a&&c+a>b&&((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2)) (-(a^2)+(b^2)+(c^2))>0])//Timing

nineq=ineq/.{a->3,b->4,c->4.5}//Chop

RegionPlot3D[nineq,{x,-1,5},{y,-1,5},{z,-1,5},PlotPoints->50]

ineq=And@@{
z≥0,
2 (Sqrt[2]) a (Sqrt[-(a^6)+(a^2) ((((b^2)-(c^2)))^2)+(a^4) ((b^2)+(c^2))-((((b^2)-(c^2)))^2) ((b^2)+(c^2))]) y+3 (a^4) z≥(((((b^2)-(c^2)))^2)+2 (a^2) ((b^2)+(c^2))) z,

(1/(2a))((1/2)  (-2 (Sqrt[2]) (Sqrt[((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2)) (-(a^2)+(b^2)+(c^2))]) x(Sqrt[(a+b-c) (a-b+c) (-a+b+c) (a+b+c)])+(a z+(((b^2) z)/a)-(((c^2) z)/a))(a+b-c) (a-b+c) (-a+b+c) (a+b+c))+((a^2)-(b^2)+(c^2)) ((Sqrt[2]) (Sqrt[((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2)) (-(a^2)+(b^2)+(c^2))]) y-(((-3 (a^4)+((((b^2)-(c^2)))^2)+2 (a^2) ((b^2)+(c^2))) z)/(2 a))))≤0,
((Sqrt[(-(a^2)+(b^2)+(c^2)) ((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2))]) ((x-a) (Sqrt[(-a+b+c) (a+b-c) (a-b+c) (a+b+c)])+(a^2) y+(b^2) y-(c^2) y))/((Sqrt[2]) a (Sqrt[(-a+b+c) (a+b-c) (a-b+c) (a+b+c)]))+((((a^4)-3 (b^4)+2 (b^2) (c^2)+(c^4)+2 (a^2) ((b^2)-(c^2))) z)/(2 (Sqrt[(-a+b+c) (a+b-c) (a-b+c) (a+b+c)])))≤0
};

ineq2=With[{
Δ=(Sqrt[(a+b-c) (a-b+c) (-a+b+c) (a+b+c)]),
ϵ=(Sqrt[(-(a^2)+(b^2)+(c^2)) ((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2))]),
α=-3 (a^4)+2 (a^2) (b^2)+(b^4)+2 (a^2) (c^2)-2 (b^2) (c^2)+(c^4),
β=(a^4)+2 (a^2) (b^2)-3 (b^4)-2 (a^2) (c^2)+2 (b^2) (c^2)+(c^4)
},
z≥0&&
2 (Sqrt[2]) a ϵ y-α z≥0&&
Δ(-2 (Sqrt[2]) ϵ x a+z((a^2)+(b^2)-(c^2))Δ)+((a^2)-(b^2)+(c^2)) (2(Sqrt[2]) ϵ y a-α z)≤0&&
(Sqrt[2])ϵ (Δ (x-a)+y((a^2)+(b^2)-(c^2)))+a β z≤0
];

{ineq,ineq2}/.{a->3,b->4,c->4.5}/.{x->.3,y->.5,z->.6}//Chop

nineq=ineq/.{a->3,b->4,c->4.5}//Chop//Expand

nineq2=ineq2/.{a->3,b->4,c->4.5}//Chop//Expand

RegionPlot3D[nineq,{x,-1,5},{y,-1,5},{z,-1,5},PlotPoints->50]

RegionPlot3D[nineq2,{x,-1,5},{y,-1,5},{z,-1,5},PlotPoints->50]

SurfaceArea

PolyhedronSurfaceArea[Flatten[Normal[tet]]]//Simplify

Volume

Assuming[a>0&&b>0&&c>0&&((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2)) (-(a^2)+(b^2)+(c^2))>0,FullSimplify[Volume[GraphicsComplex[vs,Polygon[faces]]]]]

(((6(Sqrt[2])))^2)

((Sqrt[(-(a^2)+(b^2)+(c^2)) ((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2))])/(6 (Sqrt[2])))/.{a->3,b->4,c->4.5}//Chop

(Sqrt[((((b^2)+(c^2)-(a^2))((a^2)+(c^2)-(b^2)) ((a^2)+(b^2)-(c^2)) )/72)])/.{a->3,b->4,c->4.5}

NIntegrate[Boole[nineq],{x,0,5},{y,0,5},{z,0,5}]

Centroid

cond=a+b>c&&b+c>a&&a+c>b;

(g=Assuming[a>0&&b>0&&c>0&&((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2)) (-(a^2)+(b^2)+(c^2))>0,Centroid[GraphicsComplex[vs,Polygon[faces]]]])//Timing

g/.{a->3,b->4,c->9/2}//N

FullSimplify[(Sqrt[(a-b-c) (a+b-c) (a-b+c) (a+b+c)]) (Sqrt[(1/((a-b-c) (a+b-c) (a-b+c) (a+b+c)))]),cond]

FullSimplify[(Sqrt[(a-b-c) (a+b-c) (a-b+c) (a+b+c)])(Sqrt[(1/((a^4)+((((b^2)-(c^2)))^2)-2 (a^2) ((b^2)+(c^2))))])+1,cond]

FullSimplify[(Sqrt[(a-b-c) (a+b-c) (a-b+c) (a+b+c)]) (Sqrt[(1/((a^4)+((((b^2)-(c^2)))^2)-2 (a^2) ((b^2)+(c^2))))])+1,cond]

1/Factor[(1/((a^2)+(b^2)-(c^2)))+(1/((a^2)-(b^2)+(c^2)))+(1/(-(a^2)+(b^2)+(c^2)))]

(((2(Sqrt[2])))^2)

{(1/2) a,((a (-(a^2)+(b^2)+(c^2)))/(2 (Sqrt[(-a+b+c) (a+b-c) (a-b+c) (a+b+c)]))),(Sqrt[(((-(a^2)+(b^2)+(c^2)) ((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2)))/(8(-a+b+c) (a+b-c) (a-b+c) (a+b+c)))])}/.{a->3,b->4,c->9/2}//N

Inertia Tensor

i=Assuming[a>0&&b>0&&c>0&&((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2)) (-(a^2)+(b^2)+(c^2))>0&&a+b>c&&b+c>a&&a+c>b,FullSimplify[InertiaTensor[GraphicsComplex[vs,Polygon[faces]]]]]

i/.{a->3,b->4,c->4.5}//Chop

(1/((Sqrt[(-(a^2)+(b^2)+(c^2)) ((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2))])/(6 (Sqrt[2]))))NIntegrate[{{y^2+z^2,-x y,-x z},{-x y,z^2+x^2,-y z},{-x z,-y z,x^2+y^2}}Boole[nineq],{x,0,5},{y,0,5},{z,0,5}]/.{a->3,b->4,c->4.5}//Chop

Circumsphere

FullSimplify[Circumsphere[vs],cond]

Sphere[{(a/2),((a (-(a^2)+(b^2)+(c^2)))/(2 (Sqrt[(-a+b+c) (a+b-c) (a-b+c) (a+b+c)]))),((Sqrt[(-(a^2)+(b^2)+(c^2)) ((a^2)+(b^2)-(c^2)) ((a^2)-(b^2)+(c^2))])/(2 (Sqrt[2]) (Sqrt[(-a+b+c) (a+b-c) (a-b+c) (a+b+c)])))},((Sqrt[(a^2)+(b^2)+(c^2)])/(2 (Sqrt[2])))]

Properties

Centroid

Assuming[assum,FullSimplify@RegionCentroid[reg]]

Volume

Assuming[assum,FullSimplify@RegionMeasure[reg]]