Function Repository Resource:

TetrahedronCenter

Source Notebook

Construct a specified tetrahedron center

Contributed by: Ed Pegg Jr

ResourceFunction["TetrahedronCenter"][tetra, "special"]

returns the tetrahedron center identified by "special" from the tetrahedron tetra.

Details

For a tetrahedron ABCD, various centers corresponding to "special" include:
"Incenter"center of insphere and intersection point of the dihedral angle bisectors
"Centroid"center of mass and concurrence of facial centroids
"Circumcenter"center of circumsphere and intersection of edge ⟂ bisecting planes
"Monge"intersection of midplanes (⟂ to one edge and concurrent with the opposing edge midpoint)
"12Point"center of circumsphere for face medians, one-third points to Monge and feet of mongians
"Symmedian"point with minimal total squared distance to faces and isogonal conjugate of the centroid
"Spieker"incenter of the medial tetrahedron
"Fermat"point with minimal total distance to the vertices
"Parallelians"point where subplanes parallel to faces have equal area
"Extangents"perspector of ABCD and the extangents tetrahedron
"EulerMedial"perspector of ABCD and the Euler-medial tetrahedron
"MedialEuler"perspector of ABCD and the medial-Euler tetrahedron
"EulerNegative"perspector of ABCD and the Euler-negative tetrahedron
"NegativeEuler"perspector of ABCD and the negative-Euler tetrahedron
There are 50,000+ defined triangle centers, but most do not correspond to a tetrahedron center. For example, the altitudes of a tetrahedron do not necessarily intersect.

Examples

Basic Examples (2) 

Find the incenter where the dihedral angle bisectors intersect:

In[1]:=
tet = Tetrahedron[{{33, -33, 33}, {-11, -22, 33}, {-33, 0, 33}, {-15, 3, 21}}];
ii = ResourceFunction["TetrahedronCenter"][tet, "Incenter"]
Out[2]=

The incenter is the center of Insphere, tangent to the faces. Show it:

