Message Boards

WOLFRAM COMMUNITY

14032 Views

5 Replies

13 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Staff Picks Mathematics Visual Arts Dynamic Interactivity Geometry Graphics and Visualization Wolfram Language

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

Clayton Shonkwiler

Clayton Shonkwiler, Colorado State University

Posted 8 years ago

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

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

5 Replies

Sort By:

EDITORIAL BOARD

EDITORIAL BOARD, WOLFRAM

Posted 8 years ago

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

POSTED BY: EDITORIAL BOARD

Patrick Scheibe

Patrick Scheibe, University Leipzig

Posted 8 years 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: 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

Clayton Shonkwiler

Clayton Shonkwiler, Colorado State University

Posted 8 years 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.