S^1 -> R^1

circle=Plot[Evaluate[y/.Solve[x^2+y^2==1,y]],{x,-1,1},PlotStyle->Black];
projectS1R1[theta_]:=Module[
{p,equation,pp,plotP,plotPP,line,inf},
(* Point representing infinity (at top of circle) *)
inf={0,1};
(* Original point on S^2 *)
p={Cos[theta],Sin[theta]};
plotP=Graphics[{Green,PointSize[0.03],Point[p]}];
(* Equation for line projecting down to R^1 *)
equation[t_]:=(t*p)-(t-1)*inf;
sol=Solve[equation[t][[2]]==0,t][[1]];
(* R^1 point *)
pp=equation[t]/.sol;
plotPP=Graphics[{Blue,PointSize[0.03],Point[pp]}];
(* Plot line connecting everything *)
line=Graphics[Line[{inf,p,pp}]];
Return[Show[plotP,plotPP,line]];
];
Manipulate[
Show[projectS1R1[t],circle,Axes->True,PlotRange->{{-2,2},{-2,2}}],
{t,0,2*Pi}]

S^2 -> R^2

sphere=Plot3D[Evaluate[z/.Solve[x^2+y^2+z^2==1,z]],{x,-1,1},{y,-1,1},PlotStyle->Opacity[0.2],PlotRange->All,Mesh->None];
planeR2=Plot3D[0,{x,-4,4},{y,-4,4},PlotStyle->Opacity[0.4]];

projectS2R2[theta_,phi_]:=Module[
{p,equation,pp,plotP,plotPP,line,inf,sol},
(* Point representing infinity (at top of sphere) *)
inf={0,0,1};
(* Original point on S^3 *)
p={Cos[phi]*Cos[theta],Cos[phi]*Sin[theta],Sin[phi]};
plotP=Graphics3D[{Green,PointSize[0.03],Point[p]}];
(* Equation for line projecting down to R^2 *)
equation[t_]:=(t*p)-(t-1)*inf;
sol=Solve[equation[t][[3]]==0,t][[1]];
pp=equation[t]/.sol;
plotPP=Graphics3D[{Blue,PointSize[0.03],Point[pp]}];
(* Plot line connecting everything *)
line=Graphics3D[Line[{inf,p,pp}]];
Return[Show[plotP,plotPP,line]];
];

Manipulate[Show[sphere,planeR2,projectS2R2[t,p],PlotRange->{{-2,2},{-2,2},{-2,2}},BoxRatios->{1, 1, 1},Boxed->False,Axes->False],{t,0,2*Pi},{p,0,2*Pi}]

S^3 -> R^3

(*hypersphere=Plot3D[Evaluate[z/.Solve[x^2+y^2+z^2==1,z]],{x,-1,1},{y,-1,1},PlotStyle->None,PlotRange->All];*)
sphere=Plot3D[Evaluate[z/.Solve[x^2+y^2+z^2==1,z]],{x,-1,1},{y,-1,1},PlotStyle->Opacity[0.2],Mesh->None,PlotRange->All];
projectS3R3[theta_,phi_,gamma_]:=Module[
{p,p3D,equation,pp,pp3D,plotP,plotPP,line,inf,inf3D,sol},
(* Point representing infinity (at top of sphere) *)
inf={0,0,0,1};
inf3D=Part[inf,{1,2,3}];
(* Original point on S^4 *)
p={Cos[phi]*Cos[theta],Cos[phi]*Sin[theta],Sin[phi]};
p={
Cos[gamma]*Cos[phi]*Cos[theta],
Cos[gamma]*Cos[phi]*Sin[theta],
Cos[gamma]*Sin[phi],
Sin[gamma]
};
p3D=Part[p,{1,2,3}];
plotP=Graphics3D[{Green,PointSize[0.03],Point[p3D]}];
(* Equation for line projecting down to R^2 *)
equation[t_]:=(t*p)-(t-1)*inf;
sol=Solve[equation[t][[4]]==0,t][[1]];
pp=equation[t]/.sol;
pp3D=Part[pp,{1,2,3}];
plotPP=Graphics3D[{Blue,PointSize[0.03],Point[pp3D]}];
(* Plot line connecting everything *)
line=Graphics3D[Line[{inf3D,p3D,pp3D}]];
Return[Show[plotP,plotPP,line]];
];

Manipulate[Show[sphere,projectS3R3[t,p,g],PlotRange->{{-2,2},{-2,2},{-2,2}},BoxRatios->{1, 1, 1},Boxed->False,Axes->False],{t,0,2*Pi},{p,0,2*Pi},{g,0,2*Pi}]