Skip to main content
Fixed Mathematica code formatting with use of 'pre' tag. Reduced size of second image, so it matches first image.
Source Link

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}]


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.4a=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.

where $A=(\sin \phi, 0, \cos\phi)$, , $B=(-\sin \phi, 0, \cos\phi)$ , $C=(0, \sin \psi, -\cos\psi)$, $D=(0, - \sin \psi, -\cos\psi)$. Thus in all these cases the triangle $T'$ lies inside $B$.

Code:

Tet[phi_, psi_] := {{Sin[phi], 0, Cos[phi]}, {-Sin[phi], 0, Cos[phi]}, {0, Sin[psi], -Cos[psi]}, {0, -Sin[psi], -Cos[psi]}}; Rect[a_, phi_, psi_] := Module[{x, y, u, w}, {x, y, u, w} = Tet[phi, psi]; 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_, psi_] := ParametricPlot3D[{a Sin[phi] Cos[t], -(-1 + a) Sin[psi] Sin[t], a Cos[phi] + (-1 + a) Cos[psi]}, {t, 0, 2 Pi}, Boxed -> False, Axes -> False]; Tangent[a_, phi_, psi_, t_, lam_] := {a Sin[phi] Cos[t], -(-1 + a) Sin[psi] Sin[t], a Cos[phi] + (-1 + a) Cos[psi]} + lam {-a Sin[phi] Sin[t], (1 - a) Cos[t] Sin[psi], 0};

Manipulate[ bt = 2 ArcTan[ 1 - (a Csc[psi] Sin[phi])/(-1 + a) - Sqrt[( a Csc[psi] Sin[phi] (2 - 2 a + a Csc[psi] Sin[phi]))/(-1 + a)^2]]; p1 = Tangent[a, phi, psi, bt, Cot[bt]]; p2 = Tangent[a, phi, psi, bt, -Sec[bt] - Tan[bt]]; p3 = {-1, 1, 1}*p2; Show[Graphics3D[{Opacity[0.2], Sphere[{0, 0, 0}, 1], Opacity[0.3], GraphicsComplex[Tet[phi, psi], Polygon[v]], Opacity[0.8], Rect[a, phi, psi], Green, Polygon[{p1, p2, p3}]}], ParPl[a, phi, psi]], {{phi, Pi/4}, 0, Pi/2}, {{psi, Pi/4}, 0, Pi}, {{a, 0.7}, 0, 1}]


 Tet[phi_, 
   psi_] := {{Sin[phi], 0, Cos[phi]}, {-Sin[phi], 0, Cos[phi]}, {0, 
    Sin[psi], -Cos[psi]}, {0, -Sin[psi], -Cos[psi]}};
Rect[a_, phi_, psi_] := Module[{x, y, u, w},
   {x, y, u, w} = Tet[phi, psi]; 
   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_, psi_] := 
  ParametricPlot3D[{a Sin[phi] Cos[t], -(-1 + a) Sin[psi] Sin[t], 
    a Cos[phi] + (-1 + a) Cos[psi]}, {t, 0, 2 Pi}, Boxed -> False, 
   Axes -> False];
Tangent[a_, phi_, psi_, t_, 
   lam_] := {a Sin[phi] Cos[t], -(-1 + a) Sin[psi] Sin[t], 
    a Cos[phi] + (-1 + a) Cos[psi]} + 
   lam {-a Sin[phi] Sin[t], (1 - a) Cos[t] Sin[psi], 0};

Manipulate[
 bt = 2 ArcTan[
    1 - (a Csc[psi] Sin[phi])/(-1 + a) - Sqrt[(
     a Csc[psi] Sin[phi] (2 - 2 a + a Csc[psi] Sin[phi]))/(-1 + a)^2]];
 p1 = Tangent[a, phi, psi, bt, Cot[bt]];
 p2 = Tangent[a, phi, psi, bt, -Sec[bt] - Tan[bt]];
 p3 = {-1, 1, 1}*p2;
 Show[Graphics3D[{Opacity[0.2], Sphere[{0, 0, 0}, 1], Opacity[0.3], 
    GraphicsComplex[Tet[phi, psi], Polygon[v]], Opacity[0.8], 
    Rect[a, phi, psi], Green, Polygon[{p1, p2, p3}]}], 
  ParPl[a, phi, psi]], {{phi, Pi/4}, 0, Pi/2}, {{psi, Pi/4}, 0, 
  Pi}, {{a, 0.7}, 0, 1}]

ellipse in tetrahedron in sphere with smallest enclosing triangle    

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.

where $A=(\sin \phi, 0, \cos\phi)$, , $B=(-\sin \phi, 0, \cos\phi)$ , $C=(0, \sin \psi, -\cos\psi)$, $D=(0, - \sin \psi, -\cos\psi)$. Thus in all these cases the triangle $T'$ lies inside $B$.

