## Twelve digits

N[Log[2/3*Exp[-5/2*Pi] + Exp[7*Pi – Log[7/2*Exp[-7/2*Pi] + 5/2*Exp[-5/2*Pi] + 3/2*Exp[-3/2*Pi] + Exp[5/2*Pi] + 2*Pi]]], 15]
N[Im[ZetaZero[1]], 15]

14.1347251417344…
14.1347251417347…

Posted in Uncategorized

## Periodic sequences from cosine sums.

Mathematica:

In[292]:= len = 24;
nn = 1;
Table[Sum[Cos[n*(k – 1)/nn*2*Pi], {k, 1, nn}], {n, 1, len}]
nn = 2;
Table[Sum[Cos[n*(k – 1)/nn*2*Pi], {k, 1, nn}], {n, 1, len}]
nn = 3;
Table[Sum[Cos[n*(k – 1)/nn*2*Pi], {k, 1, nn}], {n, 1, len}]
nn = 4;
Table[Sum[Cos[n*(k – 1)/nn*2*Pi], {k, 1, nn}], {n, 1, len}]

Out[294]= {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, \
1, 1, 1, 1, 1}

Out[296]= {0, 2, 0, 2, 0, 2, 0, 2, 0, 2, 0, 2, 0, 2, 0, 2, 0, 2, 0, \
2, 0, 2, 0, 2}

Out[298]= {0, 0, 3, 0, 0, 3, 0, 0, 3, 0, 0, 3, 0, 0, 3, 0, 0, 3, 0, \
0, 3, 0, 0, 3}

Out[300]= {0, 0, 0, 4, 0, 0, 0, 4, 0, 0, 0, 4, 0, 0, 0, 4, 0, 0, 0, \
4, 0, 0, 0, 4}

In[301]:= len = 24;
nn = 1;
Table[n/nn^2*Sum[Cos[n*(k – 1)/nn*2*Pi], {k, 1, nn}], {n, 1, len}]
nn = 2;
Table[n/nn^2*Sum[Cos[n*(k – 1)/nn*2*Pi], {k, 1, nn}], {n, 1, len}]
nn = 3;
Table[n/nn^2*Sum[Cos[n*(k – 1)/nn*2*Pi], {k, 1, nn}], {n, 1, len}]
nn = 4;
Table[n/nn^2*Sum[Cos[n*(k – 1)/nn*2*Pi], {k, 1, nn}], {n, 1, len}]

Out[303]= {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, \
18, 19, 20, 21, 22, 23, 24}

Out[305]= {0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 0, 7, 0, 8, 0, 9, 0, \
10, 0, 11, 0, 12}

Out[307]= {0, 0, 1, 0, 0, 2, 0, 0, 3, 0, 0, 4, 0, 0, 5, 0, 0, 6, 0, \
0, 7, 0, 0, 8}

Out[309]= {0, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 3, 0, 0, 0, 4, 0, 0, 0, \
5, 0, 0, 0, 6}

Posted in Uncategorized

## Dirichlet series converging to zero

Mathematica

``` Clear[j, a1, cc, OnePlusB, n, dd, a] OnePlusB = (1 + N[Sum[(-1)^j*(3*j)^(-1/2), {j, 1, Infinity}], 120]) a1 = N[Sum[ 1/Sqrt[i] - 1/Sqrt[1 + i] - 2/Sqrt[2 + i] - 1/Sqrt[3 + i] + 1/Sqrt[ 4 + i] + 2/Sqrt[5 + i], {i, 1, \[Infinity], 6}], 500] Monitor[cc = Table[a1*OnePlusB^n, {n, 0, 1000000}];, n] dd = 2 + Total[cc] a1 = N[Sum[ 1/Sqrt[i] - 1/Sqrt[1 + i] - dd/Sqrt[2 + i] - 1/Sqrt[3 + i] + 1/ Sqrt[4 + i] + dd/Sqrt[5 + i], {i, 1, \[Infinity], 6}], 500] ```

Dirichlet series converging to zero

