Density plot on the surface of sphere

Question

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.

Answer 1

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

Answer 2

=== 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 *)
   TraditionalForm@SphericalHarmonicY[l, m, θ, ϕ],
   (* graphics *)
   SphericalPlot3D[1, {θ, 0, π}, {ϕ, 0, 2 π},
    ColorFunction -> (gradients[
        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", 
  ImageSize -> Small}, {{gradients, 
   ColorData[
    "Rainbow"]}, (ColorData[#] -> 
      Show[ColorData[#, "Image"], ImageSize -> 100]) & /@ 
   ColorData["Gradients"]},
 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}}]

Answer 3

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

Answer 4

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

Answer 5

Is there a function like SphericalDensityPlot so that I can illustrate the functions?

There is SliceDensityPlot3D

SliceDensityPlot3D[
 Re@SphericalHarmonicY[15, 12, ArcTan[z, Sqrt[x^2 + y^2]], 
   ArcTan[x, y]],
 "CenterSphere",
 {x, -2, 2}, {y, -2, 2}, {z, -2, 2},
 ColorFunction -> Hue,
 Boxed -> False,
 Axes -> False, 
 PlotPoints -> 100]