Code:

Tet[phi_, psi_] := {{Sin[phi], 0, Cos[phi]}, {-Sin[phi], 0, Cos[phi]}, {0, Sin[psi], -Cos[psi]}, {0, -Sin[psi], -Cos[psi]}}; Rect[a_, phi_, psi_] := Module[{x, y, u, w}, {x, y, u, w} = Tet[phi, psi]; 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_, psi_] := ParametricPlot3D[{a Sin[phi] Cos[t], -(-1 + a) Sin[psi] Sin[t], a Cos[phi] + (-1 + a) Cos[psi]}, {t, 0, 2 Pi}, Boxed -> False, Axes -> False]; Tangent[a_, phi_, psi_, t_, lam_] := {a Sin[phi] Cos[t], -(-1 + a) Sin[psi] Sin[t], a Cos[phi] + (-1 + a) Cos[psi]} + lam {-a Sin[phi] Sin[t], (1 - a) Cos[t] Sin[psi], 0};

Manipulate[ bt = 2 ArcTan[ 1 - (a Csc[psi] Sin[phi])/(-1 + a) - Sqrt[( a Csc[psi] Sin[phi] (2 - 2 a + a Csc[psi] Sin[phi]))/(-1 + a)^2]]; p1 = Tangent[a, phi, psi, bt, Cot[bt]]; p2 = Tangent[a, phi, psi, bt, -Sec[bt] - Tan[bt]]; p3 = {-1, 1, 1}*p2; Show[Graphics3D[{Opacity[0.2], Sphere[{0, 0, 0}, 1], Opacity[0.3], GraphicsComplex[Tet[phi, psi], Polygon[v]], Opacity[0.8], Rect[a, phi, psi], Green, Polygon[{p1, p2, p3}]}], ParPl[a, phi, psi]], {{phi, Pi/4}, 0, Pi/2}, {{psi, Pi/4}, 0, Pi}, {{a, 0.7}, 0, 1}]

ellipse in tetrahedron in sphere with smallest enclosing triangle


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.

where $A=(\sin \phi, 0, \cos\phi)$, $B=(-\sin \phi, 0, \cos\phi)$ , $C=(0, \sin \psi, -\cos\psi)$, $D=(0, - \sin \psi, -\cos\psi)$. Thus in all these cases the triangle $T'$ lies inside $B$.

Code:


 Tet[phi_, 
   psi_] := {{Sin[phi], 0, Cos[phi]}, {-Sin[phi], 0, Cos[phi]}, {0, 
    Sin[psi], -Cos[psi]}, {0, -Sin[psi], -Cos[psi]}};
Rect[a_, phi_, psi_] := Module[{x, y, u, w},
   {x, y, u, w} = Tet[phi, psi]; 
   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_, psi_] := 
  ParametricPlot3D[{a Sin[phi] Cos[t], -(-1 + a) Sin[psi] Sin[t], 
    a Cos[phi] + (-1 + a) Cos[psi]}, {t, 0, 2 Pi}, Boxed -> False, 
   Axes -> False];
Tangent[a_, phi_, psi_, t_, 
   lam_] := {a Sin[phi] Cos[t], -(-1 + a) Sin[psi] Sin[t], 
    a Cos[phi] + (-1 + a) Cos[psi]} + 
   lam {-a Sin[phi] Sin[t], (1 - a) Cos[t] Sin[psi], 0};

Manipulate[
 bt = 2 ArcTan[
    1 - (a Csc[psi] Sin[phi])/(-1 + a) - Sqrt[(
     a Csc[psi] Sin[phi] (2 - 2 a + a Csc[psi] Sin[phi]))/(-1 + a)^2]];
 p1 = Tangent[a, phi, psi, bt, Cot[bt]];
 p2 = Tangent[a, phi, psi, bt, -Sec[bt] - Tan[bt]];
 p3 = {-1, 1, 1}*p2;
 Show[Graphics3D[{Opacity[0.2], Sphere[{0, 0, 0}, 1], Opacity[0.3], 
    GraphicsComplex[Tet[phi, psi], Polygon[v]], Opacity[0.8], 
    Rect[a, phi, psi], Green, Polygon[{p1, p2, p3}]}], 
  ParPl[a, phi, psi]], {{phi, Pi/4}, 0, Pi/2}, {{psi, Pi/4}, 0, 
  Pi}, {{a, 0.7}, 0, 1}]

    

added 78 characters in body
Source Link
Karl Fabian
  • 1.7k
  • 10
  • 15

The following improved version uses an analytic solution for tetrahedra $ABCD$ with $[AB]$ perpendicular to $[CD]$, and the maximal ellipse $E$ in a plane cutting $ABCD$ parallel to $[AB]$ and $[CD]$. In this case the maximal distance of the vertices of the smallest enclosing triangle $T'$ from the origin is

