# How to improve this atomic orbitals manipulate box output?

I made this Manipulate box to show the atomic orbitals in the $$(x, z)$$ plane:

Clear["Global*"]

NormFactor[n_, l_] := Sqrt[Factorial[n - l - 1]/(2 n Factorial[n + l])]

Psi[n_, l_, m_, u_, \[Theta]_, \[Phi]_] := NormFactor[n, l] Exp[-u/2] u^l LaguerreL[n - l - 1, 2 l + 1, u] SphericalHarmonicY[l, m, \[Theta], \[Phi]]

u[x_, z_] := Sqrt[x^2 + z^2]
theta[x_, z_] := ArcTan[z, x]

Manipulate[
DensityPlot[
Abs[Psi[nn, nl, nm, u[x, z], theta[x, z], 0]]^2,
{x, -20, 20}, {z, -20, 20},
Frame -> None,
Axes -> True,
Ticks -> None,
PlotPoints -> 120,
ColorFunction -> "GrayTones",
ImageSize -> {800, 800}
],
{{nn, 1, Style["n :", 12]}, 1, 5, 1, Appearance -> "Labeled"},
{{nl, 0, Style["\[ScriptL] :", 12]}, 0, nn - 1, 1, Appearance -> "Labeled"},
{{nm, 0, Style["m :", 12]}, -nl, nl, 1, Appearance -> "Labeled"}
]


Preview of what this code is doing:

The code works, but it is a bit slow on my fast M2 Mac (I'm using Mathematica 13.2), and the output is a bit crude to me. How can I improve the output color shades and style? I would also like to add some level curves to have a better feel of the probabilities gradations. Currently, I don't know any proper options for the DensityPlot to add level curves or to get a nice mesh. Any suggestions?

EDIT: Using ContourPlot instead of DensityPlot may be a good alternative. However, using a color gradation like ColorFunction -> ColorData[{"GrayTones", "Reverse"}] gives a strong white region, instead of a black region. What's wrong here? I'm having issues with the colors gradient on the density plot, that I would like to invert (from black to white, instead of white to black).

Also, is there an option to get a random dots distribution instead of a smooth shade of grays, to simulate the electron count probability?

• Change your functions Psi, etc to pure functions. This will speedup code a bit. Problem with colors can be solved with correct definition of PlotRange Commented Mar 11 at 3:04
• @Rom38, can you be more specific about the color range?
– Cham
Commented Mar 11 at 3:19
• To keep the control variables in the allowed ranges, modify the Manipulate to Manipulate[nl = Min[nl, nn - 1]; nm = Clip[nm, {-nl, nl}]; DensityPlot[ ... Commented Mar 11 at 4:28
• @Cham, The correct settings of PlotRange around the min/max values of your z-values allows you avoiding this overlighting of white areas. Commented Mar 12 at 17:58
• @Rom38, I don't understand your comment. The $z$ values are the same as for $x$. The wave function spreads over all of the 2D euclidian space. I could plot the squared wave-function over any part of 2D space. In other words, there is no min or max value of $z$. However, there are min/max values for the squared wave function itself: $|\psi|_{min}^2 = 0$ and $|\psi|_{max}^2 < 1$.
– Cham
Commented Mar 12 at 20:55

To accelerate code we can first generate all images as follows

Clear["Global*"]

NormFactor[n_, l_] :=
Sqrt[Factorial[n - l - 1]/(2  n  Factorial[n + l])]

Psi[n_, l_, m_, u_, \[Theta]_, \[Phi]_] :=
NormFactor[n, l]  Exp[-u/2]  u^l  LaguerreL[n - l - 1, 2  l + 1,
u]  SphericalHarmonicY[l, m, \[Theta], \[Phi]]

u[x_, z_] := Sqrt[x^2 + z^2]
theta[x_, z_] := ArcTan[z, x]

Do[Do[Do[
orbit[nn, nl, nm] =
DensityPlot[
Evaluate[
Abs[Psi[nn, nl, nm, u[x, z], theta[x, z], 0]]^2], {x, -5,
5}, {z, -5, 5}, Frame -> None, Axes -> True, Ticks -> None,
PlotPoints -> 50, ColorFunction -> "AvocadoColors",
ImageSize -> {400, 400}, PlotRange -> All,
Exclusions -> None];, {nm, -nl, nl, 1}];, {nl, 0, nn - 1,
1}];, {nn, 1, 5, 1}];


Then we can manipulate orbit

Manipulate[
orbit[nn, nl, nm], {{nn, 1, Style["n :", 12]}, 1, 5, 1,
Appearance -> "Labeled"}, {{nl, 0, Style["\[ScriptL] :", 12]}, 0,
nn - 1, 1,
Appearance -> "Labeled"}, {{nm, 0, Style["m :", 12]}, -nl, nl, 1,
Appearance -> "Labeled"}]


For a black on white appearance we can use scheme

Do[Do[Do[
orbit1[nn, nl, nm] =
DensityPlot[
Evaluate[
1 - Abs[Psi[nn, nl, nm, u[x, z], theta[x, z],
0]]^2], {x, -5, 5}, {z, -5, 5}, Frame -> None,
Axes -> True, Ticks -> None, PlotPoints -> 50,
ColorFunction -> "GrayTones", ImageSize -> {400, 400},
PlotRange -> All, Exclusions -> None];, {nm, -nl, nl,
1}];, {nl, 0, nn - 1, 1}];, {nn, 1, 5, 1}];

Manipulate[
orbit1[nn, nl, nm], {{nn, 1, Style["n :", 12]}, 1, 5, 1,
Appearance -> "Labeled"}, {{nl, 0, Style["\[ScriptL] :", 12]}, 0,
nn - 1, 1,
Appearance -> "Labeled"}, {{nm, 0, Style["m :", 12]}, -nl, nl, 1,
Appearance -> "Labeled"}]


• It's working very well. But how do you make the output as black shades on a white background, with high contrasts to better see the orbitals?
– Cham
Commented Mar 11 at 13:46
• The images are quite different from OP, which are correct? Compare with OP's image for n=3;l=1;m=1;. Commented Mar 11 at 13:55
• @azerbajdzan Please, pay attention that we used scale {x, -5, 5}, {z, -5, 5} while OP used {x, -20, 20}, {z, -20, 20}. If we apply this scale to my code we will see green aura around central image. Also in OP's code there is no option PlotRange -> All that leads to the wrong appearance in combination with ColorFunction -> "GrayTones" since white area in his image is clipping region. Commented Mar 11 at 14:27
• Using ColorNegate inside the Manipulate box almost give the black on white background output I prefer, but it also add a black frame all around. What would be a proper way of achieving a black pattern on a white background?
– Cham
Commented Mar 11 at 14:28
• @Cham Ok! See update to my answer. Commented Mar 11 at 14:41