Group Abstract

Message Boards

WOLFRAM COMMUNITY

17.7K 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 9 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