$1 - 2 (1 - a) a (1 + \cos(\phi - \psi))\leq 1$ for $1 - 2 (1 - a) a (1 + \cos(\phi - \psi)\leq 1$$0 < a < 1 $, 

where $A=(\sin \phi, 0, \cos\phi)$, , $B=(-\sin \phi, 0, \cos\phi)$ , $C={0, \sin \psi, -\cos\psi)$, $D=(0, - \sin \psi, -\cos\psi)$. Thus in all these cases in fact, $T' \subset B$$C=(0, \sin \psi, -\cos\psi)$, $D=(0, - \sin \psi, -\cos\psi)$. Thus in all these cases the triangle $T'$ lies inside $B$.

I even think that all other (nontrivial) cases of $E\subset T$ can be reduced to one of thosethe above cases by aligning two edges of the enclosing tetrahedron $T$ to lie along the mainprincipal axes of $E$, while keeping $E$ inside. But this I cannot prove yet.

The following improved version uses an analytic solution for tetrahedra $ABCD$ with $[AB]$ perpendicular to $[CD]$, and the maximal ellipse $E$ in a plane cutting $ABCD$ parallel to $[AB]$ and $[CD]$. In this case the maximal distance of the vertices of the smallest enclosing triangle $T'$ from the origin is $1 - 2 (1 - a) a (1 + \cos(\phi - \psi)\leq 1$, where $A=(\sin \phi, 0, \cos\phi)$, , $B=(-\sin \phi, 0, \cos\phi)$ , $C={0, \sin \psi, -\cos\psi)$, $D=(0, - \sin \psi, -\cos\psi)$. Thus in all these cases in fact, $T' \subset B$.

I even think that all other (nontrivial) cases of $E\subset T$ can be reduced to one of those by aligning two edges of $T$ to lie along the main axes of $E$, while keeping $E$ inside. But this I cannot prove yet.

The following improved version uses an analytic solution for tetrahedra $ABCD$ with $[AB]$ perpendicular to $[CD]$, and the maximal ellipse $E$ in a plane cutting $ABCD$ parallel to $[AB]$ and $[CD]$. In this case the maximal distance of the vertices of the smallest enclosing triangle $T'$ from the origin is

$1 - 2 (1 - a) a (1 + \cos(\phi - \psi))\leq 1$ for $0 < a < 1 $, 

where $A=(\sin \phi, 0, \cos\phi)$, , $B=(-\sin \phi, 0, \cos\phi)$ , $C=(0, \sin \psi, -\cos\psi)$, $D=(0, - \sin \psi, -\cos\psi)$. Thus in all these cases the triangle $T'$ lies inside $B$.

I even think that all other (nontrivial) cases of $E\subset T$ can be reduced to one of the above cases by aligning two edges of the enclosing tetrahedron $T$ to lie along the principal axes of $E$, while keeping $E$ inside. But this I cannot prove yet.

added 401 characters in body
Source Link
Karl Fabian
  • 1.7k
  • 10
  • 15

Edit (2):

The following improved version fitsuses an analytic solution for tetrahedra $ABCD$ with $[AB]$ perpendicular to $[CD]$, and the largest possiblemaximal ellipse $E$ in the rectanglea plane cutting $ABCD$ parallel to $[AB]$ and finds $[CD]$. In this case the maximal distance of the vertices of 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$T'$ from the statementorigin is true$1 - 2 (1 - a) a (1 + \cos(\phi - \psi)\leq 1$, where $A=(\sin \phi, 0, \cos\phi)$, , $B=(-\sin \phi, 0, \cos\phi)$ , $C={0, \sin \psi, -\cos\psi)$, $D=(0, - \sin \psi, -\cos\psi)$. Thus in all these cases in fact, $T' \subset B$.

I even think that all other (Note:nontrivial) cases of $E\subset T$ can be reduced to one of those by aligning two edges of $T$ to lie along the triangle should turn red if a counterexample occursmain axes of $E$, while keeping $E$ inside.) But this I cannot prove yet.

Tet[phi_]Tet[phi_, psi_] := {{Sin[phi], 0, Cos[phi]}, {-Sin[phi], 0, Cos[phi]}, {0, Sin[phi]Sin[psi], -Cos[phi]Cos[psi]}, {0, -Sin[phi]Sin[psi], -Cos[phi]Cos[psi]}}; Rect[a_, phi_]phi_, psi_] := Module[{x, y, u, w}, {x, y, u, w} = Tet[phi];Tet[phi, psi]; 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_ ParPl[a_, phi_]phi_, psi_] := ParametricPlot3D[{a Sin[phi] Cos[t], -(-1 + a) Sin[phi] Sin[ t]Sin[psi] Sin[t], a Cos[phi] + (-1 + 2 a) Cos[phi]Cos[psi]}, {t, 0, 2 Pi}, Boxed -> False, Axes -> False];

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

