5
$\begingroup$

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: enter image description here

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?

$\endgroup$
7
  • $\begingroup$ 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 $\endgroup$
    – Rom38
    Commented Mar 11 at 3:04
  • $\begingroup$ @Rom38, can you be more specific about the color range? $\endgroup$
    – Cham
    Commented Mar 11 at 3:19
  • $\begingroup$ 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[ ... $\endgroup$
    – Bob Hanlon
    Commented Mar 11 at 4:28
  • $\begingroup$ @Cham, The correct settings of PlotRange around the min/max values of your z-values allows you avoiding this overlighting of white areas. $\endgroup$
    – Rom38
    Commented Mar 12 at 17:58
  • $\begingroup$ @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$. $\endgroup$
    – Cham
    Commented Mar 12 at 20:55

1 Answer 1

9
$\begingroup$

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

Figure 1

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

Figure 2

$\endgroup$
10
  • $\begingroup$ 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? $\endgroup$
    – Cham
    Commented Mar 11 at 13:46
  • $\begingroup$ The images are quite different from OP, which are correct? Compare with OP's image for n=3;l=1;m=1;. $\endgroup$ Commented Mar 11 at 13:55
  • 1
    $\begingroup$ @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. $\endgroup$ Commented Mar 11 at 14:27
  • $\begingroup$ 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? $\endgroup$
    – Cham
    Commented Mar 11 at 14:28
  • 1
    $\begingroup$ @Cham Ok! See update to my answer. $\endgroup$ Commented Mar 11 at 14:41

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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