The basic idea is simple: take =1521 small spheres centered at points on the Clifford torus inside the 3-sphere, rotate in the -plane, and then stereographically project down to 3-space.
One could theoretically accomplish this with ParametricPlot3D[], but with so many spheres I strongly suspect the kernel would crash long before you could actually render it. So instead I had to figure out the following: given a 2-sphere of radius centered at a point in the 3-sphere, what is the center and radius of the resulting 2-sphere after stereographically projecting to .
2
39
zw
One could theoretically accomplish this with ParametricPlot3D[], but with so many spheres I strongly suspect the kernel would crash long before you could actually render it. So instead I had to figure out the following: given a 2-sphere of radius
r
p
3
To figure that out, define the stereographic projection map:
In[]:=
Stereo[{x1_,y1_,x2_,y2_}]:={x1/(1-y2),y1/(1-y2),x2/(1-y2)}
And a function which gives an orthonormal basis for the orthogonal complement of a point in the 3-sphere:
In[]:=
ThreeSpherePointPerp[{x_,y_,z_,w_}]:={{-y,x,-w,z},{-z,w,x,-y},{-w,-z,y,x}};
(All this is doing is thinking of the point as a unit quaternion , and then multiplying on the left by , , and , yielding , , and . Then is guaranteed to be an orthonormal basis for , and in particular is an orthonormal basis for .)Next, using spherical coordinates in , we can define a sphere of radius centered at :
p=(x,y,z,w)
q=x+iy+jz+kw
i
j
k
ip
jp
kp
(p,ip,jp,kp)
4
(ip,jp,kp)
⊥
p
⊥
p
r
p
In[]:=
ThreeSphereSphere[p_,r_,θ_,ϕ_]:=With[{b=ThreeSpherePointPerp[p]},Cos[r]p+Sin[r](Cos[ϕ]Sin[θ]b〚1〛+Sin[ϕ]Sin[θ]b〚2〛+Cos[θ]b〚3〛)];
At this point, leaving and symbolic, I just found where the normal lines to two points on the stereographic projection of the above sphere intersected: this is the center of the projected sphere, and its distance from either of the two points is its radius. I then encoded that in the function ProjectedSphere[{x_, y_, z_, w_}, r_], which outputs a Sphere[] object of the appropriate center and radius (the definition is very long and slightly horrifying, so I’ve deferred it until the end of this post).
p
r
With all of that in place, then, here’s the Manipulate for the above animation (which undoubtedly could be optimized):
With{a=39,b=39,cols=RGBColor/@{"#1DCED8","#F6490D","#000249"}},ManipulateGraphics3DTableProjectedSphere,.05,θ,0.,2π-,,{i,0,b-1},PlotRange3,ViewPoint{.38,0,0},ViewAngle,ImageSize540,BoxedFalse,Backgroundcols-1,SphericalRegionTrue,Lighting{{"Point",cols〚1〛,{0,1,0}},{"Point",cols〚2〛,{0,-1,0}}},t,0.,
Cosθ+,Sinθ+,Cos+t,Sin+t
2πi
3a
2πi
3a
2πi
b
2πi
b
2
2π
a
2π
a
π
2
3×2π
b
And, finally, here’s the definition of ProjectedSphere. I’m sure there are various simplifications one could do to make this less intimidating, but I didn’t have the patience to do much more than apply Simplify[] with some reasonable TimeConstraint.
In[]:=