Manipulate[ p1bt = Tangent[a, phi, tau, Cot[tau]];2 ArcTan[ p2 = Tangent[a, phi, tau, -Sec[tau]1 - Tan[tau]]; f[tau_] = p1.p1 /(a Csc[psi] Sin[phi])/ Simplify; g[tau_] = p2.p2(-1 + a) // Simplify;- Sqrt[( bt = taua Csc[psi] Sin[phi] /. FindRoot[f[tau] == g[tau],(2 {tau, 0.1, 10^-10, Pi 2 a + a Csc[psi] Sin[phi]))/2}];(-1 + a)^2]]; p1 = Tangent[a, phi, psi, bt, Cot[bt]]; p2 = Tangent[a, phi, psi, 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]GraphicsComplex[Tet[phi, psi], Polygon[v]], Opacity[0.8], Rect[a Rect[a, phi]phi, col psi], Green, Polygon[{p1, p2, p3}]}], ParPl[a ParPl[a, phi]]phi, psi]], {{phi, Pi/4}, 0, Pi Pi/2}, {{psi, Pi/4}, 0, Pi}, {{a, 0.7}, 0, 1}]

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.)

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}]

Edit (2):

The following improved version uses an analytic solution for tetrahedra $ABCD$ with $[AB]$ perpendicular to $[CD]$, and the maximal ellipse $E$ in a plane cutting $ABCD$ parallel to $[AB]$ and $[CD]$. In this case the maximal distance of the vertices of the smallest enclosing triangle $T'$ from the origin is $1 - 2 (1 - a) a (1 + \cos(\phi - \psi)\leq 1$, where $A=(\sin \phi, 0, \cos\phi)$, , $B=(-\sin \phi, 0, \cos\phi)$ , $C={0, \sin \psi, -\cos\psi)$, $D=(0, - \sin \psi, -\cos\psi)$. Thus in all these cases in fact, $T' \subset B$.

I even think that all other (nontrivial) cases of $E\subset T$ can be reduced to one of those by aligning two edges of $T$ to lie along the main axes of $E$, while keeping $E$ inside. But this I cannot prove yet.

Tet[phi_, psi_] := {{Sin[phi], 0, Cos[phi]}, {-Sin[phi], 0, Cos[phi]}, {0, Sin[psi], -Cos[psi]}, {0, -Sin[psi], -Cos[psi]}}; Rect[a_, phi_, psi_] := Module[{x, y, u, w}, {x, y, u, w} = Tet[phi, psi]; 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_, psi_] := ParametricPlot3D[{a Sin[phi] Cos[t], -(-1 + a) Sin[psi] Sin[t], a Cos[phi] + (-1 + a) Cos[psi]}, {t, 0, 2 Pi}, Boxed -> False, Axes -> False]; Tangent[a_, phi_, psi_, t_, lam_] := {a Sin[phi] Cos[t], -(-1 + a) Sin[psi] Sin[t], a Cos[phi] + (-1 + a) Cos[psi]} + lam {-a Sin[phi] Sin[t], (1 - a) Cos[t] Sin[psi], 0};

Manipulate[ bt = 2 ArcTan[ 1 - (a Csc[psi] Sin[phi])/(-1 + a) - Sqrt[( a Csc[psi] Sin[phi] (2 - 2 a + a Csc[psi] Sin[phi]))/(-1 + a)^2]]; p1 = Tangent[a, phi, psi, bt, Cot[bt]]; p2 = Tangent[a, phi, psi, bt, -Sec[bt] - Tan[bt]]; p3 = {-1, 1, 1}*p2; Show[Graphics3D[{Opacity[0.2], Sphere[{0, 0, 0}, 1], Opacity[0.3], GraphicsComplex[Tet[phi, psi], Polygon[v]], Opacity[0.8], Rect[a, phi, psi], Green, Polygon[{p1, p2, p3}]}], ParPl[a, phi, psi]], {{phi, Pi/4}, 0, Pi/2}, {{psi, Pi/4}, 0, Pi}, {{a, 0.7}, 0, 1}]

deleted 16 characters in body
Source Link
Karl Fabian
  • 1.7k
  • 10
  • 15
Loading
Improved Mathematica code; added 1 characters in body
Source Link
Karl Fabian
  • 1.7k
  • 10
  • 15
Loading
add image
Source Link
j.c.
  • 13.6k
  • 3
  • 52
  • 90
Loading
Source Link
Karl Fabian
  • 1.7k
  • 10
  • 15
Loading