# Density plot on the surface of sphere

I would like to make density plots of a list of (size 2 or 3) spherical harmonics on the surface of a sphere. I'd like to plot it so that each element of that list is using a different color (red density plot for the first one, blue for the next, green... and so on)

I tried using ColorFunction like

SphericalPlot3D[1, {θ, 0, Pi}, {ϕ, 0, 2 Pi},
ColorFunction ->
Function[{x, y, z, θ, ϕ, r},
RGBColor[Abs[SphericalHarmonicY[1, 1, θ, ϕ]]^2,
Abs[SphericalHarmonicY[1, 0, θ, ϕ]]^2,
Abs[SphericalHarmonicY[1, -1, θ, ϕ]]^2]]]


but all I get is some dark-green sphere. Is there a function like SphericalDensityPlot so that I can illustrate the functions?

Also, a big problem I'm running into is the ambient lighting direction, which interferes with what it's supposed to look like.

-
 Have a look at this post/answer that might be of help. – Matariki Aug 26 '12 at 23:26

Instead of individually controlling the RGB colors, which is much harder, use the output of your function (a scalar) as the input to some color function.

Here's an example:

SphericalPlot3D[1, {θ, 0, π}, {Φ, 0, 2 π},
ColorFunction -> Function[{x, y, z, θ, Φ, r},
ColorData["DarkRainbow"][Cos[5 θ] + Cos[4 Φ]/2]],
ColorFunctionScaling -> False, Mesh -> False, Boxed -> False, Axes -> False]


Your original function didn't have much variability. Specifically, it doesn't vary in Φ and very little in θ. You can see it in this Manipulate:

Manipulate[
Graphics[{
RGBColor[
Abs[SphericalHarmonicY[1, 1, θ, Φ]]^2,
Abs[SphericalHarmonicY[1, 0, θ, Φ]]^2,
Abs[SphericalHarmonicY[1, -1, θ, Φ]]^2
],
Disk[]
}],
{θ, 0, 2 π}, {Φ, 0, 2 π}
]

