Take the 2-minute tour ×
Mathematics Stack Exchange is a question and answer site for people studying math at any level and professionals in related fields. It's 100% free, no registration required.

Mathematica knows that the logarithm of $n$ is:

$$\log(n) = \lim\limits_{s \rightarrow 1} \zeta(s)\left(1 - \frac{1}{n^{(s - 1)}}\right)$$

The von Mangoldt function should then be:

$$\Lambda(n)=\lim\limits_{s \rightarrow 1} \zeta(s)\sum\limits_{d|n} \frac{\mu(d)}{d^{(s-1)}}.$$

Setting the first term of the von Mangoldt function $\Lambda(1)$ equal to the harmonic number $H_{\operatorname{scale}}$ where scale is equal to the scale of the Fourier transform matrix, one can calculate the Fourier transform of the von Mangoldt function with the Mathematica program at the link below:

http://pastebin.com/ZNNYZ4F6

In the program I studied the function within the limit for the von Mangoldt function, and made some small changes to the function itself:

$f(t)=\sum\limits_{n=1}^{n=k} \frac{1}{\log(k)} \frac{1}{n} \zeta(1/2+i \cdot t)\sum\limits_{d|n} \frac{\mu(d)}{d^{(1/2+i \cdot t-1)}}$ as $k$ goes to infinity.

(Edit 20.9.2013: The function $f(t)$ had "-1" in the argument for the zeta function.)

The plot of this function looks like this:

function

While the plot of the Fourier transform of the von Mangoldt function with the program looks like this:

Fourier transform

There are some similarities but the Fourier transform converges faster towards smaller oscillations in between the spikes at zeta zeros and the scale factor is wrong.

Will the function $f(t)$ above eventually converge to the Fourier transform of the von Mangoldt function, or is it only yet another meaningless plot?

Now when I look at it I think the spikes at zeros comes from the zeta function itself and the spectrum like feature comes from the Möbius function which inverts the zeta function.

scale = 50; (*scale = 5000 gives the plot below*)
Print["Counting to 60"]
Monitor[g1 = 
  ListLinePlot[
   Table[Re[
     Zeta[1/2 + I*k]*
      Total[Table[
        Total[MoebiusMu[Divisors[n]]/Divisors[n]^(1/2 + I*k - 1)]/(n*
           k), {n, 1, scale}]]], {k, 0 + 1/1000, 60, N[1/6]}], 
   DataRange -> {0, 60}, PlotRange -> {-0.15, 1.5}], Floor[k]]

Dirichlet series:

zeta zero spectrum 1


Clear[f]
scale = 100000;
f = ConstantArray[0, scale];
f[[1]] = N@HarmonicNumber[scale];
Monitor[Do[
  f[[i]] = N@MangoldtLambda[i] + f[[i - 1]], {i, 2, scale}], i]
xres = .002;
xlist = Exp[Range[0, Log[scale], xres]];
tmax = 60;
tres = .015;
Monitor[errList = 
   Table[(xlist^(1/2 + I k - 1).(f[[Floor[xlist]]] - xlist)), {k, 
     Range[0, 60, tres]}];, k]
ListLinePlot[Im[errList]/Length[xlist], DataRange -> {0, 60}, 
 PlotRange -> {-.01, .15}]

Fourier transform:

zeta zero spectrum 2


Matrix inverse:

Clear[n, k, t, A, nn]
nn = 50;
A = Table[
   Table[If[Mod[n, k] == 0, 1/(n/k)^(1/2 + I*t - 1), 0], {k, 1, nn}], {n, 1,
     nn}];
MatrixForm[A];
ListLinePlot[
 Table[Total[
   1/Table[n*t, {n, 1, nn}]*
    Total[Transpose[Re[Inverse[A]*Zeta[1/2 + I*t]]]]], {t, 1/1000, 60,
    N[1/6]}], DataRange -> {0, 60}, PlotRange -> {-0.15, 1.5}]

