Rot[z_, w_]:=Function[u, ((z u+w)/(-Conjugate[w]u+Conjugate[z]))]

Proj[z_, s_]:=Module[{x=Re[z], y=Im[z]},
{((1-s)(Sqrt[(x^2)+(y^2)])+s Sin[2ArcTan[(Sqrt[(x^2)+(y^2)])]])Cos[Arg[x+y I]],((1-s)(Sqrt[(x^2)+(y^2)])+s Sin[2ArcTan[(Sqrt[(x^2)+(y^2)])]])Sin[Arg[x+y I]], -1(1-s)+s(-Cos[2ArcTan[(Sqrt[(x^2)+(y^2)])]])}
]

Manipulate[Show[ParametricPlot3D[{Sin[ψ]Sin[ϕ], Sin[ψ]Cos[ϕ], -Cos[ψ]}, {ϕ, 0, 2Pi}, {ψ, 0, Pi}, Mesh->None], ParametricPlot3D[Proj[x+I y, s], {x, -R, R}, {y, -R, R}, Mesh->{15, 15}], PlotRange->All], {s, 0, 1}, {{R, 2}, (1/2), 10}]

Manipulate[{Show[ParametricPlot3D[{0.98Sin[ψ]Sin[ϕ], 0.98Sin[ψ]Cos[ϕ], -0.98Cos[ψ]}, {ϕ, 0, 2Pi}, {ψ, 0, Pi}, Mesh->None, PlotStyle->Blue], ParametricPlot3D[Proj[Rot[p[[1]]+I p[[2]], q[[1]]+I q[[2]]][x+I y], s], {x, -R, R}, {y, -R, R}, Mesh->None, PlotStyle->Green], Graphics3D[{Red, Sphere[Proj[((q[[1]]+I q[[2]])/(p[[1]]-I p[[2]])), 1],0.1]}], PlotRange->All], Graphics[{LightGreen, Disk[{0, 0}, 1],Red, Text[Style["Z", Large, Bold], p], Blue,  Text[Style["W", Large, Bold], q]},PlotRange->1]}, {{s, 0}, 0, 1}, {{R, 2}, 0.1, 20}, {{p,{0,1}},Locator},{{q,{0,0}},Locator}]

Ahhoz, hogy P((((Subscript[u, R])-(Subscript[v, R]))/(1+(OverBar[(Subscript[u, R])]) (Subscript[v, R])))) a főkörön van.

Manipulate[{Show[ Graphics3D[{Black, Cylinder[{{0,0, -0.01}, {0, 0, 0.01}}, 1], White, Sphere[{0,0, 0}, 1],Red, Sphere[Proj[ur[[1]]+I ur[[2]], 1],0.1],Blue, Sphere[Proj[vr[[1]]+I vr[[2]], 1],0.1],Green,Sphere[Proj[Rot[1, ur[[1]]+I ur[[2]]][vr[[1]]+I vr[[2]]], 1],0.1]}], PlotRange->1.1], Graphics[{LightGreen, Disk[{0, 0}, 1],Red, Text[Style["(Subscript[u, R])", Large, Bold], ur], Blue, Text[Style["(Subscript[v, R])", Large, Bold], vr]},PlotRange->2]}, {{R, 2}, 0.1, 20}, {{ur,{0,1}},Locator}, {{vr,{1,0}},Locator}]