Guest User

Fourier transform of Riemann zeta zero spectrum Bernoulli

a guest
Sep 23rd, 2018
239
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Clear[t, m, s, M, r, b, M, v, d, x, k, q, z, nn];
  2. (*b=N[Sum[Sum[(BernoulliB[2*r]/((2*r)!))*(-d k^(1-2 r) E^(I x) \
  3. Abs[StirlingS1[2*r-1,m]] Gamma[1+m,s Log[d*k]] \
  4. Log[d*k]^(-1-m)),{m,1,2*r-1}],{r,1,q-1}],30];*)
  5. b = 4;
  6. M = 7;
  7. v = 2;
  8. (*d=11;*)
  9. k = 8;
  10. q = 4;
  11. c = 1;
  12. nn = 10;
  13. (*r=19;
  14. m=5;*)
  15.  
  16.  
  17. h[t_] = Sum[(I d^(1/2 - I t) E^(I t x) n^(-(1/2) - I t))/(
  18. 2 (-x + Log[d] + Log[n])) - (
  19. I d^(1/2 + I t) E^(I t x) n^(-(1/2) + I t))/(
  20. 2 (x + Log[d] + Log[n])), {n, 1, k}] + -(1/2) I E^(x/2)
  21. ExpIntegralEi[1/2 I (I + 2 t) (x - Log[d k])] +
  22. 1/2 I E^(-x/2) ExpIntegralEi[1/2 (1 + 2 I t) (x + Log[d k])] - (
  23. I d^(1/2 - I t) E^(I t x) k^(-(1/2) - I t))/(
  24. 4 (-x + Log[d] + Log[k])) + (
  25. I d^(1/2 + I t) E^(I t N[x]) k^(-(1/2) + I t))/(
  26. 4 (x + Log[d] + Log[k]));
  27.  
  28.  
  29. t1 = 1/200;
  30. t2 = 100;
  31. g1 = ListLinePlot[
  32. Table[-Im[
  33. N[Sum[Sum[-I*(h[t2] - h[t1])*MoebiusMu[d], {d, Divisors[z]}]/
  34. z^c, {z, 1, nn}] -
  35. I*(N[Sum[
  36.  
  37. Sum[(Sum[
  38. Sum[-(d/v) k^(1 - 2 r)
  39. E^(-(x/
  40. v) (1 -
  41. 2 (1/2 + I*t2))) ((BernoulliB[2*r]/((2*r)!))*
  42. Abs[StirlingS1[2*r - 1, m]]) Gamma[
  43. 1 + m, (1/2 + I*t2) Log[d*k]] Log[d*k]^(-1 -
  44. m) + (d*x)/v k^(
  45. 1 - 2 r) ((BernoulliB[2*r]/((2*r)!))*
  46. Abs[StirlingS1[2*r - 1, m]]) (1/
  47. x E^(-(x/v) + x (1/2 + I*t2))
  48. Gamma[1 + m, (1/2 + I*t2) Log[d*k]] +
  49. 1/x (Sum[
  50. Sum[(-1)^(m - kk)*
  51. m!/kk!/(N[x] - Log[d*k])^(m + 1)*
  52. E^(((1/2 + I*t2) - 1/v)*x)*(1/2 + I*t2)^(kk +
  53. p)*(d*k)^(-(1/2 + I*t2))*x^kk*Log[d*k]^p/p!, {kk,
  54. 0, m - p}], {p, 0, m}]) Log[d*k]^(1 + m)) Log[
  55. d*k]^(-1 - m), {m, 1, 2*r - 1}], {r, 1,
  56. q - 1}] -
  57. Sum[Sum[-(d/v) k^(1 - 2 r)
  58. E^(-(x/
  59. v) (1 -
  60. 2 (1/2 + I*t1))) ((BernoulliB[2*r]/((2*r)!))*
  61. Abs[StirlingS1[2*r - 1, m]]) Gamma[
  62. 1 + m, (1/2 + I*t1) Log[d*k]] Log[d*k]^(-1 -
  63. m) + (d*x)/v k^(
  64. 1 - 2 r) ((BernoulliB[2*r]/((2*r)!))*
  65. Abs[StirlingS1[2*r - 1, m]]) (1/
  66. x E^(-(x/v) + x (1/2 + I*t1))
  67. Gamma[1 + m, (1/2 + I*t1) Log[d*k]] +
  68.  
  69. 1/x (Sum[
  70. Sum[(-1)^(m - kk)*m!/kk!/(x - Log[d*k])^(m + 1)*
  71. E^(((1/2 + I*t1) - 1/v)*x)*(1/2 + I*t1)^(kk +
  72. p)*(d*k)^(-(1/2 + I*t1))*x^kk*Log[d*k]^p/p!, {kk,
  73. 0, m - p}], {p, 0, m}]) Log[d*k]^(1 + m)) Log[
  74. d*k]^(-1 - m), {m, 1, 2*r - 1}], {r, 1, q - 1}])*
  75. MoebiusMu[d], {d, Divisors[z]}]/z^c, {z, 1, nn}],
  76. b]) + -I*(N[
  77. Sum[Sum[(Sum[
  78. Sum[-(-(d/v) k^(1 - 2 r)
  79. E^(-(x/
  80. v) (1 -
  81. 2 (1/2 - I*t2))) ((BernoulliB[2*r]/((2*r)!))*
  82. Abs[StirlingS1[2*r - 1, m]]) Gamma[
  83. 1 + m, (1/2 - I*t2) Log[d*k]] Log[d*k]^(-1 -
  84. m) + (d*x)/v k^(
  85. 1 - 2 r) ((BernoulliB[2*r]/((2*r)!))*
  86. Abs[StirlingS1[2*r - 1, m]]) (1/
  87. x E^(-(x/v) + x (1/2 - I*t2))
  88. Gamma[1 + m, (1/2 - I*t2) Log[d*k]] +
  89. 1/x (Sum[
  90. Sum[-(+1)^(m - kk)*
  91. m!/kk!/(N[x] + Log[d*k])^(m + 1)*
  92. E^((-(1/2 - I*t2) + 1/v)*x)*(1/2 - I*t2)^(kk +
  93. p)*(d*k)^(-(1/2 - I*t2))*x^kk*Log[d*k]^p/p!, {kk,
  94. 0, m - p}], {p, 0, m}]) Log[d*k]^(1 + m)) Log[
  95. d*k]^(-1 - m)), {m, 1, 2*r - 1}], {r, 1,
  96. q - 1}] -
  97.  
  98. Sum[Sum[-(-(d/v) k^(1 - 2 r)
  99. E^(-(x/
  100. v) (1 -
  101. 2 (1/2 - I*t1))) ((BernoulliB[2*r]/((2*r)!))*
  102. Abs[StirlingS1[2*r - 1, m]]) Gamma[
  103. 1 + m, (1/2 - I*t1) Log[d*k]] Log[d*k]^(-1 -
  104. m) + (d*x)/v k^(
  105. 1 - 2 r) ((BernoulliB[2*r]/((2*r)!))*
  106. Abs[StirlingS1[2*r - 1, m]]) (1/
  107. x E^(-(x/v) + x (1/2 - I*t1))
  108. Gamma[1 + m, (1/2 - I*t1) Log[d*k]] +
  109. 1/x (Sum[
  110. Sum[-(+1)^(m - kk)*m!/kk!/(x + Log[d*k])^(m + 1)*
  111. E^((-(1/2 - I*t1) + 1/v)*x)*(1/2 - I*t1)^(kk +
  112. p)*(d*k)^(-(1/2 - I*t1))*x^kk*Log[d*k]^p/p!, {kk,
  113. 0, m - p}], {p, 0, m}]) Log[d*k]^(1 + m)) Log[
  114. d*k]^(-1 - m)), {m, 1, 2*r - 1}], {r, 1, q - 1}])*
  115. MoebiusMu[d], {d, Divisors[z]}]/z^c, {z, 1, nn}], b]),
  116. b]], {x, 1/200, 2, 1/200}], DataRange -> {1/200, 2},
  117. ImageSize -> Large, PlotStyle -> {Thickness[0.004]}];
  118. g2 = Table[Graphics[Line[{{Log[n], -45}, {Log[n], 0}}]], {n, 1, 7}];
  119. g3 = Table[Graphics[Text[Log[n], {Log[n], -50}]], {n, 1, 7}];
  120. Show[g1, g2, g3]
RAW Paste Data