Dibujo de un engrosamiento de la cinta de Moebius en Mathematica

Question

Me gustaría tener Mathematica trazar un "engrosamiento de la cinta de Moebius", es decir, un toro con sección transversal cuadrada que se da una media vuelta. Idealmente, me gustaría que este engrosamiento de la cinta de Moebius a ser transparente con un (no engrosado) sólida cinta de Moebius sentado en su centro; aquí es la mejor aproximación podría dibujar a mano de lo que quiero:
Mi motivación es que quiero usar el engrosamiento de la cinta de Moebius una representación visual de una línea de paquete de más de $E$ donde $E$ es la cinta de Moebius, por eso me gustaría que la cinta de Moebius en el centro para que sea visible. Una línea de paquete de más de $E$ puede ser identificado con el paquete de $E\oplus E$$\mathbb{S}^1$.

Me acercaba a este al intentar dibujar los (dos) de los lados de la engrosamiento de la cinta de Moebius como superficies paramétricas. Modelado de mi línea de paquete como $$E\oplus E=\mathbb{R}^3/\langle (t,x,y)\mapsto(t+2\pi,-x,-y)\rangle,$$ un marco global está dada por el vector de los campos de $v,w:\mathbb{S}^1\rightarrow E\oplus E$, donde $$v(t)=\overline{(t,\cos(t),\sin(t))},\hskip0.3in w(t)=\overline{(t,-\sin(t),\cos(t))}.$$ El uso de estos $\{v(t),w(t)\}$ como base para la copia de $\mathbb{R}^2$ en cada punto de $t\in\mathbb{S}^1$, no es difícil describir lo que los lados de el engrosamiento de la cinta de Moebius aspecto dentro de $E\oplus E$. Mi dificultad radica en encontrar las ecuaciones que describen el "obvio" inmersión $F:E\oplus E\rightarrow\mathbb{R}^3$, el mapa que, por ejemplo, ha $$F\left(\overline{(t,0,0)}\right)=(R\cos(t),R\sin(t),0)$$ donde $R$ es el radio de la "real" plaza de toro-con-twist, y $$F\left(\{\overline{(t,x,y)}\mid x,y\in [-r,r]\}\right)= {\text{a (rotated) square of side length $2r$ centered at $F(\overline{(t,0,0)})$}\atop\text{and lying in the plane containing $(0,0,1)$ and $F(\overline{(t,0,0)})$}}.$$

Cualquier ayuda sería muy apreciada.

Answer 1

He estado trabajando en el problema un poco más, y creo que las ecuaciones que se me ocurrió es equivalente a la de Jim. He combinado partes de Jim respuesta con la mía, de hecho el código un poco más modular, y en aras de la exhaustividad que voy a publicar aquí el resultado:

F[R_][t_, x_, y_] := {(R + x) Cos[t], (R + x) Sin[t], y}

Faces[R_, r_, s_, t_] := {F[R][t, -r Sin[t/2] + s Cos[t/2], r Cos[t/2] + s Sin[t/2]], F[R][t, r Cos[t/2] - s Sin[t/2], r Sin[t/2] + s Cos[t/2]]}

Strip[R_, r_, s_, t_] := F[R][t, s Cos[t/2], s Sin[t/2]]

Edges[R_, r_, t_] := {F[R][t, -r Sin[t/2] + r Cos[t/2], r Cos[t/2] + r Sin[t/2]], F[R][t, -r Sin[t/2] - r Cos[t/2], r Cos[t/2] - r Sin[t/2]], F[R][t, r Cos[t/2], r Sin[t/2]]}

ThickMobius[R_, r_, u_] := Show[ ParametricPlot3D[Faces[R, r, s, t], {s, -r, r}, {t, 0, 4 Pi}, PlotStyle -> {{Blue, Opacity -> 0.25}, {Blue, Opacity -> 0.25}}, PlotPoints -> {2, 50}, Mesh -> None, Boxed -> False, Axes -> None], ParametricPlot3D[Strip[R, r, s, t], {s, -r, r}, {t, 0, 2 Pi}, Mesh -> None, PlotStyle -> Red, PlotPoints -> 50], ParametricPlot3D[Edges[R, r, t], {t, 0, 4 Pi}, PlotStyle -> {Darker[Blue], Thickness[u]}, PlotPoints -> 30]]

Aquí hay algunos ejemplos de los resultados:

ThickMobius[6,2,0.001]

ThickMobius[6,1,0.001]

ThickMobius[6,2.5,0.003]

Answer 2

El siguiente código produce cerca de lo que usted está buscando:

F[x_, y_, t_] := {(3 + x*Cos[t/2] - y*Sin[t/2])*Cos[t],
                  (3 + x*Cos[t/2] - y*Sin[t/2])*Sin[t], 
                  x*Sin[t/2] + y*Cos[t/2]}
