3
$\begingroup$

What kind of regular tetrahedra can we inscribe into a given torus?

For example, is it possible to inscribe a unit edge length regular tetrahedron to a spindle torus with major radius $R=\frac{\sqrt 2}2$ and minor radius $r=\frac{\sqrt 3}2$?

It seems to me that such an inscription should be doable for any $R$ and $r$ in a reasonable range, but I'm having a very hard time imagining it; I hope someone with some knowledge/vision in spatial geometry can answer this from the top of their head.

$\endgroup$
  • 1
    $\begingroup$ The tetrahedron needs to be wholly inside of the torus? And every point of the tetrahedron needs to be on the torus' surface? And the dimensions of both the torus and the tetrahedron are given , so the only degrees of freedom are the location and orientation of the tetrahedron? $\endgroup$ – Wouter Dec 7 '18 at 8:54
  • $\begingroup$ No, yes, and yes. $\endgroup$ – domotorp Dec 7 '18 at 9:27
2
+50
$\begingroup$

One solution has the vertices: $$\begin{array}{ccc} (-0.42, & \ \ \, 0.28, & 0.84 )\\ (-0.03, & -0.16, & 0.04 )\\ (-0.19, & -0.69, & 0.87 )\\ (\ \ \, 0.54, & \ \ \, 0.00, & 0.85 )\\ \end{array}$$ which lead to this view looking up at the region with $z>0$: torus with inscribed tetradhedron

This comes from Mathematica using NMinimize, which surprisingly worked better than NSolve or FindInstance. The code is below, and you could get other solutions by rotating this or by adding a term like $(a_2-\frac32)^2$ to the sum of squares.

xyz[a_, b_] := {(Sqrt[2] + Sqrt[3] Cos[b]) Cos[a],
     (Sqrt[2] + Sqrt[3] Cos[b]) Sin[a], Sqrt[3] Sin[b]} / 2

d[t_, u_, v_, w_] := (xyz[t, u] - xyz[v, w]).(xyz[t, u] - xyz[v, w])

sol = NMinimize[
     (d[a1, b1, a2, b2] - 1)^2 + (d[a2, b2, a3, b3] - 1)^2 + 
     (d[a3, b3, a1, b1] - 1)^2 + (d[a1, b1, 0, b0] - 1)^2 +
     (d[a2, b2, 0, b0] - 1)^2 + (d[a3, b3, 0, b0] - 1)^2,
     {a1, a2, a3, b1, b2, b3, b0}][[2]]

Round[{xyz[a1, b1], xyz[a2, b2], xyz[a3, b3], xyz[0, b0]} /. sol, .01]

tetra = ListPlot3D[{xyz[a1, b1], xyz[a2, b2], xyz[a3, b3], 
     xyz[0, b0]} /. sol, PlotTheme -> Business, 
     PlotRange -> {{-2, 2}, {-2, 2}, {0, 1}}]

torus = ParametricPlot3D[xyz[a, b], {a, 0, 2 Pi}, {b, 0, 2 Pi}, 
     PlotRange -> {{-2, 2}, {-2, 2}, {0, 1}}]

Show[tetra, torus]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.