(* S2S1ani is an animation of the homeomorphism S^2 \ S^1 = S^0 x D^2 *) (* S2S1hty is an animation of the equivalence S^2 \ S^1 = S^0. *) <<../live.m f[r_,th_] := {r Cos[th],r Sin[th],1} g[r_,th_] := {r Cos[th],r Sin[th],Sqrt[1-r^2]} h[t_,r_,th_] := (1-t) f[r,th] + t g[r,th] opts := {Boxed -> False, Axes -> False, AspectRatio -> Automatic, ViewPoint -> {1,-6,1}, PlotRange -> {{-1.1,1.1},{-1.1,1.1},{-1.1,1.1}}} hopts := Join[opts,{DisplayFunction -> Identity}] F[t_] := Show[{ ParametricPlot3D[ h[1. t,r,th], {th,0.,2 Pi}, {r,0,1}, Evaluate[hopts]], ParametricPlot3D[ {1,1,-1} h[1. t,r,th], {th,0.,2 Pi}, {r,0,1}, Evaluate[hopts]], Graphics3D[{ Thickness[0.01], Red, Line[Table[{Cos[th],Sin[th],0},{th,0,2 Pi,Pi/20}]] }]}, Evaluate[hopts] ] makeanim["sphere/S2S1ani",F,ImageSize -> 3 * 72] skel = Show[{ Table[ ParametricPlot3D[ sph[th,ph], {th,0,2 Pi}, Evaluate[hopts]], {ph,0,Pi,Pi/20} ], Table[ ParametricPlot3D[ sph[th,ph], {ph,0,Pi}, Evaluate[hopts]], {th,0,2 Pi,Pi/10} ] }] H[t_] := Show[{ skel, ParametricPlot3D[ sph[th,(1-t) ph], {th,0,2 Pi}, {ph,0.01,Pi/2 - 0.01}, Evaluate[hopts] ], ParametricPlot3D[ sph[th,Pi - (1-t) ph], {th,0,2 Pi}, {ph,0.01,Pi/2 - 0.01}, Evaluate[hopts] ], Graphics3D[{ Thickness[0.01], Green, Line[Table[sph[th,Pi/2],{th,0,2 Pi,Pi/20}]], Red, PointSize[0.02], Point[{0,0,1}], Point[{0,0,-1}] }] }] makeanim["sphere/S2S1hty",H,ImageSize -> 3 * 72]