2
$\begingroup$

I have a function $f[\theta,\phi]$ defined on the surface of a sphere that I would like to plot in an equal-area projection ellipse. Surely there's a straightforward way to do this, but so far all I've able to produce are rectangular plots.

$\endgroup$
3
  • $\begingroup$ Your question is unclear to me. Please give a concrete example. $\endgroup$
    – user64494
    Jul 25, 2019 at 4:23
  • $\begingroup$ For example, displaying the (real part of) spherical harmonics in a Hammer projection. $\endgroup$
    – gilonik
    Jul 25, 2019 at 4:25
  • 1
    $\begingroup$ Is this what you need: mathematica.stackexchange.com/q/83050/5478? $\endgroup$
    – Kuba
    Jul 25, 2019 at 5:58

2 Answers 2

3
$\begingroup$

Here's a code snippet that I wrote a long time ago, specifically for the Hammer projection.

HammerPlot::usage=
  "HammerPlot[f] shows a Hammer projection (see http://en.wikipedia.org/wiki/Hammer_projection) of a function f[θ,φ].  "~~
  "The option ViewPoint->{Θ,Φ,χ} places the viewer over the point (Θ,Φ) and "~~
  "rotates the sphere by an angle χ around the line connecting the viewer and the center.  "~~
  "With ViewPoint->{0,0,0} the observer looks at the north pole, with the Gulf of Guinea to the right and the Bay of Bengal up.  "~~
  "With ViewPoint->{π/2,0,0} the observer looks at the Gulf of Guinea, with the Bay of Bengal up, the north pole left, and the south pole right.  "~~
  "With ViewPoint->{π/2,π/2,0} the observer looks at the Bay of Bengal, with the Gulf of Guinea down, the Pacific ocean up, the north pole left and the south pole right.  "~~
  "With the default setting ViewPoint->{π/2,0,-π/2} the observer looks at the Gulf of Guinea, with the equator going left-to-right, the north pole up, and the south pole down.";

Options[HammerPlot] = Join[Options[DensityPlot], {ViewPoint -> Automatic}];
SetOptions[HammerPlot, AspectRatio -> Automatic, PlotRange -> All, 
                       Frame -> False, ColorFunction -> "SunsetColors"];
HammerPlot[f_, opts : OptionsPattern[]] := Module[{vp, θ, φ, χ},
  (* read view point *)
  vp = OptionValue[ViewPoint];
  {θ, φ, χ} = If[VectorQ[vp, NumericQ] && Length[vp] == 3,
                 vp,
                 {π/2, 0, -π/2}];
  DensityPlot[
    f[ArcCos[1/(4 Sqrt[4 + (-8 + x^2) y^2 + 4 y^4]) ((x^4 + 8 (-1 + y^2)^2 + x^2 (-8 + 6 y^2)) Cos[θ] + Sin[θ] (x Sqrt[8 - x^2 - 4 y^2] (-4 + x^2 + 4 y^2) Cos[χ] - 2 y Sqrt[-(-8 + x^2 + 4 y^2) (4 + (-8 + x^2) y^2 + 4 y^4)] Sin[χ]))],
      ArcTan[(x^4 + 8 (-1 + y^2)^2 + x^2 (-8 + 6 y^2)) Cos[φ] Sin[θ] - Sin[φ] (2 y Sqrt[(8 - x^2 - 4 y^2) (4 + (-8 + x^2) y^2 + 4 y^4)] Cos[χ] + x Sqrt[8 - x^2 - 4 y^2] (-4 + x^2 + 4 y^2) Sin[χ]) + Cos[θ] Cos[φ] (-x Sqrt[8 - x^2 - 4 y^2] (-4 + x^2 + 4 y^2) Cos[χ] + 2 y Sqrt[(8 - x^2 - 4 y^2) (4 + (-8 + x^2) y^2 + 4 y^4)] Sin[χ]), Cos[φ] (2 y Sqrt[(8 - x^2 - 4 y^2) (4 + (-8 + x^2) y^2 + 4 y^4)] Cos[χ] + x Sqrt[8 - x^2 - 4 y^2] (-4 + x^2 + 4 y^2) Sin[χ]) + Sin[φ] (8 Sin[θ] + (x^2 + 2 y^2) (-8 + x^2 + 4 y^2) Sin[θ] + Cos[θ] (-x Sqrt[8 - x^2 - 4 y^2] (-4 + x^2 + 4 y^2) Cos[χ] + 2 y Sqrt[(8 - x^2 - 4 y^2) (4 + (-8 + x^2) y^2 + 4 y^4)] Sin[χ]))]],
     {x, -2, 2}, {y, -1, 1}, 
     RegionFunction -> ((#1/2)^2 + #2^2 < 1 &), 
     Evaluate[FilterRules[{opts, Options[HammerPlot]}, Options[DensityPlot]]]]]

Try it out: Plot the $x=\sin(\theta)\cos(\phi)$ coordinate with

HammerPlot[Sin[#1] Cos[#2] &]

enter image description here

Plot the $y=\sin(\theta)\sin(\phi)$ coordinate with

HammerPlot[Sin[#1] Sin[#2] &]

enter image description here

Plot the $z=\cos(\theta)$ coordinate with

HammerPlot[Cos[#1] &]

enter image description here

These plots can be modified with all the options available for DensityPlot, for example HammerPlot[Cos[#1] &, ColorFunction -> Hue, PlotLegends -> Automatic]. Particularly the ViewPoint option is useful to center the viewer at arbitrary points over the sphere.

$\endgroup$
1
  • $\begingroup$ That's great -- and it looks adaptable to other projections. Thx! $\endgroup$
    – gilonik
    Jul 25, 2019 at 16:02
1
$\begingroup$

How about the following?

Plot3D[Re[SphericalHarmonicY[3, 1,\[Theta],\[Phi]]] /.
 {\[Phi] -> ArcSin[x*y], \[Theta]->2*ArcTan[x*Sqrt[1 - (x/4)^2-(y/2)^2]/
2/(2*(1 - (x/4)^2 - (y/2)^2) - 1)]}, {x, -4, 4}, {y, -Sqrt[1 - (x/4)^2], Sqrt[1 - (x/4)^2]},
BoxRatios -> Automatic]

enter image description here The formulas from Wiki are used. Compare with

Plot3D[Re[SphericalHarmonicY[3, 1, \[Theta], \[Phi]]], {\[Theta], 0,  Pi}, {\[Phi], 0, 2*Pi}]

enter image description here

$\endgroup$

Not the answer you're looking for? Browse other questions tagged or ask your own question.