In[3]:=
Graphics3D[{{Opacity[.5], tet, Green, Sphere[ii, 33/14]}, Tube[{ii, #}] & /@ PolyhedronCoordinates[tet]}, Sequence[
 Boxed -> False, ImageSize -> Small, SphericalRegion -> True]]
Out[3]=

Scope (4) 

Find the centroid, which is the center of mass or the concurrence of the face centroids:

In[4]:=
tet = {{-22, -25, 4}, {-12, 15, -6}, {8, 5, -6}, {18, -15, 24}};
facecentroids = Reverse[Mean /@ Subsets[tet, {3}]];
gg = ResourceFunction["TetrahedronCenter"][tet, "Centroid"]
Out[6]=

The centroid can also be found with Mean. Show it:

In[7]:=
Graphics3D[{{Opacity[.5], Tetrahedron[tet], Green, Sphere[gg, 1]}, Tube /@ Transpose[{tet, facecentroids}]}, Sequence[
 Boxed -> False, ImageSize -> Small, SphericalRegion -> True]]
Out[7]=

Find the circumcenter, where the edge-bisecting perpendicular planes intersect:

In[8]:=
tet = {{0, 0, 0}, {0, 0, 6}, {0, 8, 6}, {6, 2, 9}};
oo = ResourceFunction["TetrahedronCenter"][tet, "Circumcenter"]
Out[9]=

The circumcenter is the center of the Circumsphere. Show it:

In[10]:=
Graphics3D[{{Opacity[.5], Sphere[oo, Sqrt[689]/4], Green, Tetrahedron[tet]}, Blue, Sphere[oo, 1/3], Red, Tube[{oo, #}] & /@ tet}, Sequence[
 Boxed -> False, ImageSize -> Small, SphericalRegion -> True]]
Out[10]=

In a tetrahedron, a midplane is perpendicular to one edge and concurrent with the midpoint of the opposing edge. Find the Monge point, the concurrence of the midplanes:

In[11]:=
tet = {{2, 2, 2}, {0, -2, 2}, {-4, 2, 2}, {0, 0, -2}};
mm = ResourceFunction["TetrahedronCenter"][tet, "Monge"]
Out[12]=

Calculate the cevians of the Monge point:

In[13]:=
mongecevians = ResourceFunction["Cevians"][tet, mm]
Out[13]=

Show the Monge point and the cevians:

In[14]:=
Graphics3D[{{Opacity[.5], Tetrahedron[tet]}, Red, Sphere[mm, .1], Green, Tube /@ Transpose[{tet, mongecevians}]}, Sequence[
 Boxed -> False, ImageSize -> Small, SphericalRegion -> True]]
Out[14]=

Here are the available SubTetrahedron items:

In[15]:=
subs = {"Altitude", "Anticomplementary", "Circummedial", "Circummonge", "Contact", "Euler", "EulerProjected", "Excentral", "Extouch", "Extangents", "HalfAltitude", "Incentral", "Medial", "Negative", "Reflection", "Symmedial", "Tangential"};

For example, here's the reflection tetrahedron, resulting from reflecting each vertex by the opposite face:

In[16]:=
tet = {{0, 0, 0}, {1, 2, 0}, {3, 0, 0}, {1, 1, 2}};
ref = ResourceFunction["SubTetrahedron"][tet, "Reflection"]
Out[17]=

Connecting the vertices shows a perspector point where the tubes intersect, namely the Monge point:

In[18]:=
Graphics3D[{{Opacity[.5], Tetrahedron[tet], Tetrahedron[ref], Red, Sphere[ResourceFunction["TetrahedronCenter"][tet, "Monge"], .2]}, Blue, Tube[#] & /@ Transpose[{tet, ref}]}, Sequence[
 Boxed -> False, ImageSize -> Small, SphericalRegion -> True]]
Out[18]=

Possible Issues (1) 

Various triangle center points, such as the orthocenter, don't always have a tetrahedron center.

For example, in 2D, the Gergonne point is the perspector of the contact triangle, but the lines do not coincide in 3D given the contact tetrahedron:

In[19]:=
tet = {{0, 0, 0}, {1, 2, 1}, {3, 0, 0}, {1, 1, 4}};
con = RootReduce[ResourceFunction["SubTetrahedron"][tet, "Contact"]];
Graphics3D[{{Opacity[.5], Red, Tetrahedron[tet], Green, Tetrahedron[con]}, Blue, Tube[#] & /@ Transpose[{tet, con}], Opacity[.2], Insphere[tet]}, Sequence[
 Boxed -> False, ImageSize -> Small, SphericalRegion -> True]]
Out[20]=

Neat Examples (5) 

The symmedian point has the minimal total distance squared to the faces:

In[21]:=
tet = {{0, 0, 0}, {0, 0, 6}, {0, 8, 6}, {6, 2, 9}};
sym = ResourceFunction["TetrahedronCenter"][tet, "Symmedian"]
Out[22]=

Check that:

In[23]:=
planes = ResourceFunction["HessianPlane"][#] & /@ Subsets[tet, {3}];
RootApproximant[{x, y, z} /. Last[NMinimize[
    Quiet@Total[({x, y, z, 1} . #)^2 & /@ planes], {x, y, z}, WorkingPrecision -> 60, Method -> "SimulatedAnnealing"]]]
Out[24]=

Show the symmedian point:

In[25]:=
Graphics3D[{{Opacity[.5], Tetrahedron[tet]}, Blue, Sphere[sym, .3]}, Sequence[
 Boxed -> False, ImageSize -> Small, SphericalRegion -> True]]
Out[25]=

Find the Euler, Euler projected and medial tetrahedra:

In[26]:=
initial = {{0, 0, 0}, {1, 3, 0}, {3, 0, 0}, {1, 1, 2}};
tetras = ResourceFunction["SubTetrahedron"][initial, #] & /@ {"Euler", "EulerProjected", "Medial"};
spheres = Circumsphere /@ tetras
Out[27]=

The spheres are all identical. This unique sphere is also known as the 12-point sphere:

In[28]:=
tw = ResourceFunction["TetrahedronCenter"][initial, "12Point"]
Out[28]=

Show the 12-point sphere:

In[29]:=
Graphics3D[{Opacity[.5], Thick, Tetrahedron[initial], spheres[[1]], Tetrahedron /@ tetras}, Boxed -> False, SphericalRegion -> True]
Out[29]=

The Fermat point minimizes the total distance to the vertices:

In[30]:=
tet = {{-22, -25, 4}, {-12, 15, -6}, {8, 5, -6}, {18, -15, 24}};
xx = ResourceFunction["TetrahedronCenter"][tet, "Fermat"]
Out[31]=

Check that:

In[32]:=
{x, y, z} /. Last[NMinimize[
   Quiet@
    Total[ResourceFunction["RealEuclideanDistance"][{x, y, z}, #] & /@
       tet], {x, y, z}, WorkingPrecision -> 60, Method -> "SimulatedAnnealing"]]
Out[32]=

Let S be the sum of distances to the Fermat point. The Fermat tetrahedron is a set of segment endpoints S away from the vertices and passing through the Fermat point:

In[33]:=
fermatTetra = ResourceFunction["SubTetrahedron"][tet, "Fermat"]
Out[33]=

Circumspheres of the Fermat point and three vertices coincide with the segment endpoints:

In[34]:=
Graphics3D[{{Opacity[.5], Tetrahedron[tet], Green, Sphere[xx, 3]}, Tube /@ Transpose[{tet, fermatTetra}], Opacity[.2], Circumsphere /@ Take[Subsets[Prepend[tet, xx], {4}], 4]}, Sequence[
 Boxed -> False, ImageSize -> Small, SphericalRegion -> True]]
Out[34]=

Calculate the Euler-medial tetrahedron and find the Euler-medial point:

In[35]:=
tet = {{2, 2, 2}, {0, 0, 6}, {0, 8, 6}, {6, 2, 9}}; eulermedial = ResourceFunction["SubTetrahedron"][
  ResourceFunction["SubTetrahedron"][tet, "Euler"], "Medial"];
em = RootReduce[
  ResourceFunction["TetrahedronCenter"][tet, "EulerMedial"]]
Out[36]=

Show that the point is the perspector of the original and Euler-medial tetrahedron:

In[37]:=
Graphics3D[{{Opacity[.5], Blue, Tetrahedron[tet], Green, Tetrahedron[eulermedial]}, InfiniteLine /@ Transpose[{tet, eulermedial}], Red, Sphere[em, .1]}, Boxed -> False, ImageSize -> Small, SphericalRegion -> True]
Out[37]=

Find the parallelians point:

In[38]:=
tet = {{0, 0, 0}, {1, 3, 0}, {3, 0, 0}, {1, 1, 2}};
para = N[ResourceFunction["TetrahedronCenter"][tet, "Parallelians"]]
Out[39]=

Move the tetrahedron and calculate the area of the parallel triangles through the point:

In[40]:=
new = # - para & /@ tet;
planes = Take[#, 3] & /@ (N[ResourceFunction["HessianPlane"][#]] & /@ Reverse[Subsets[new, {3}]]);
triangles = Table[RegionIntersection[Hyperplane[planes[[k]], {0, 0, 0}], Tetrahedron[N[new]]], {k, 1, 4}];
Area /@ triangles
Out[41]=

Show the parallelians point and the equal area parallel triangles:

In[42]:=
Graphics3D[{{Opacity[.5], Tetrahedron[new], Gray, triangles}, Red, Sphere[{0, 0, 0}, .1]}, Boxed -> False, ImageSize -> Small, SphericalRegion -> True]
Out[42]=

Version History

  • 1.0.0 – 31 October 2023

Related Resources

License Information