Lean In

A similar idea to Fall Out, one dimension up. Now I have a 2-sphere in the 3-sphere which I map to 3-space by extending the line containing a point until it intersects the $w=1$ hyperplane, then inverting in the unit sphere and reflecting through the origin.

The underlying object is just the standard equatorial 2-sphere $(x,y,z,0)$ with $x^2+y^2+z^2=1$, which then gets rotated by $\pi/4$ in the plane spanned by $\cos s (0,0,1,0) + \sin s (1,0,0,0)$ and $(0,0,0,1)$ as $s$ varies from $0$ to $2\pi$.

Here's the code:

inversion[p_] := p/Norm[p]^2;

With[{n = 50, m = 31, d = .01, 
  cols = Darker[RGBColor[#]] & /@ {"#43DDE6", "#FC5185", "#364F6B"}},
 Manipulate[
  Graphics3D[
   {Sphere[#, .02] & /@
     Flatten[
      Table[
       i * inversion[#1[[1 ;; -2]]/#1[[-1]]] &[ 
        RotationMatrix[Pi/4, {Cos[s] {0, 0, 1, 0} + Sin[s] {1, 0, 0, 0}, {0, 0, 0, 1}}]
           .{Sqrt[1 - z^2] Cos[θ], Sqrt[1 - z^2] Sin[θ], z, 0}],
       {i, {-1, 1}}, {θ, 0., 2 Pi - 2 Pi/n, 
        2 Pi/n}, {z, -1., 1, 2/m}], 2]},
   PlotRange -> 1.2, Boxed -> False, ViewPoint -> {0, 5, 0}, 
   ImageSize -> 540, Background -> cols[[-1]],
   Lighting -> {{"Point", cols[[1]], 1/2 {Sin[s], 0, Cos[s]}}, 
      {"Point", cols[[2]], 1/2 {-Sin[s], 0, -Cos[s]}}, {"Ambient", cols[[-1]], {0, 5, 0}}}],
  {s, 0, 2 Pi}]
 ]