Mathematica code for this animation of transitions in hydrogen wavefunctions: https://twitter.com/bencbartlett/status/1287802625602117632

hydrogen_orbitals.nb

<< MaTeX`
SetOptions[MaTeX, "Preamble" -> {"\\usepackage{color,txfonts}"}];
SetDirectory[NotebookDirectory[]];

Clear[drawLadder];
drawLadder[n_, l_, m_, imsize_: 500] := Module[{maxrungs = 5, mag = 4},
   Graphics[{
     White, Opacity[1], Thickness[.02], Dashing[None],
     Table[Line[{{0, k}, {1, k}}], {k, maxrungs}], (*draw n lines*)
  
        Gray, Dashed, Thickness[.005], Line[{{0, 0}, {1, 0}}],
     Red, Opacity[.75],
     Disk[{0.5, n}, .3],
     
     White, Opacity[1], Thickness[.02], Dashing[None],
     Table[
      Line[{{2, k}, {3, k}}], {k, 0, 
       Floor[n + 0.01] - 1}], (*draw l lines*)
     Gray, Dashed, 
     Thickness[.005],
     Table[Line[{{2, k}, {3, k}}], {k, Floor[n + 0.01], maxrungs}],
     Blue, Opacity[.75],
     Disk[{2.5, l}, .3],
     
     White, Opacity[1], Thickness[.02], Dashing[None],
     Table[
      Line[{{4, k}, {5, k}}], {k, 0, 
       Ceiling[l - 0.01]}], (*draw m lines*)
     Gray, Dashed, 
     Thickness[.005],
     Table[
      Line[{{4, k}, {5, k}}], {k, Ceiling[l - 0.01] + 1, maxrungs}],
     Green, Opacity[.75],
     Disk[{4.5, m}, .3],
     
     White, Opacity[1], Thick, Dashing[None],
     Text[
      MaTeX["\\color{white} n", Magnification -> mag], {.5, 
       maxrungs + 1}],
     Text[
      MaTeX["\\color{white} l", Magnification -> mag], {2.5, 
       maxrungs + 1}],
     Text[
      MaTeX["\\color{white} m", Magnification -> mag], {4.5, 
       maxrungs + 1}],
     Table[
      Text[MaTeX["\\color{white} " <> ToString[k], 
        Magnification -> .5*mag], {5.8, k}], {k, 0, maxrungs}]
     },
    (*Background\[Rule]Black,*)
    Background -> Transparent,
    ImageSize -> imsize
    ]
   ];
(*drawLadder[3,2,0]*)

Clear[drawFrame];
drawFrame[{n1_, l1_, m1_}, {n2_, l2_, m2_}, c1_, c2_] := 
 Module[{c1norm, c2norm},
  c1norm = c1/Sqrt[Abs[c1]^2 + Abs[c2]^2];
  c2norm = c2/Sqrt[Abs[c1]^2 + Abs[c2]^2];
  
  ListDensityPlot[
   Table[
    Module[{r = Norm[{x, 0, z}], eq1, eq2},
     eq1 = 
      Sqrt[4 \[Pi]]
        r (Exp[-(r/n1)] r^
         l1 LaguerreL[n1 - 1 - l1, 2 l1 + 1, (2 r)/
          n1]) SphericalHarmonicY[l1, m1, ArcCos[z/r], ArcTan[x, 0]];
     eq2 = 
      Sqrt[4 \[Pi]]
        r (Exp[-(r/n2)] r^
         l2 LaguerreL[n2 - 1 - l2, 2 l2 + 1, (2 r)/
          n2]) SphericalHarmonicY[l2, m2, ArcCos[z/r], ArcTan[x, 0]];
     Abs[c1norm*eq1 + c2norm*eq2]^2
     ], {z, -40.1, 40, .5}, {x, -40.1, 80, .5}],
   DataRange -> {{-40, 40}, {-40, 80}},
   AspectRatio -> .8/1.2, ImageSize -> 1000*{1.2, .8},
   Mesh -> False, Frame -> False,
   (*InterpolationOrder\[Rule]1, 
   THIS CAUSES CRASHES*)
   (*PlotPoints\[Rule]100,
   MaxRecursion\[Rule]6,*)
   ColorFunctionScaling -> True, 
   ColorFunction -> "SunsetColors",
   Epilog -> Inset[
     drawLadder[
      (*n1*c1norm+n2*c2norm,m1*c1norm+m2*c2norm,l1*c1norm+l2*c2norm*)

            n1*c1norm^2 + n2*c2norm^2, l1*c1norm^2 + l2*c2norm^2, 
      m1*c1norm^2 + m2*c2norm^2, 250],
     (*{60,0},*)
     {29, 20}
     ]
   ]
  
  ]
drawFrame[{4, 3, 3}, {5, 3, 3}, .5, .5]
(*drawFrame[{2,0,0},{2,1,0},1,.8]*)

Clear[renderFrame];
renderFrame[t_] := Module[{tt = t - Floor[t], c1, c2, ttt},
   ttt = Piecewise[{{0, 
       tt < .1}, {(tt - .1)/(1 - .1 - .1), .1 <= tt < .9}, {1, 
       tt >= .9}}];
   c1 = Cos[\[Pi]/2 * ttt];
   c2 = Sin[\[Pi]/2 * ttt];
   Switch[Floor[t],
    0, drawFrame[{5, 0, 0}, {4, 0, 0}, c1, c2],
    1, drawFrame[{4, 0, 0}, {3, 0, 0}, c1, c2],
    2, drawFrame[{3, 0, 0}, {3, 1, 0}, c1, c2],
    3, drawFrame[{3, 1, 0}, {3, 1, 1}, c1, c2],
    4, drawFrame[{3, 1, 1}, {4, 0, 0}, c1, c2],
    5, drawFrame[{4, 0, 0}, {4, 1, 1}, c1, c2],
    6, drawFrame[{4, 1, 1}, {4, 2, 1}, c1, c2],
    7, drawFrame[{4, 2, 1}, {4, 3, 1}, c1, c2],
    8, drawFrame[{4, 3, 1}, {5, 0, 0}, c1, c2],
    9, drawFrame[{5, 0, 0}, {5, 1, 1}, c1, c2],
    10, drawFrame[{5, 1, 1}, {5, 2, 1}, c1, c2],
    11, drawFrame[{5, 2, 1}, {5, 3, 1}, c1, c2],
    12, drawFrame[{5, 3, 1}, {5, 4, 1}, c1, c2],
    13, drawFrame[{5, 4, 1}, {5, 3, 1}, c1, c2],
    14, drawFrame[{5, 3, 1}, {5, 2, 1}, c1, c2],
    15, drawFrame[{5, 2, 1}, {5, 1, 1}, c1, c2],
    16, drawFrame[{5, 1, 1}, {4, 1, 1}, c1, c2],
    17, drawFrame[{4, 1, 1}, {3, 1, 1}, c1, c2],
    18, drawFrame[{3, 1, 1}, {2, 1, 1}, c1, c2],
    19, drawFrame[{2, 1, 1}, {1, 0, 0}, c1, c2],
    _,  drawFrame[{2, 1, 0}, {1, 0, 0}, 0, 1]
    ]
   ];
renderFrame[0.9]


Plot[
 Module[{},
  ttt = Piecewise[{{0, 
      x < .1}, {(x - .1)/(1 - .1 - .1), .1 <= x < .9}, {1, x > .9}}];
  c1 = Cos[\[Pi]/2 * ttt];
  c2 = Sin[\[Pi]/2 * ttt];
  2*c1^2 + 3*c2^2
  ], {x, -1, 2}]
  
saveframe[tt_] := Module[{frame, title},
   frame = renderFrame[tt];
   title = IntegerString[Floor[tt*1000], 10, 8] <> ".png";
   Export["frames/" <> title, frame];
   ];

Monitor[Table[saveframe[t], {t, 0, 20, 1/120}], 
  ProgressIndicator[t, {0, 20}]];