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

Posted 1 year ago
3000 Views
|
5 Replies
|
13 Total Likes
|
 InterlockThis 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, π}] ] 
5 Replies
Sort By:
Posted 1 year ago
 This hurts my brain a bit...
Posted 1 year ago
 That's what I was going for!
Posted 1 year 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.
 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.