4
$\begingroup$

Let $T^2\cong S^1\times S^1$ be the one-holed torus surface (say, embedded in $\mathbb{R}^3$) and say I have a simple-ish map $f:T^2\to T^2$ which I'd like to visualize. How might I do that?

To make this concrete, let $f(z,w)=(zw,z^2)$ where $z,w\in S^1$. I'd like to see a decent representation of the image of this map on $T^2$.

Here's what I know:

From a previous answer here, I know I can visualize a torus in Mathematica (as well as plot a contour on it). For example, I can use something like

yourFunc = Function[{u, v}, Re[2 Exp[2 π I (u + 2 v)] + 3 Exp[2 π I (u - 2 v)]]];

ParametricPlot3D[{(2 + Cos[2 π v]) Sin[2 π u], 
   (2 + Cos[2 π v]) Cos[2 π u], Sin[2 π v]}, 
   {u, 0, 1}, {v, 0, 1}, 
   MeshFunctions -> Function[{x, y, z, u, v}, 
   yourFunc[u, v]], Mesh -> {{0}}, 
   MeshStyle -> Directive[Blue, Thick], PlotPoints -> 50]

to visualize (on a torus) the contour corresponding to the zero-set of a provided parametric function:

enter image description here

However, this sort of example hinges on a 3D parametric representation of a torus rather than a product of circles representation and my knowledge is currently insufficient to bridge the gap.

Edit: Per a comment by @Rahul below: I'm considering $S^1$ as a subset of $\mathbb{C}$. In particular, the map $f(z,w)$ can be converted to a map $[0,1]^2\mapsto[0,2]^2$ by converting: $$z=e^{2\pi i\theta},w=e^{2\pi i \phi}\implies zw=e^{2\pi i(\theta+\phi)}\text{ and }z^2=e^{2\pi i(2\theta)}.$$ So, equivalently, we have a map $g:[0,1]^2\to[0,2]^2$ given by $g(\theta,\phi)=(\theta+\phi,2\theta)$. Using Mod, we can visualize a parametric plot for the map $g$:

ParametricPlot[{Mod[u + v, 1], Mod[2 u, 1]}, {u, 0, 1}, {v, 0, 1}]

yields

enter image description here

. Does this help? Note that I tried substituting

yourFunc = Function[{u, v}, {u+v, 2u}];

into the original snippet of code above but that doesn't work.

$\endgroup$
  • $\begingroup$ How is it S^1xS^2 and not S^1xS^1? $\endgroup$ – BlacKow Mar 15 '16 at 18:50
  • $\begingroup$ @BlacKow - Because I are not type good. ;) (fixed now) $\endgroup$ – cstover Mar 15 '16 at 18:52
  • $\begingroup$ You can draw a mesh on our original torus (that would be circles) and then draw (on the second torus) the result of your map applied to every circle $\endgroup$ – BlacKow Mar 15 '16 at 19:15
  • $\begingroup$ What is $zw$ when $z,w\in S^1$? Are we interpreting $S^1$ as a subset of $\mathbb C$? $\endgroup$ – Rahul Mar 15 '16 at 19:30
  • $\begingroup$ @BlacKow - I understand the idea/theory behind what you're saying, but is this something Mathematica can do programmatically? Could you possibly shed some light on the computational aspect in an answer? $\endgroup$ – cstover Mar 15 '16 at 20:37
2
$\begingroup$

You can move the patch around the left torus to see where it's mapped on the right torus by func.

func = Function[{u, v}, {u + v, 2 u}];

Mathematica graphics

func = Function[{u, v}, {u + v, 2 u}];
nmesh = 10;
mesh = {(-0.5 + Range[-nmesh, 2 nmesh])/nmesh,
        (-0.5 + Range[-nmesh, 2 nmesh])/nmesh};
param = Function[{u, v},
   {(2 + Cos[2 π v]) Sin[2 π u], (2 + Cos[2 π v]) Cos[2 π u], Sin[2 π v]}];
With[{patch = First@ParametricPlot[{u, v}, {u, 0, 0.15}, {v, 0, 0.15}]},
  points = Transpose@patch[[1]];
  polygon = Cases[patch, _Polygon, Infinity];
  ];
