# Showing a rectangular plot on an almost-closed sphere

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.

-
Could you explain "a sphere with a disk removed (the gluing isn't finished yet)." a little further? (or upload an image!) –  belisarius Feb 26 '13 at 20:59
@belisarius: Here is some sample code: SphericalPlot3D[1, {theta, 0, Pi}, {phi, 0, 3 Pi}, RegionFunction -> (#1 < .8 &), Mesh -> None, Boxed -> False, Axes -> False] –  Steve D Feb 26 '13 at 21:07
You can imagine the rectangular plot being stretched over this sphere, so that the boundary is basically infinity in rectangular coordinates. (I don't know if RegionFunction is the right approach, but it is what has worked for me so far.) –  Steve D Feb 26 '13 at 21:08
What mapping are you using from the plane to the sphere? Perhaps you could show the successful result for step 3. –  Simon Woods Feb 26 '13 at 21:17
I'm not sure what you are looking for, but if the problem is because of "Texture" gives rastered image so that the result look not good, you can try directly change the 2d plot to 3d plot by changing the coordinates and map it onto the sphere. A example is here mathematica.stackexchange.com/a/19963/1364 –  xslittlegrass Feb 26 '13 at 23:21

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.)

-
This seems like the sensible way to go about it. Also makes it not too difficult to show from different projections, that is, using different affine slices. –  Daniel Lichtblau Feb 27 '13 at 14:53
@Daniel That's right. The importance of stereographic projection is that it is a rational transformation between the affine and projective planes, so that changing the pole of the projection--which I think is what you might have in mind with "affine slices"--just gives an alternative affine picture of the same cubic (or the same rational function, if you began with a rational function). –  whuber Feb 27 '13 at 15:15
Yes, that's what I meant. Maybe a better phrasing would have been "projecting through different affine planes". Different from the (x,y) plane we started in, that is, wherein we set the homogenizing variable to 1. (Okay, maybe that's just as confusing as what I said in fewer words.) –  Daniel Lichtblau Feb 27 '13 at 15:29
This is a great answer, but it is lacking one thing, that might not have been clear from my question: I want the actual axes and everything to be on the surface of the sphere. That is why I added that picture, and why I hinted at using texture. –  Steve D Feb 27 '13 at 18:47
I answered before you added that image, Steve. But what precisely do you mean by "actual axes" on the surface of the sphere? What values do they purport to show? Explain that and perhaps we can find a solution that meets your needs :-). –  whuber Feb 27 '13 at 18:55

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:

-
This is great! When I have some time later, I will try it out, making a few slight adjustments (I'd like to watch that visualization from the bottom of the sphere). But thanks again! –  Steve D Feb 27 '13 at 22:02
This is on the right track, but the example does not seem mathematically correct, because it illustrates a series of maps from the plane to the sphere rather than a single, fixed map to the sphere. In fact, it appears to be a series of maps from the square to the sphere which, in the limit, will map only the square to the entire sphere. A mathematically correct answer would look like the texture on the sphere is fixed (immobile) and that the sphere is merely being more or less chopped off near its top. –  whuber Feb 28 '13 at 16:07
@whuber, true. The static image (with k = 3) shows a correct projection I think, since the plot ranges from -3 to 3 in both directions. The idea with the animation was to show a gradual transition from the plane to the sphere, as if the page was curling up. –  Simon Woods Feb 28 '13 at 17:41
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:

-
Great approach! But as I mentioned in a comment above (and now an edit to the question), I want the entire plot (graph, axes, tick marks, etc.) to be on the sphere. –  Steve D Feb 27 '13 at 18:50

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


-