Message Boards Message Boards

[GIF] Interlock (Rotating Clifford torus/Hopf fibration)

GROUPS:

Rotating Clifford torus/Hopf fibration

Interlock

This animation shows the stereographic image of 22 Hopf circles on the Clifford torus while they are being rotated in the $xw$-plane in $\mathbb{R}^4$.

The actual version I exported causes Manipulate to abort on my machine, so here's the code for a lower-quality version for which Manipulate is only moderately laggy. The version I exported used n=200 instead of n=30.

Stereo[{x1_, y1_, x2_, y2_}] := {x1/(1 - y2), y1/(1 - y2), x2/(1 - y2)};

With[{n = 30, m = 22, viewpoint = 5 {1, 0, 0}, 
  cols = RGBColor /@ {"#2292CA", "#EEEEEE", "#222831"}},
 Manipulate[
  Graphics3D[
   {cols[[1]],
    Table[
     Tube[
      Table[
       Stereo[
        RotationTransform[-s, {{1, 0, 0, 0}, {0, 0, 0, 1}}][1/Sqrt[2] {Cos[θ], Sin[θ], Cos[θ + t], Sin[θ + t]}]],
       {θ, 0., 2 π, 2 π/n}]
      ],
     {t, 0., 2 π, 2 π/m}]},
   ViewPoint -> viewpoint, Boxed -> False, Background -> cols[[-1]], 
   ImageSize -> 500, PlotRange -> 10, ViewAngle -> π/50, 
   Lighting -> {{"Point", cols[[1]], {0, -1, 0}}, {"Point", cols[[2]], {0, 1, 0}}, 
      {"Ambient", RGBColor["#ff463e"], viewpoint}}],
  {s, 0, π}]
 ]
POSTED BY: Clayton Shonkwiler
Answer
5 months ago

This hurts my brain a bit...

POSTED BY: Sander Huisman
Answer
5 months ago

That's what I was going for!

POSTED BY: Clayton Shonkwiler
Answer
5 months ago

This looks really nice and you get a big +1 from me!

However, consider that you are creating a RotationTransform in each iteration of the table, plug it into Stereo and use the resulting point for your tubes. This is unnecessary because the result can be calculated ahead completely analytical with unknown parameters:

Mathematica graphics

This repeated unnecessary calculation is, besides the rendering of the 3D graphics, one key point that slows down your Manipulate. Therefore, why don't we try to build a compiled function from the output above and call it in parallel on the inner table?

Stereo[{x1_, y1_, x2_, y2_}] := {x1/(1 - y2), y1/(1 - y2), x2/(1 - y2)};
stereoC = Compile[
  {{θ, _Real, 0}, {t, _Real, 0}, {s, _Real, 0}},
  #,
  Parallelization -> True,
  RuntimeAttributes -> {Listable}]&[
    Stereo[RotationTransform[-s, {{1, 0, 0, 0}, {0, 0, 0, 1}}][
    1/Sqrt[2] {Cos[θ], Sin[θ], Cos[θ + t], Sin[θ + t]}]]
  ]

Don't get confused; I have to evaluate the Stereo expression before I inject it into the Compile body.

Now you can try the Manipulate with the same parameters and hopefully, it is as fast as on my machine:

With[{n = 30, m = 22, viewpoint = 5 {1, 0, 0}, 
  cols = RGBColor /@ {"#2292CA", "#EEEEEE", "#222831"}}, 
 Manipulate[
  Graphics3D[{cols[[1]], 
    Table[Tube[
      stereoC @@ 
       Transpose@
        Table[{θ, t, s}, {θ, 0., 2 π, 
          2 π/n}]], {t, 0., 2 π, 2 π/m}]}, 
   ViewPoint -> viewpoint, Boxed -> False, Background -> cols[[-1]], 
   ImageSize -> 500, PlotRange -> 10, ViewAngle -> π/50, 
   Lighting -> {{"Point", cols[[1]], {0, -1, 0}}, {"Point", 
      cols[[2]], {0, 1, 0}}, {"Ambient", RGBColor["#ff463e"], 
      viewpoint}}], {s, 0, π}]]

Final note, if your Manipulate aborts because the calculation takes too long, try setting SynchronousUpdating -> False and you are fine.

POSTED BY: Patrick Scheibe
Answer
5 months ago

Thanks!

As you've probably guessed, the reason I used

Stereo[RotationTransform[-s, {{1, 0, 0, 0}, {0, 0, 0, 1}}][1/Sqrt[2] {Cos[θ], Sin[θ], Cos[θ + t], Sin[θ + t]}]]

rather than just evaluating it separately and replacing it with the expression it evaluates to is to enhance the readability of the code. But your solution of using a compiled function is a good way to dramatically speed things up while maintaining a reasonable level of readability.

I should definitely use compiled functions much more often than I do, but they always seem like voodoo to me, so it's definitely helpful to see an example of a compiled function I would actually use.

POSTED BY: Clayton Shonkwiler
Answer
5 months ago

enter image description here - Congratulations! This post is now a Staff Pick! Thank you for your wonderful contributions. Please, keep them coming!

POSTED BY: Moderation Team
Answer
5 months ago

Group Abstract Group Abstract