(* 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]