MatsGranvik

Linear programming and the Riemann hypothesis

Nov 12th, 2019
263
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (*start*)
  2. (*Mathematica 8.0.1*)
  3. Clear[nn, constant, s, a, d, M, T, n, k, m, sequenceToBeBounded,
  4. linearProgrammingSolution];
  5. nn = 50;
  6. constant = 1;
  7. s = 1;
  8. a[n_] := If[n < 1, 0, Sum[d MoebiusMu@d, {d, Divisors[n]}]]
  9.  
  10. Monitor[TableForm[
  11. M = Table[
  12. Table[Sum[If[m >= k, a[GCD[m, k]], 0], {m, 1, n}], {k, 1,
  13. nn}], {n, 1, nn}]];, n]
  14. Monitor[sequenceToBeBounded =
  15. Table[Sum[M[[n, k]]/k^s, {k, 2, n}], {n, 1,
  16. nn}](*<--sequence to be bounded*), n]
  17. Table[Sum[
  18. Sum[If[Mod[m, k] == 0, MoebiusMu[m/k]*HarmonicNumber[k], 0], {k, 1,
  19. m}] - 1, {m, 1, n}], {n, 1, nn}]
  20. %% - %
  21.  
  22. "1"
  23. Monitor[TableForm[
  24. PartialSumsOfMöbiusInverseOfHarmonicNumberLinearProgrammingSolution \
  25. = Table[LinearProgramming[
  26. Table[1/k^s, {k, 1, n}], {Table[
  27. If[k == 1, n, 1], {k, 1, n}]}, {{1, 0}},
  28. Table[If[k == 1, {-1, 1}, {M[[n, k]], M[[n, k]]}], {k, 1,
  29. n}]], {n, 1, nn}]], n]
  30. Monitor[lowerBound1 =
  31. Table[Sum[
  32. PartialSumsOfMöbiusInverseOfHarmonicNumberLinearProgrammingSoluti\
  33. on[[n, k]]/k^s, {k, 2, n}], {n, 1, nn}];, n]
  34.  
  35. Show[ListPlot[constant*lowerBound1, PlotStyle -> {Thick},
  36. PlotMarkers -> Automatic],
  37. ListLinePlot[constant*lowerBound1, PlotStyle -> {Thick}],
  38. ListLinePlot[sequenceToBeBounded, PlotStyle -> {Red, Thick}],
  39. ImageSize -> Large]
  40.  
  41. "2"
  42. constant = 2;
  43. Monitor[TableForm[
  44. AbsoluteValueNumberTheoreticLinearProgrammingSolution =
  45. Table[LinearProgramming[
  46. Table[1/k^s, {k, 1, n}], {Table[
  47. If[k == 1, n, 1], {k, 1, n}]}, {{1, 0}},
  48. Table[If[k == 1, {-1, 1}, {-Abs[M[[n, k]]], 0 (k - 1)}], {k, 1,
  49. n}]], {n, 1, nn}]], n]
  50. Monitor[lowerBound2 =
  51. Table[Sum[
  52. AbsoluteValueNumberTheoreticLinearProgrammingSolution[[n, k]]/
  53. k^s, {k, 2, n}], {n, 1, nn}];, n]
  54.  
  55. "3"
  56. constant = 2;
  57. Monitor[TableForm[
  58. OrdinaryLinearProgrammingSolution =
  59. Table[LinearProgramming[
  60. Table[1/k^s, {k, 1, n}], {Table[
  61. If[k == 1, n, 1], {k, 1, n}]}, {{1, 0}},
  62. Table[If[
  63. k == 1, {-1, 1}, {-(k - 1) + 0*Abs[M[[n, k]]],
  64. 0 (k - 1)}], {k, 1, n}]], {n, 1, nn}]];, n]
  65. Monitor[lowerBound3 =
  66. Table[Sum[
  67. OrdinaryLinearProgrammingSolution[[n, k]]/k^s, {k, 2, n}], {n, 1,
  68. nn}];, n]
  69.  
  70. Show[ListLinePlot[constant*lowerBound3, PlotStyle -> {Thick}],
  71. ListPlot[constant*lowerBound3, PlotStyle -> {Thick},
  72. PlotMarkers -> Automatic],
  73. ListPlot[lowerBound1, PlotStyle -> {Thick, Red},
  74. PlotMarkers -> Automatic],
  75. ListLinePlot[lowerBound1, PlotStyle -> {Thick, Red}],
  76. ListPlot[constant*lowerBound2, PlotStyle -> {Thick},
  77. PlotMarkers -> Automatic],
  78. ListLinePlot[constant*lowerBound2, PlotStyle -> {Thick},
  79. PlotMarkers -> Automatic], ImageSize -> Large]
  80. (*end*)
  81.  
  82.  
  83. (*****************************************************)
  84. (*****************************************************)
  85. (*****************************************************)
  86.  
  87. (*start*)(*Mathematica 8.0.1*)
  88. Clear[nn, constant, s, a, d, M, T, n, k, m, sequenceToBeBounded,
  89. linearProgrammingSolution];
  90. nn = 50;
  91. constant = 1;
  92. s = 1;
  93. a[n_] := If[n < 1, 0, Sum[d MoebiusMu@d, {d, Divisors[n]}]]
  94.  
  95. Monitor[TableForm[
  96. M = Table[
  97. Table[Sum[If[m >= k, a[GCD[m, k]], 0], {m, 1, n}], {k, 1,
  98. nn}], {n, 1, nn}]];, n]
  99. Monitor[sequenceToBeBounded =
  100. Table[Sum[M[[n, k]]/k^s, {k, 2, n}], {n, 1,
  101. nn}];(*<--sequence to be bounded*), n]
  102. Monitor[sequenceToBeBounded2 =
  103. Table[Sum[(M[[n, k]] - 1)/k^s, {k, 2, n}], {n, 1,
  104. nn}];(*<--sequence to be bounded*), n]
  105. Table[Sum[
  106. Sum[If[Mod[m, k] == 0, MoebiusMu[m/k]*HarmonicNumber[k], 0], {k, 1,
  107. m}] - 1, {m, 1, n}], {n, 1, nn}];
  108. (*%%-%;*)
  109.  
  110. "1"
  111. Monitor[TableForm[
  112. PartialSumsOfMöbiusInverseOfHarmonicNumberLinearProgrammingSolution\
  113. = Table[LinearProgramming[
  114. Table[1/k^s, {k, 1, n}], {Table[
  115. If[k == 1, n, 1], {k, 1, n}]}, {{1, 0}},
  116. Table[If[k == 1, {-1, 1}, {M[[n, k]] - 1, M[[n, k]]}], {k, 1,
  117. n}]], {n, 1, nn}]];, n]
  118. Monitor[lowerBound1 =
  119. Table[Sum[
  120. PartialSumsOfMöbiusInverseOfHarmonicNumberLinearProgrammingSoluti\
  121. on[[n, k]]/k^s, {k, 2, n}], {n, 1, nn}];, n]
  122.  
  123. Show[ListPlot[constant*lowerBound1, PlotStyle -> {Thick},
  124. PlotMarkers -> Automatic],
  125. ListLinePlot[constant*lowerBound1, PlotStyle -> {Thick}],
  126. ListLinePlot[sequenceToBeBounded, PlotStyle -> {Red, Thick}],
  127. ImageSize -> Large]
  128.  
  129. "2"
  130. constant = 1;
  131. Monitor[TableForm[
  132. AbsoluteValueNumberTheoreticLinearProgrammingSolution =
  133. Table[LinearProgramming[
  134. Table[1/k^s, {k, 1, n}], {Table[
  135. If[k == 1, n, 1], {k, 1, n}]}, {{1, 0}},
  136. Table[If[k == 1, {-1, 1}, {-Abs[M[[n, k]]] - 1, 0 (k - 1)}], {k,
  137. 1, n}]], {n, 1, nn}]];, n]
  138. Monitor[lowerBound2 =
  139. Table[Sum[
  140. AbsoluteValueNumberTheoreticLinearProgrammingSolution[[n, k]]/
  141. k^s, {k, 2, n}], {n, 1, nn}];, n]
  142. "here here here"
  143. Show[ListLinePlot[lowerBound2, PlotStyle -> Blue],
  144. ListLinePlot[sequenceToBeBounded2, PlotStyle -> Red]]
  145.  
  146. "3"
  147. constant = 1;
  148. Monitor[TableForm[
  149. OrdinaryLinearProgrammingSolution =
  150. Table[LinearProgramming[
  151. Table[1/k^s, {k, 1, n}], {Table[
  152. If[k == 1, n, 1], {k, 1, n}]}, {{1, 0}},
  153. Table[If[
  154. k == 1, {-1, 1}, {-k - 1 + 0*Abs[M[[n, k]]], 0 (k - 1)}], {k,
  155. 1, n}]], {n, 1, nn}]];, n]
  156. Monitor[lowerBound3 =
  157. Table[Sum[
  158. OrdinaryLinearProgrammingSolution[[n, k]]/k^(s), {k, 2, n}], {n,
  159. 1, nn}];, n]
  160.  
  161. Monitor[lowerBound4 =
  162. Table[Sum[
  163. Sign[OrdinaryLinearProgrammingSolution[[n, k]]], {k, 2, n}], {n,
  164. 1, nn}];, n]
  165. Count[Table[Floor[(Sqrt[1 + 8*(n + 1)] - 3)/2], {n, 1, nn}] +
  166. lowerBound4, 0]
  167.  
  168. Show[ListLinePlot[constant*lowerBound3, PlotStyle -> {Thick}],
  169. ListPlot[constant*lowerBound3, PlotStyle -> {Thick},
  170. PlotMarkers -> Automatic],
  171. ListPlot[lowerBound1, PlotStyle -> {Thick, Red},
  172. PlotMarkers -> Automatic],
  173. ListLinePlot[lowerBound1, PlotStyle -> {Thick, Red}],
  174. ListPlot[constant*lowerBound2, PlotStyle -> {Thick},
  175. PlotMarkers -> Automatic],
  176. ListLinePlot[constant*lowerBound2, PlotStyle -> {Thick},
  177. PlotMarkers -> Automatic], ImageSize -> Large]
  178. (*end*)
RAW Paste Data