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: enter image description here
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.


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]}
      {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],
      {F[1, 1, t], F[-1, 1, t], F[1, 0, t]},
      {t, 0, 4 Pi},
      PlotStyle -> Darker[Blue] , PlotPoints -> 30]
  • $\begingroup$ +1, thanks for your help, Jim! Your answer does indeed produce what I was looking for, so I have accepted it. I tweaked some aspects and posted the result in a separate answer below. $\endgroup$ – Zev Chonoles May 29 '11 at 3:07

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] enter image description here

ThickMobius[6,1,0.001] enter image description here

ThickMobius[6,2.5,0.003] enter image description here


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,


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

thick Möbius


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]

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.