# [GIF] Double Projection (Projected rotating 16-cell)

Posted 5 months ago
824 Views
|
|
2 Total Likes
| Double ProjectionThis is a similar idea to J34: starting with the vertices of the 16-cell (a.k.a. cross polytope, a.k.a. orthoplex) and thinking of them as points on the 3-sphere, I'm applying a rotation, then projecting down to the 2-sphere using the Hopf map. From there, the difference from J34 is that I'm taking those points on the 2-sphere, forming a spherical disk of radius 0.4, then stereographically projecting down to the plane (this last step uses the ProjectedSphericalCircle[] function from Small Changes which, given the center and radius of a disk on the sphere, outputs a Disk[] in the plane which is its stereographic image).First of all, we need the Hopf map and the smootherstep function: Hopf[{x_, y_, z_, w_}] := {x^2 + y^2 - z^2 - w^2, 2 y z - 2 w x, 2 w y + 2 x z}; smootherstep[t_] := 6 t^5 - 15 t^4 + 10 t^3; And the vertices of the 16-cell: sixteencellvertices = Normalize /@ Flatten[Permutations[{-1, 0, 0, 0}]^# & /@ Range[1, 2], 1]; And then this is the animation code: With[{pts = Normalize /@ sixteencellvertices, viewpoint = 2 {1, 0, 0}, cols = RGBColor /@ {"#00adb5", "#f8b500", "#1a0841"}}, Manipulate[ Graphics[ {Blend[ cols[[;; 2]], (Floor[t] + Sign[1 - t] smootherstep[Mod[t, 1]])], Table[ ProjectedSphericalCircle[ RotationMatrix[π/2, {0, 0, 1}]. Hopf[ RotationMatrix[π/2 (Floor[t] + smootherstep[Mod[t, 1]]), {{1, 1, 0, 0}, {0, 0, 1, 1}}].pts[[i]] ], .4], {i, 1, Length[pts]}]}, PlotRange -> 3, ImageSize -> 540, Background -> cols[[-1]]], {t, 0, 2}] ] Finally, here's an image where I've composited together all of the frames of a similar animation (essentially the same thing without the smootherstep function, so it's just a constant-speed rotation):  Answer - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming, and consider contributing your work to the The Notebook Archive! Answer