Drawing a thickened Möbius strip in Mathematica

Question

I would like to have Mathematica plot a "thickened Möbius strip", i.e. a torus with square cross section that is given a one-half twist. Ideally, I would like this thickened Möbius strip to be transparent with a (non-thickened) solid Möbius strip sitting at its center; here is the best approximation I could draw by hand of what I want:
My motivation here is that I want to use the thickened Möbius strip a visual representation of a line bundle over $E$, where $E$ is the Möbius strip; that's why I'd like the Möbius strip at the center to be visible. A line bundle over $E$ can be identified with the bundle $E\oplus E$ over $\mathbb{S}^1$.

I was approaching this by attempting to draw the (two) sides of the thickened Möbius strip as parametric surfaces. Modeling my line bundle as $$E\oplus E=\mathbb{R}^3/\langle (t,x,y)\mapsto(t+2\pi,-x,-y)\rangle,$$ a global frame is given by the vector fields $v,w:\mathbb{S}^1\rightarrow E\oplus E$, where $$v(t)=\overline{(t,\cos(t),\sin(t))},\hskip0.3in w(t)=\overline{(t,-\sin(t),\cos(t))}.$$ Using these $\{v(t),w(t)\}$ as a basis for the copy of $\mathbb{R}^2$ at each point $t\in\mathbb{S}^1$, it is not hard to describe what the sides of the thickened Möbius strip look like within $E\oplus E$. My difficultly lies in finding the equations that describe the "obvious" immersion $F:E\oplus E\rightarrow\mathbb{R}^3$, the map that e.g. has $$F\left(\overline{(t,0,0)}\right)=(R\cos(t),R\sin(t),0)$$ where $R$ is the radius of the "actual" square-torus-with-twist, and $$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)})$}}.$$

Any help would be much appreciated.

Answer 1

The following code produces roughly what you're looking for:

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 2

I have been working on the problem some more, and I think the equations I came up with are equivalent to Jim's. I've combined parts of Jim's answer with mine, made the code a bit more modular, and for the sake of completeness I'll post here the result:

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

Here are some example results:

ThickMobius[6,2,0.001]

ThickMobius[6,1,0.001]

ThickMobius[6,2.5,0.003]

Answer 3

I'm too late the hero here, but I'm posting the general form of a "twisted" surface for completeness, which you can easily adapt to your needs:

$$\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 $a$ 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$ (suitably rotated) as the cross-section. (If needed, it is of course trivial to change the square to a rectangle.)

Thus, the following Mathematica code generates a Möbius strip and its "thickened" version: (adjust parameters and colors/styles to taste):

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

Here is a code using RegionPlot3D. It has a nice "solid" feel, but the problem is that to get decent quality you have to jack up the number of plot points way too high...

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]