Showing a rectangular plot on an almost-closed sphere

Question

I am currently teaching some students about the "point at infinity", and how it allows us to treat circles and lines as "the same", etc. I would like to kind of show this happening with a series of three images:

1. The usual, $x$-$y$ plane plot of some function (say $y=x^3$)
2. That plot, on the surface of an incomplete sphere: that is, a sphere with a disk removed (the gluing isn't finished yet).
3. The plot on a complete sphere (bonus points if the ends of the cubic join together!)

Now, I have been playing with Texture for the last 90min or so, and while I think I can eventually get it to do what I want for step 3., I don't see how to get it to work for step 2. The problem is, when I do an incomplete sphere (I have been using a RegionFunction), the Texture is distorted by this. In fact, the distortion is quite nasty (I am always completely confused by TextureCoordinates).

Is there a way to do this in a nice way? I am open to any suggestions!

EDIT: here is a picture of what I mean by "incomplete sphere":

2nd EDIT: here is a picture of what I had in mind (for step 3 anyway):

Code:

SphericalPlot3D[1, {theta, 0, Pi}, {phi, 0, 2 Pi},  PlotStyle -> Texture[p], 
        TextureCoordinateFunction -> ({#5, 1 - #4} &), Lighting -> "Neutral",
        Mesh -> None, Axes -> False, Boxed -> False]

3rd EDIT: Sorry for the confusion, and multiple edits! When I say "that plot" on the surface of a sphere, I mean the graph, the axes, the tick marks, everything.

Answer 1

It sounds like you might like to use a stereographic projection.

xy[ϕ_, λ_] := 2 Tan[(π - ϕ)/2] {Cos[λ], Sin[λ]};

Here is a cubic with a free parameter (for fun):

cubic[{x_, y_}, b_] := y^3 - b x y + 4 x^3;

For the sphere, use SphericalPlot3D of course. Although you could resort to ParametricPlot3D for the cubic curve, it's automatic and much simpler to co-opt the Mesh option. We vary the contour level of the cubic, thereby plotting $y^3 - b x y + 4 x^3 = c$ for countour = $c$, and of course we vary the opening in the sphere near $\infty$. For reference, look at a traditional plot in Cartesian coordinates $(x,y)$ using ContourPlot.

Let's play:

Manipulate[
 GraphicsRow[{SphericalPlot3D[1, {ϕ, opening, π}, {λ, 0, 2 π}, 
    MeshFunctions -> {#4 &, #5 &,  
      Function[{x, y, z, ϕ, λ, r}, cubic[xy[ϕ, λ], b]]}, 
    Mesh -> {8, 16, {contour}}, 
    MeshStyle -> {{Thin, Opacity[.25], White}, {Thin, Opacity[.25], White}, Thick}, 
    PlotStyle -> Opacity[0.75], Boxed -> False, AxesLabel -> {x, y, z}], 
   ContourPlot[cubic[{x, y}, b] == contour, {x, -3, 3}, {y, -3, 3}, ContourStyle -> Thick]}],
 {{opening, 0.25}, 0, π}, {{contour, 0}, -4, 4}, {{b, -4}, -8, 8}]

(I have left the contour plot within Manipulate because it is likely you would like to decorate it with, say, the projection of the opening circle into the plane and to zoom in or out accordingly.)

Answer 2

Perhaps something like this?

p = Plot[x^3/9, {x, -3, 3}, PlotStyle -> Thickness[0.01], 
   Filling -> Axis, AspectRatio -> 1, ImageSize -> 500, 
   BaseStyle -> {FontFamily -> "Calibri", 30}, AxesStyle -> Thick];

With[{k = 3}, 
 SphericalPlot3D[1, {theta, 0, Pi}, {phi, 0, 2 Pi}, Mesh -> None, 
  Boxed -> False, Axes -> False, Lighting -> "Neutral", 
  PlotStyle -> Texture[p],
  TextureCoordinateFunction -> ({#1/(1 - #3), #2/(1 - #3)}/(2 k) + 0.5 &),
  TextureCoordinateScaling -> False, PlotPoints -> 100, 
  RegionFunction -> (-k < #1/(1 - #3) < k && -k < #2/(1 - #3) < k &), 
  BoundaryStyle -> Black]]

The sphere is not complete, because the plane is finite. The parameter k controls the width of the plane, with larger k the sphere will become more complete.

Varying k gives a nice visualisation of the transformation from plane to sphere:

Answer 3

u = {x, x^3, 0};
v = {0, 0, z2};
l = (u - v) t + v;
w = l /. Solve[xs xs + ys ys + (zs - 1)^2 == 1 /. Thread[{xs, ys, zs} -> l], t][[2]];
Manipulate[Show[
  ParametricPlot3D[{Cos[u] Sin[v], Sin[u] Sin[v], 1 - Cos[v]}, {v, ArcCos[1 - z1], 0}, 
                  {u, 0, 2 Pi}, PlotStyle -> {Opacity[.3], FaceForm[Red, Yellow]}, Mesh -> False, 
                  PlotRange -> {{-1, 1}, {-1, 1}, {0, 2}}], 
  Graphics3D[{Opacity[.3], Cuboid[{-1, -1, -.01}, {1, 1, .01}]}], 
  ParametricPlot3D[{u, u^3, 0}, {u, -1, 1}], 
  ParametricPlot3D[w /. z2 -> z1, {x, -10^3, 10^3}, PlotPoints -> 300]], 
{z1, 0.1, 2}]

The same with a spiral instead of a cubic:

Answer 4

Without knowing exactly how you want to define your projected function in terms of the spherical coordinates, I'll just make up a definition and use the following, based on this answer by Vitaliy Kaurov:

f[θ_, ϕ_] := SphericalHarmonicY[2, 1, θ, ϕ]

With[{thetaMin = .8},
 SphericalPlot3D[1, {θ, thetaMin, Pi}, {ϕ, 0, 2 Pi},
   ColorFunction -> (Hue[Re[f[#4, #5]] - .7] &), Mesh -> True,
  ColorFunctionScaling -> False,
  PlotPoints -> 100]
 ]