-
 Did you add e.g. PlotPoints -> 200 to produce your first graphic, or does v8 output that smooth result by default? (+1) – Mr.Wizard♦ Aug 27 '12 at 2:51 @Mr.Wizard Not by default :) I increased it in my figure above, but left it out in the code because it'd unnecessarily slow things down – rm -rf♦ Aug 27 '12 at 2:58 @Mr. Wizard, that's a common problem with using solid textures; to get really smooth-looking colors, you need to use a large number of polygons (and thus, a large value of PlotPoints). The advantage is that the colors "fit" naturally; you do not have to reckon formulae for mapping a flat image into your surface. (Some of the previous Perlin noise-related work I've done before required lots of PlotPoints and lots of time for rendering, for instance.) – J. M.♦ Aug 27 '12 at 9:19

An alternative to R.M's method that became available in version eight is the Texture[] directive, which allows one to wrap textures on surfaces. For this application, we can wrap the output of DensityPlot[] (after some postprocessing with Image[]) on a sphere. One benefit to this approach is that DensityPlot[] takes care of scaling the spherical harmonics before feeding their values to the ColorFunction.

For instance, to use $\Re(Y_\ell^m(\theta,\phi))$ as the texture, we can do this:

ReYDensityPlot[ℓ_Integer, m_Integer] := Block[{ymap, θ, ϕ},
ymap = Image[DensityPlot[
Re[SphericalHarmonicY[ℓ, m, θ, ϕ]] // Evaluate,
{ϕ, 0, 2 π}, {θ, 0, π}, AspectRatio -> Automatic,
ColorFunction -> "DarkRainbow", Frame -> False,
ImagePadding -> None, PerformanceGoal -> "Quality",
PlotPoints -> 55, PlotRange -> All, PlotRangePadding -> None],
ImageResolution -> 144];
ParametricPlot3D[{Cos[ϕ] Sin[θ], Sin[ϕ] Sin[θ], Cos[θ]},
{ϕ, 0, 2 π}, {θ, 0, π}, Lighting -> "Neutral",
Mesh -> None, PlotStyle -> Texture[ymap],
TextureCoordinateFunction -> ({#4, #5} &)]]


Note the use of Lighting -> "Neutral" so that all lights used for the surface are white.

(I know I could have used SphericalPlot3D[], but I wanted an explicit reminder of the coordinate system convention being used, as I am more accustomed to using $\theta$ as longitude and $\varphi$ as co-latitude.)

Now, pictures!

GraphicsGrid[Table[ReYDensityPlot[ℓ, m], {ℓ, 0, 3}, {m, 0, ℓ}], ImageSize -> Full]


-
 For the interested, here is a version that uses a different coloring scheme... – J. M.♦ Aug 27 '12 at 13:11

=== Update - all color gradients ===

You should check out some of the related Demonstrations. This is my version - a close reproduction of Wikipedia figures found on this page. Note, $l \geq |m|$ conditions is imposed. The code is below the image.

Manipulate[If[m > l, m = l];
Column[{
(* formula *)
(* graphics *)
SphericalPlot3D[1, {θ, 0, π}, {ϕ, 0, 2 π},
t (.5 + f[SphericalHarmonicY[l, m, #4, #5]])] &),
Mesh -> False, Boxed -> False, Axes -> False,
ColorFunctionScaling -> False,
PlotPoints -> 100, SphericalRegion -> True, ViewAngle -> .3,
ImageSize -> 400]
}, Alignment -> Center],
(* controls *)
{{l, 5}, 0, 10, 1, Setter},
{{m, 2}, 0, 10, 1, Setter},
{{f, Re}, {Re, Im, Abs}},
{{t, 1.2, "focus"}, .5, 1.5, Appearance -> "Labeled",
ColorData[
"Rainbow"]}, (ColorData[#] ->
Show[ColorData[#, "Image"], ImageSize -> 100]) & /@
ControlPlacement -> Left]


=== Simpler older version using Hue ===

Manipulate[If[m > l, m = l];
SphericalPlot3D[1, {θ, 0, π}, {ϕ, 0, 2 π},
ColorFunction -> (Hue[f[SphericalHarmonicY[l, m, #4, #5]] - .7] &),
Mesh -> False, Boxed -> False, Axes -> False,
ColorFunctionScaling -> False, PlotPoints -> 100,
SphericalRegion -> True, ViewAngle -> .3], {{l, 5}, 0, 10, 1,
Setter}, {{m, 2}, 0, 10, 1, Setter}, {{f, Re}, {Re, Im, Abs}}]


-
Very cool! Add a choice of color schemes, and then we're cooking! :D – J. M. Aug 27 '12 at 10:03

Adding the option ColorFunctionScaling->False, and putting directional light sources:

SphericalPlot3D[1, {θ, 0, Pi}, {Φ, 0, 2 Pi},
ColorFunction -> (Function[{x, y, z, θ, Φ, r},
RGBColor[Abs[SphericalHarmonicY[1, 1, θ, Φ]]^2,
Abs[SphericalHarmonicY[1, 0, θ, Φ]]^2,
Abs[SphericalHarmonicY[1, -1, θ, Φ]]^2]]),
ColorFunctionScaling -> False,
Lighting -> ({"Directional", White, #} & /@ Tuples[{-1, 1, -1/2}, 3])]


gives

Update: As an alternative to playing with the Lighting option settings, one can enhance the color values by scaling the arguments of RGBColor[...] up by a factor:

Manipulate[ SphericalPlot3D[1, {θ, 0, Pi}, {Φ, 0, 2 Pi},
ColorFunction -> (Function[{x, y, z, θ, Φ, r},
RGBColor[ s Abs[SphericalHarmonicY[1, 1, θ, Φ]]^2,
s Abs[SphericalHarmonicY[1, 0, θ, Φ]]^2,
s Abs[SphericalHarmonicY[1, -1, θ, Φ]]^2]]),
ColorFunctionScaling -> False],
{{s, 10, "s"}, .5, 20, .5, Appearance -> "Labeled"}]


-