Visualizing the Riemann zeta function

One way is to show the convergence of the defining sum.

Background

The zeta function is defined as

$$\zeta (s)=\sum\limits_{k=1}^{\infty}\frac{1}{k^s}=\frac{1}{1^s}+\frac{1}{2^s}+\frac{1}{3^s}+\frac{1}{4^s}+\ldots$$

which is:

• divergent for $s=1$;
• gives nice values for other positive integers, e.g. Zeta[2]$=\frac{\pi^2}{6}$;
• is well defined on the complex plane if $\Re (s)>1$;
• when $\Re (s)\leq 1$, the sum is divergent, e.g. $\zeta (-1)=1+2+3+4+\ldots$. However, one can perform a unique analytic continuation that ascribes a value of $-\frac{1}{12}$ to $\zeta (-1)$ (not to be covered here).

For $s\in\mathbb{C}$, e.g. $s=2+i$, the sum will be

$$\frac{1}{1^2 1^i}+\frac{1}{2^2 2^i}+\frac{1}{3^2 3^i}+\frac{1}{4^2 4^i}+\ldots$$

Each of the terms consists of a purely real and a purely imaginary exponent (referred to as part in short). The real part describes the length of the number (i.e., $\frac{1}{1^2}=1$ says the number is 1 unit from $(0,0)$; $\frac{1}{2^2}=1/4$ says that the number is $1/4$ units from the previous number, etc.); the imaginary part describes an angle. Given this, each term describes a vector starting from the end of the previous one.

Code

Defining a partial sum of $n$ terms:

zeta[s_, n_] := Table[1/k^s, {k, 1, n}]

one can visualize the addition of partial vectors in the complex plane with

Manipulate[
 DynamicModule[{loc = {2., 1.}}, 
  LocatorPane[Dynamic[loc], 
   Dynamic@ListLinePlot[
     Accumulate@
      Partition[
       Join[{{0, 0}}, ReIm /@ zeta[loc[[1]] + loc[[2]] I, n]], 2, 1], 
     PlotRange -> {{-1, 3}, {-2, 2}}, Frame -> True, 
     AxesOrigin -> {1, 0}, AspectRatio -> 1, 
     PlotLabel -> If[loc[[1]] <= 1, "Divergent", "Convergent"], 
     Epilog -> {Red, PointSize[Large], 
       Point@ReIm@Zeta[loc[[1]] + loc[[2]] I]}]
   ]
  ]
 , {n, {100, 500, 1000}, ControlType -> PopupMenu}]

The Locator shows the input value $s$; the red point shows the exact value Zeta[s]; the spiral with colorful segments shows the partial vectors in the complex plane. n can be varied. One can see that when $\Re (s)$ is close to $1$, the convergence is very slow.

One of the visualisations in the linked video is similar to the following. Parameter t is the imaginary value (height) above the real axis.

Manipulate[
   Module[{p, c, z},
      p = Table[RiemannSiegelZ[t]*{Cos[t], Sin[t]}, {t, 0, tmax - dt, dt}];
      c = Table[ColorData["DarkRainbow", t/tmax], {t, 0, tmax - dt, dt}];
      z = Im[N[ZetaZero[Range[tmax]]]];
      Graphics[{
         Red, Line[{{-4, 0}, {4, 0}}], Line[{{0, -4}, {0, 4}}],
         Thick, Line[Take[p,Floor[t/dt]], VertexColors->Take[c,Floor[t/dt]]]},
         PlotLabel -> ToString[Select[z, # <= t &]], Background -> Black,
         PlotRange -> 4 {{-1, 1}, {-1, 1}}, BaseStyle -> {FontSize -> 12},
         ImageSize -> 600]
      ],
{{tmax, 60., "Maximum t"}, 3, 100, Appearance -> "Labeled"},
{{dt, 0.1, "Delta t"}, 0.03, 0.3, Appearance -> "Labeled"},
{{t, 0.0, "Parameter t"}, 0.0, tmax, 1, Appearance -> "Labeled"}]

Or try an animation:

Module[{tmax = 60, dt = 0.1, p, c, z},
   p = Table[RiemannSiegelZ[t]*{Cos[t], Sin[t]}, {t, 0, tmax - dt, dt}];
   c = Table[ColorData["DarkRainbow", t/tmax], {t, 0, tmax - dt, dt}];
   z = Im[N[ZetaZero[Range[tmax]]]];
   Animate[
      Graphics[{
      Red, Line[{{-4, 0}, {4, 0}}], Line[{{0, -4}, {0, 4}}],
      Thick, Line[Take[p, Floor[t/dt]], VertexColors->Take[c,Floor[t/dt]]]},
      PlotLabel -> ToString[Select[z, # <= t &]], Background -> Black,
      PlotRange -> 4 {{-1, 1}, {-1, 1}}, BaseStyle -> {FontSize -> 12},
      ImageSize -> 500],
  {t, 0.0, tmax}, AnimationDirection -> ForwardBackward]
]

The curving coloured line plots the complex value of w=Zeta[1/2+ I t] as real t increases from zero. The red axes are the real part of w (horizontal) and imaginary part of w (vertical). As each non-trivial zeta-function root is encountered on this critical line x=1/2, the curve passes through the origin and the plot label appends its t value to a list.

rz[u_, v_] := With[{i = Complex[u, v]}, ReIm[Zeta[i]]]
szf[{u_, v_}, n_Integer] := {{0, 0}}~Join~
  N@Table[ReIm[Sum[1/j^(u + I v), {j, 1, k}]], {k, 1, n}]
Manipulate[
 Row[{ParametricPlot[{u, v}, {u, -r, r}, {v, -r, r}, 
    MeshFunctions -> {#3 &, #4 &}, Mesh -> {10, 10}, 
    Exclusions -> None, ImageSize -> 400, 
    Epilog -> {Red, PointSize[0.02], Point[p]}],
   ParametricPlot[rz[u, v], {u, -r, r}, {v, -r, r}, 
    MeshFunctions -> {#3 &, #4 &}, Mesh -> {10, 10}, 
    Exclusions -> None, ImageSize -> 400, 
    Epilog -> {Red, PointSize[0.02], Point[rz @@ p], Green, 
      Line[szf[p, number]], Black, Point[szf[p, number]]
      }, PlotRange -> {{-r, r}, {-r, r}}]}], {{p, {1, 
    1}}, {-r, -r}, {r, r}, 
  Slider2D}, {{r, 2}, {2, 5, 10, 20}}, {number, Range[2, 100]}]

If you want to see behaviour along Re[z]=1/2:

tab1 = Table[{1/2, j}, {j, -30, 30, 0.1}];
tab2 = Table[ReIm[Zeta[1/2 + j I]], {j, -30, 30, 0.1}];
lp1 = ListPlot[tab1, Joined -> True, PlotStyle -> Dashed, 
     Epilog -> {Red, PointSize[0.02], Point[#]}, Frame -> True, 
     ImageSize -> 400] & /@ tab1;
lp2 = ListPlot[tab2, Joined -> True, PlotStyle -> Dashed, 
     Epilog -> {Red, PointSize[0.02], Point[#]}, Frame -> True, 
     ImageSize -> 400] & /@ tab2;
an = Row /@ Thread[{lp1, lp2}];

Animated gif is here