Manipulate[
 GraphicsRow[{
   Show[
    ParametricPlot3D[
     param[u, v],
     {u, 0, 1}, {v, 0, 1},
     PlotStyle -> None, Mesh -> mesh],
    Graphics3D[GraphicsComplex[
      Dynamic@Transpose[param @@ (p + points)],
      {Red, EdgeForm[], polygon}]]
    ],
   Show[
    ParametricPlot3D[
     param[u, v],
     {u, 0, 1}, {v, 0, 2},
     MeshFunctions -> {Function[{x, y, z, u, v}, 1/2 (2 u - v)],
       Function[{x, y, z, u, v}, v/2]},
     PlotStyle -> None, Mesh -> mesh],
    Graphics3D[GraphicsComplex[
      Dynamic@Transpose[param @@ func @@ (p + points)],
      {Red, EdgeForm[], polygon}]]]
   }],
 {{p, {0, 0}}, {0, 0}, {1, 1}}]

The mesh is computed from the inverse function of func, i.e., Solve[func[s, t] == {u, v}, {s, t}]. One might have to use FindRoot on complicated functions, which might also be quite slow. In such a case, it would be faster to map forward lines in the domain torus, in the way the polygon is mapped onto range torus.

$\endgroup$
  • $\begingroup$ Thank you so much! This is far-and-away better than anything I would have thought possible (definitely anything I would have come up with on my own). This is excellent! $\endgroup$ – cstover Apr 18 '16 at 13:54
1
$\begingroup$

I've been working on this independently as well.

First, I define a function which is projection to a torus of given inner/outer radii:

r1=1;r2=0.3;
f[{\[Theta]_,\[Phi]_}]:={(r1+r2*Cos[\[Phi]])*Cos[\[Theta]],
   (r1+r2*Cos[\[Phi]])*Sin[\[Theta]],r2*Sin[\[Phi]]};

My first step at visualizing such a map was to look at what it does to a lattice in $[0,1]^2$:

pts=6;
grid=Table[{i,j},{i,0,1,1/pts},{j,0,1,1/pts}];
grid2=Table[{Mod[i+j,1],Mod[2 i,1]},{i,0,1,1/pts},{j,0,1,1/pts}];
g=Graphics[Table[Arrow[{{i,j},{Mod[i+j,1],Mod[2i,1]}}], {i,0,1,1/pts},
   {j,0,1,1/pts}]];

Show[g, ListPlot[grid, PlotStyle -> Directive[Blue, PointSize[0.015]]],
   ListPlot[grid2, PlotStyle -> Directive[Red, PointSize[0.015]]]]

enter image description here

And on a torus:

grid3=Evaluate[f]/@Flatten[grid*2Pi,1];
grid4=Evaluate[f]/@Flatten[grid2*2Pi,1];

ptgrid=Evaluate[Point]/@grid3; 
ptgrid2=Evaluate[Point]/@grid4;
g2=Graphics3D[Table[Arrow[{grid3[[i]],grid4[[i]]}],{i,1,Length[grid3]}]];

Show[ListPointPlot3D[grid3, 
   PlotStyle -> Directive[Blue, PointSize[0.02]], 
   PlotRange -> All], ListPointPlot3D[grid4, 
   PlotStyle -> Directive[Red, PointSize[0.02]], PlotRange -> All], 
   g2, ParametricPlot3D[Evaluate@f[{\[Theta], \[Phi]}], 
   {\[Theta], 0, 2*\[Pi]}, {\[Phi], 0, 2*\[Pi]}, Mesh -> None, 
   PlotStyle -> Opacity[0.25], PlotRange -> All]]

enter image description here

I later modified the above so that I could look at the orbit of a single point when the given function is iterated a given number of times.

Note that the above includes a number of ideas borrowed from various places online and so I definitely don't think it's concise, clean, or necessarily well-written.

I would still love to see other people's takes on this, though, so please chime in if you have other ideas, alternatives, etc.!

$\endgroup$
  • $\begingroup$ And yes, I later modified the PlotRange so that the torus wasn't cut off by the box. <(^_^<) $\endgroup$ – cstover Mar 17 '16 at 3:50

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.