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]

logarithmic square root waves

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

Mertens function in the middle

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