Clear[n, k, t, A, nn]
nnn = 12;
Show[Flatten[{Table[
    ListLinePlot[
     Table[Re[
       Total[1/Table[n*t, {n, 1, nn}]*
         Total[Transpose[
           Inverse[
             Table[Table[
               If[Mod[n, k] == 0, N[1/(n/k)^(1/2 + I*t - 1)], 0], {k, 
                1, nn}], {n, 1, nn}]]*Zeta[1/2 + I*t]]]]], {t, 1/1000,
        60, N[1/10]}], DataRange -> {0, 60}, 
     PlotRange -> {-0.15, 1.5}], {nn, 1, nnn}], 
   Table[ListLinePlot[
     Table[Re[
       Total[1/Table[n*t, {n, 1, nn}]*
         Total[Transpose[
           Inverse[
             Table[Table[
               If[Mod[n, k] == 0, N[1/(n/k)^(1/2 + I*t - 1)], 0], {k, 
                1, nn}], {n, 1, nn}]]*Zeta[1/2 + I*t]]]]], {t, 1/1000,
        60, N[1/10]}], DataRange -> {0, 60}, 
     PlotRange -> {-0.15, 1.5}, PlotStyle -> Red], {nn, nnn, nnn}]}]]

12 first curves together or partial sums:

12 curves

Clear[n, k, t, A, nn, dd]
dd = 220;
Print["Counting to ", dd]
nn = 20;
A = Table[
   Table[If[Mod[n, k] == 0, 1/(n/k)^(1/2 + I*t - 1), 0], {k, 1, 
     nn}], {n, 1, nn}];
Monitor[g1 = 
   ListLinePlot[
    Table[Total[
      1/Table[n*t, {n, 1, nn}]*
       Total[Transpose[
         Re[Inverse[
           IdentityMatrix[nn] + (Inverse[A] - IdentityMatrix[nn])*
             Zeta[1/2 + I*t]]]]]], {t, 1/1000, dd, N[1/100]}], 
    DataRange -> {0, dd}, PlotRange -> {-7, 7}];, Floor[t]]
mm = N[2*Pi/Log[2], 20]
g2 = Graphics[
   Table[Style[Text[n, {mm*n, 1}], FontFamily -> "Times New Roman", 
     FontSize -> 14], {n, 1, 32}]];
Show[g1, g2, ImageSize -> Large]

Matrix Inverse of matrix inverse times zeta function (on critical line):

matrix inverse of matrix inverse as function of t

Clear[n, k, t, A, nn, h]
nn = 60;
h = 2; (*h=2 gives log 2 operator, h=3 gives log 3 operator and so on*)
A = Table[
   Table[If[Mod[n, k] == 0, 
     If[Mod[n/k, h] == 0, 1 - h, 1]/(n/k)^(1/2 + I*t - 1), 0], {k, 1, 
     nn}], {n, 1, nn}];
MatrixForm[A];
g1 = ListLinePlot[
   Table[Total[
     1/Table[n*t, {n, 1, nn}]*
      Total[Transpose[Re[Inverse[A]*Zeta[1/2 + I*t]]]]], {t, 1/1000, 
     nn, N[1/6]}], DataRange -> {0, nn}, PlotRange -> {-3, 7}];
mm = N[2*Pi/Log[h], 12]
g2 = Graphics[
   Table[Style[Text[n*2*Pi/Log[h], {mm*n, 1}], 
     FontFamily -> "Times New Roman", FontSize -> 14], {n, 1, 32}]];
Show[g1, g2, ImageSize -> Large]

Matrix inverse of Riemann zeta times log 2 operator:

2 Pi div log2 spectrum

Jeffrey Stopple's code:

Show[Graphics[
  RasterArray[
   Table[Hue[
     Mod[3 Pi/2 + Arg[Zeta[sigma + I t]], 2 Pi]/(2 Pi)], {t, -30, 
     30, .1}, {sigma, -30, 30, .1}]]], AspectRatio -> Automatic]

Normal or usual zeta:

Normal zeta

Show[Graphics[
  RasterArray[
   Table[Hue[
     Mod[3 Pi/2 + 
        Arg[Sum[Zeta[sigma + I t]*
           Total[1/Divisors[n]^(sigma + I t - 1)*
              MoebiusMu[Divisors[n]]]/n, {n, 1, 30}]], 
       2 Pi]/(2 Pi)], {t, -30, 30, .1}, {sigma, -30, 30, .1}]]], 
 AspectRatio -> Automatic]

Spectral zeta (30-th partial sum):

spectral zeta