Posted in Uncategorized

## Logarithmic square root waves

Mathematica

``` Clear[A, B, n, k, T, nn] nn = 100; Monitor[A = Table[Table[N[Re[k^ZetaZero[n]], 12], {k, 1, nn}], {n, 1, nn}];, n] ArrayPlot[A, ImageSize -> Full] ```

Posted in Uncategorized

## von Mangoldt function and Riemann zeta zeros

Mathematica

``` Clear[A, B, n, k, T, nn] nn = 24;```

``` A = Table[Table[N[Re[k^ZetaZero[n]], 12], {k, 1, nn}], {n, 1, nn}]; MatrixForm[A] T[n_, k_] := T[n, k] = If[n < 1 || k n, T[k, n], If[n > k, T[k, Mod[n, k, 1]], -Sum[T[n, i], {i, n - 1}]]]]]; B = Table[Table[T[n, k]/n, {k, 1, nn}], {n, 1, nn}]; ```

```MatrixForm[B] Total[A] Total[N[B, 10]] ```

Posted in Uncategorized

## Mertens function

Mathematica

``` nn = 1000 Monitor[aa = Table[Sum[MoebiusMu[k]*Floor[n/k]^(0), {k, 1, n}], {n, 1, nn}];, n] Monitor[bb = Table[Sum[MoebiusMu[k]*Floor[n/k]^(1/2), {k, 1, n}], {n, 1, nn}];, n + 1000] Monitor[cc = Table[(6/Pi^2)*n^(1/2), {n, 1, nn}];, n + 2000] ListLinePlot[{aa, bb, -cc, bb + 2*cc - 2*cc[[1]], cc}, ImageSize -> Full]```

``` Print["These are equal:"] Clear[t]; nn = 12; rowsumexponent = 1/2; t[n_, k_] := t[n, k] = If[n = k, t[Floor[n/k], 1]]]]]; MatrixForm[Table[Table[t[n, k], {k, 1, 12}], {n, 1, 12}]]; gg = Table[t[n, 1], {n, 1, 12}]; dd = Table[ Sum[MoebiusMu[k]*Floor[n/k]^(rowsumexponent), {k, 1, n}], {n, 1, nn}]; MatrixForm[Transpose[{gg, dd, dd - gg}]] ```

```Print["But unfortunately these are not equal:"] Clear[t]; nn = 12; rowsumexponent = 1/2; t[n_, k_] := t[n, k] = If[n = k, t[Floor[n/k], 1]]]]]; MatrixForm[Table[Table[t[n, k], {k, 1, 12}], {n, 1, 12}]]; gg = Table[t[n, 1], {n, 1, 12}]; dd = (6/Pi^2)* Table[Sum[MoebiusMu[k]*Floor[n/k]^(rowsumexponent), {k, 1, n}], {n, 1, nn}]; MatrixForm[Transpose[{gg, dd, dd - gg}]] ```

Posted in Uncategorized

## Zeta zero spectrum with spikes of similar heights

Mathematica

``` Clear[f] scale = 1000000; f = Range[scale];```

``` f[[1]] = N@MangoldtLambda[1]; Monitor[Do[ f[[i]] = N@MangoldtLambda[i] + f[[i - 1]], {i, 2, scale}], i] xres = .004; xlist = Exp[Range[0, Log[scale - 1], xres]]; tmax = 60; tres = .015; s = 1/2; Monitor[errList1 = Table[(Total[(xlist^(-1/2 + I t)*(f[[Floor[xlist]]] - xlist))])*(-1/2 + I t), {t, 0, tmax, tres}];, t] ```

```Print["Variant of the Fourier transform of the von Mangoldt function"] g1 = ListLinePlot[Re[errList1]/Length[xlist], DataRange -> {0, tmax}, PlotRange -> {-.3, 1.3}, Axes -> True, Filling -> Axis]; g2 = Graphics[Line[{{0, 1}, {tmax, 1}}]]; Show[g1, g2, ImageSize -> Large] ```

Posted in Uncategorized