Show[
    ParametricPlot3D[
      {F[1, u, t], F[u, 1, t], F[u, 0, t]},
      {t, 0, 4 Pi}, {u, -1, 1},
      PlotStyle -> {{Blue, Opacity[0.3]}, {Blue, Opacity[0.3]},
                    {Green, Opacity[0.5]}},
      Mesh -> None, PlotPoints -> {30, 2}, 
      ImageSize -> 500, ViewPoint -> {0, -3, 3}, 
      ViewVertical -> {0, 0, 1} , Boxed -> False, Axes -> None],
    ParametricPlot3D[
      {F[1, 1, t], F[-1, 1, t], F[1, 0, t]},
      {t, 0, 4 Pi},
      PlotStyle -> Darker[Blue] , PlotPoints -> 30]
    ]

Answer 3

Estoy demasiado tarde el héroe aquí, pero voy a postear la forma general de una "torcida" de la superficie de integridad, que se puede adaptar fácilmente a sus necesidades:

$$\begin{pmatrix}\cos\,u&-\sin\,u&0\\\sin\,u&\cos\,u&0\\0&0&1\end{pmatrix}\cdot\left(\begin{pmatrix}a\\0\\0\end{pmatrix}+\begin{pmatrix} \cos\,bu&0&-\sin\,bu\\0&1&0\\\sin\,bu&0&\cos\,bu\end{pmatrix}\cdot\begin{pmatrix}f(v)\\0\\g(v)\end{pmatrix}\right)$$

or explicitly,

$$\begin{align*}x&=(a+f(v)\cos\,bu-g(v)\sin\,bu)\cos\,u\\y&=(a+f(v)\cos\,bu-g(v)\sin\,bu)\sin\,u\\z&=f(v)\sin\,bu+g(v)\cos\,bu\end{align*}$$

where $(f(v)\quad g(v))^T$ is the plane curve that makes the "cross-section" of your twisted surface, $b$ is a "twist factor" (e.g. $b=\frac12$, a "half-twist", for a Möbius strip), and $$ is the distance from the origin to the "center" of the cross-section. (The way I have written the matrix-vector expression for the twisted surface should give a hint on how it was derived.) For the case of the Möbius strip, one appropriate cross-section is the line segment given by $(c-v\quad 0)^T$, $c$ a constant.

For the problem at hand of drawing a "thickened" strip, I use the square Lamé curve $(|\cos\,v|\cos\,v\quad |\sin\,v|\sin\,v)^T$ (convenientemente girado) como la sección transversal. (Si es necesario, por supuesto, es trivial para cambiar el cuadrado de un rectángulo.)

Por lo tanto, el siguiente Mathematica código genera una cinta de Moebius y su "engrosamiento" de la versión: (ajustar los parámetros y colores/estilos a gusto):

twist[{f_, g_}, a_, b_, u_] := {Cos[u] (a + f Cos[b u] - g Sin[b u]), 
  Sin[u] (a + f Cos[b u] - g Sin[b u]), g Cos[b u] + f Sin[b u]}

With[{a = 3, b = 1/2, f = 1/2}, 
  ParametricPlot3D[{
     twist[f {Cos[Pi v/f] Abs[Cos[Pi v/f]] - Sin[Pi v/f] Abs[Sin[Pi v/f]], 
        Cos[Pi v/f] Abs[Cos[Pi v/f]] + Sin[Pi v/f] Abs[Sin[Pi v/f]]}, a, b, u],
     twist[{f - v, 0}, a, b, u]}, {u, 0, 2 Pi}, {v, 0, 2 f},
     Axes -> None, Boxed -> False,
     Mesh -> None, PlotStyle -> {{Opacity[1/5], Blue}, Green}]]

Answer 4

Aquí es un código de uso de RegionPlot3D. Tiene un bonito "sólido", pero el problema es que para obtener una calidad decente tienes que subir el número de puntos de la trama demasiado alto...

p1 = ParametricPlot3D[{3 Cos[t], 3 Sin[t], 0} + 
u (Cos[t/2 + \[Pi]/4] {Cos[t], Sin[t], 0} + 
   Sin[t/2 + \[Pi]/4] {0, 0, 1}), {t, 0, 2 \[Pi]}, {u, -1/Sqrt[2],
 1/Sqrt[2]}, PlotStyle -> Red, Mesh -> False];
p2 = RegionPlot3D[
   Abs[(Cos[Arg[x + I y]/2] Sqrt[x^2 + y^2] + 
         Sin[Arg[x + I y]/2] z) - 3 Cos[Arg[x + I y]/2]] + 
     Abs[(-Sin[Arg[x + I y]/2] Sqrt[x^2 + y^2] + 
         Cos[Arg[x + I y]/2] z) + 3 Sin[Arg[x + I y]/2]] <= 1, {x, -4,
     4}, {y, -4, 4}, {z, -1, 1}, BoxRatios -> Automatic, 
   PlotPoints -> 100, Mesh -> False, 
   PlotStyle -> {{Green, Opacity[.7]}}];
Show[p1, p2, PlotRange -> All, Axes -> False, Boxed -> False]