Clear[n, k, t, A, nn, B]
nn = 60
A = Table[
  Table[If[Mod[n, k] == 0, 1/(n/k)^(1/2 + I*t - 1), 0], {k, 1, 
    nn}], {n, 1, nn}]; MatrixForm[A];
B = FourierDCT[
   Table[Total[
     1/Table[n, {n, 1, nn}]*
      Total[Transpose[Re[Inverse[A]*Zeta[1/2 + I*t]]]]], {t, 1/1000, 
     600, N[1/6]}]];
g1 = ListLinePlot[B[[1 ;; 700]]*Table[Sqrt[n], {n, 1, 700}], 
   DataRange -> {0, 60}, PlotRange -> {-60, 600}];
mm = 11.35/Log[2];
g2 = Graphics[
   Table[Style[Text[n, {mm*Log[n], 100 + 20*(-1)^n}], 
     FontFamily -> "Times New Roman", FontSize -> 14], {n, 1, 16}]];
Show[g1, g2, ImageSize -> Large]

Mobius function -> Dirichlet series -> Spectral Riemann zeta -> Fourier transform -> von Mangoldt function:

from Mobius via spectral Riemann zeta to von Mangoldt

Larger von Mangoldt function plot still wrong amplitude: http://i.stack.imgur.com/02A1p.jpg

Clear[n, k, t, A, nn, B, g1, g2]
nn = 32
A = Table[
   Table[If[Mod[n, k] == 0, 1/(n/k)^(1/2 + I*t - 1), 0], {k, 1, 
     nn}], {n, 1, nn}];
MatrixForm[A];
B = FourierDCT[
   Table[Total[
     1/Table[n, {n, 1, nn}]*
      Total[Transpose[Re[Inverse[A]*Zeta[1/2 + I*t]]]]], {t, 0, 2000, 
     N[1/6]}]];
g1 = ListLinePlot[B[[1 ;; 2000]], DataRange -> {0, 60}, 
   PlotRange -> {-5, 50}];
2*N[Length[B]/1500, 12]
mm = 13.25/Log[2];
g2 = Graphics[
   Table[Style[Text[n, {mm*Log[n], 7 + (-1)^n}], 
     FontFamily -> "Times New Roman", FontSize -> 14], {n, 1, 40}]];
Show[g1, g2, ImageSize -> Full]

Plot from program above: http://i.stack.imgur.com/r6mTJ.jpg

Partial sums of zeta function, use this one:

Clear[n, k, t, A, nn, B]
nn = 80
mm = 11.35/Log[2];
A = Table[
   Table[If[Mod[n, k] == 0, 1/(n/k)^(1/2 + I*t - 1), 0], {k, 1, 
     nn}], {n, 1, nn}];
MatrixForm[A];
B = Re[FourierDCT[
    Monitor[Table[
      Total[1/Table[
          n, {n, 1, nn}]*(Total[
           Transpose[Inverse[A]*Sum[1/j^(1/2 + I*t), {j, 1, nn}]]] - 
          1)], {t, 1/1000, 600, N[1/6]}], Floor[t]]]];
g1 = ListLinePlot[B[[1 ;; 700]], DataRange -> {0, 60/mm}, 
   PlotRange -> {-30, 30}];
g2 = Graphics[
   Table[Style[Text[n, {Log[n], 5 - (-1)^n}], 
     FontFamily -> "Times New Roman", FontSize -> 14], {n, 1, 32}]];
Show[g1, g2, ImageSize -> Full]
share|improve this question
1  
some code: pastebin.com/sT3zbSTP and a picture: i.stack.imgur.com/5LirM.jpg –  Mats Granvik Mar 23 at 16:05
1  
It seems this would work well on MO to me as well. We (lowly site mods) cannot migrate questions that are more than 30 days old, so I've asked a SE mod to migrate it for you. –  mixedmath Mar 31 at 18:37
    
Actually, this is simply too old to be migrated at all. I encourage you to simply ask it again on MO with a reference back here so that they know it was asked here first. –  mixedmath Mar 31 at 18:43
    
I have now posted at Math Overflow: mathoverflow.net/questions/162076/… –  Mats Granvik Apr 1 at 15:48
    
I cant say I know the field, but the Mathematica StackExchange site sometimes handles stuff like this. Btw- they like their questions brief and to the point ! –  PlaysDice Apr 6 at 21:43

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Browse other questions tagged or ask your own question.