Skip to main content
4 of 7
deleted 16 characters in body
Karl Fabian
  • 1.7k
  • 10
  • 15

Here is a bit of Mathematica code that rather supports Joseph's conclusion.

Tet[phi_] := {{Sin[phi], 0, Cos[phi]}, {-Sin[phi], 0, Cos[phi]}, {0, Sin[phi], -Cos[phi]}, {0, -Sin[phi], -Cos[phi]}};

Rect[a_, phi_] := Module[{x, y, u, w}, {x, y, u, w} = Tet[phi]; Polygon[{a x + (1 - a) u, a x + (1 - a) w, a y + (1 - a) w, a y + (1 - a) u}]];

v = Subsets[Range[4], {3}];

Manipulate[ Graphics3D[{Opacity[0.2], Sphere[{0, 0, 0}, 1], Opacity[0.3], GraphicsComplex[Tet[phi], Polygon[v]], Opacity[0.8], Rect[a, phi]}], {phi, 0, Pi/2}, {a, 0, 1}]

Using parameters like a=0.9, phi=1.4 one obtains an elongated rectangle inscribed a flat tetrahedron, close to an equatorial plane. The maximal inscribed ellipse in this rectangle hardly is contained in any triangle that fits in the unit ball.

rectangle in tetrahedron in sphere

Edit:

The following improved version fits the largest possible ellipse in the rectangle and finds the smallest enclosing triangle. This actually shows that in all above cases a triangle $T' \subset B$ can be found. This now rather strengthens the belief that the statement is true.

(Note: the triangle should turn red if a counterexample occurs.)

Code:

Tet[phi_] := {{Sin[phi], 0, Cos[phi]}, {-Sin[phi], 0, Cos[phi]}, {0, Sin[phi], -Cos[phi]}, {0, -Sin[phi], -Cos[phi]}}; Rect[a_, phi_] := Module[{x, y, u, w}, {x, y, u, w} = Tet[phi]; Polygon[{a x + (1 - a) u, a x + (1 - a) w, a y + (1 - a) w, a y + (1 - a) u}]]; v = Subsets[Range[4], {3}];

ParPl[a_, phi_] := ParametricPlot3D[{a Sin[phi] Cos[t], -(-1 + a) Sin[phi] Sin[ t], (-1 + 2 a) Cos[phi]}, {t, 0, 2 Pi}, Boxed -> False, Axes -> False];

Tangent[a_, phi_, t_, lam_] := {a Sin[phi] Cos[t], -(-1 + a) Sin[phi] Sin[ t], (-1 + 2 a) Cos[phi]} + lam {-a Sin[phi] Sin[t], (1 - a) Cos[t] Sin[phi], 0};

Manipulate[ p1 = Tangent[a, phi, tau, Cot[tau]]; p2 = Tangent[a, phi, tau, -Sec[tau] - Tan[tau]]; f[tau_] = p1.p1 // Simplify; g[tau_] = p2.p2 // Simplify; bt = tau /. FindRoot[f[tau] == g[tau], {tau, 0.1, 10^-10, Pi/2}]; p1 = Tangent[a, phi, bt, Cot[bt]]; p2 = Tangent[a, phi, bt, -Sec[bt] - Tan[bt]]; p3 = {-1, 1, 1}*p2; col = If[Max[p1.p1, p2.p2, p3.p3] <= 1, Green, Red]; Show[Graphics3D[{Opacity[0.2], Sphere[{0, 0, 0}, 1], Opacity[0.3], GraphicsComplex[Tet[phi], Polygon[v]], Opacity[0.8], Rect[a, phi], col, Polygon[{p1, p2, p3}]}], ParPl[a, phi]], {{phi, Pi/4}, 0, Pi/2}, {{a, 0.7}, 0, 1}]

ellipse in tetrahedron in sphere with smallest enclosing triangle

Karl Fabian
  • 1.7k
  • 10
  • 15