如何在 Mathematica 中用傅立叶变换绘制黎曼 zeta 零谱?

发布于 2024-12-27 20:16:40 字数 1537 浏览 0 评论 0原文

在 J. Brian Conrey 的论文“黎曼猜想”中,图 6 给出了素数定理中误差项的傅立叶变换图。请参阅下图中左侧的图:

Plots from Conrey's paper on the Riemann opportunity

在名为 素数稀薄Air 由 Chris King 编写,有一个绘制频谱的 Matlab 程序。请参阅帖子开头右侧的情节。可以翻译成 Mathematica:

Mathematica:

 scale = 10^6;
 start = 1;
 fin = 50;
 its = 490;
 xres = 600;
 y = N[Accumulate[Table[MangoldtLambda[i], {i, 1, scale}]], 10];
 x = scale;
 a = 1;
 myspan = 800;
 xres = 4000;
 xx = N[Range[a, myspan, (myspan - a)/(xres - 1)]];
 stpval = 10^4;
 F = Range[1, xres]*0;

For[t = 1, t <= xres, t++,
 For[yy=0, yy<=Log[x], yy+=1/stpval,
 F[[t]] =
 F[[t]] +
 Sin[t*myspan/xres*yy]*(y[[Floor[Exp[yy]]]] - Exp[yy])/Exp[yy/2];
 ]
 ]
 F = F/Log[x];
 ListLinePlot[F]

然而,据我所知,这是傅立叶正弦变换的矩阵公式,因此计算成本非常高。我不建议运行它,因为它已经使我的计算机崩溃过一次。

Mathematica 中有没有办法利用快速傅里叶变换来绘制 x 值处的尖峰等于黎曼 zeta 零点虚部的频谱?

我尝试了命令 FourierDSTFourier 但没有成功。问题似乎是代码中的变量 yy 包含在 Sin[t*myspan/xres*yy] 和 (y[[Floor[ Exp[yy]]]] - Exp[yy])/Exp[yy/2]。

编辑:2012 年 1 月 20 日,我将行:

For[yy = 0, yy <= Log[x], 1/stpval++,

更改为以下内容:

For[yy = 0, yy/stpval <= Log[x], yy++,

编辑:2012 年 1 月 22 日,来自 Heike 的评论,更改:

For[yy = 0, yy/stpval <= Log[x], yy++,

为:

For[yy=0, yy<=Log[x], yy+=1/stpval ,

In the paper "The Riemann Hypothesis" by J. Brian Conrey in figure 6 there is a plot of the Fourier transform of the error term in the prime number theorem. See the plot to the left in the image below:

Plots from Conrey's paper on the Riemann hypothesis

In a blog post called Primes out of Thin Air written by Chris King there is a Matlab program that plots the spectrum. See the plot to the right at the beginning of the post. A translation into Mathematica is possible:

Mathematica:

 scale = 10^6;
 start = 1;
 fin = 50;
 its = 490;
 xres = 600;
 y = N[Accumulate[Table[MangoldtLambda[i], {i, 1, scale}]], 10];
 x = scale;
 a = 1;
 myspan = 800;
 xres = 4000;
 xx = N[Range[a, myspan, (myspan - a)/(xres - 1)]];
 stpval = 10^4;
 F = Range[1, xres]*0;

For[t = 1, t <= xres, t++,
 For[yy=0, yy<=Log[x], yy+=1/stpval,
 F[[t]] =
 F[[t]] +
 Sin[t*myspan/xres*yy]*(y[[Floor[Exp[yy]]]] - Exp[yy])/Exp[yy/2];
 ]
 ]
 F = F/Log[x];
 ListLinePlot[F]

However, this is as I understand it the matrix formulation of the Fourier sine transform and it is therefore very costly to compute. I do NOT recommend running it because it already crashed my computer once.

Is there a way in Mathematica utilising the Fast Fourier Transform, to plot the spectrum with spikes at x-values equal to imaginary part of Riemann zeta zeros?

I have tried the commands FourierDST and Fourier without success. The problem seems to be that the variable yy in the code is included in both Sin[t*myspan/xres*yy] and (y[[Floor[Exp[yy]]]] - Exp[yy])/Exp[yy/2].

EDIT: 20.1.2012, I changed the line:

For[yy = 0, yy <= Log[x], 1/stpval++,

into the following:

For[yy = 0, yy/stpval <= Log[x], yy++,

EDIT: 22.1.2012, From Heike's comment, changed:

For[yy = 0, yy/stpval <= Log[x], yy++,

into:

For[yy=0, yy<=Log[x], yy+=1/stpval,

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

自此以后,行同陌路 2025-01-03 20:16:40

这又如何呢?我使用恒等式 Exp[a Log[x]]==x^a 稍微重写了正弦变换

Clear[f]
scale = 1000000;
f = ConstantArray[0, scale];
f[[1]] = N@MangoldtLambda[1];
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 t).(f[[Floor[xlist]]] - xlist)), 
  {t, Range[0, 60, tres]}];, t]

ListLinePlot[Im[errList]/Length[xlist], DataRange -> {0, 60}, 
  PlotRange -> {-.09, .02}, Frame -> True, Axes -> False]

,它产生

Mathematica 图形

What about this? I've rewritten the sine transform slightly using the identity Exp[a Log[x]]==x^a

Clear[f]
scale = 1000000;
f = ConstantArray[0, scale];
f[[1]] = N@MangoldtLambda[1];
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 t).(f[[Floor[xlist]]] - xlist)), 
  {t, Range[0, 60, tres]}];, t]

ListLinePlot[Im[errList]/Length[xlist], DataRange -> {0, 60}, 
  PlotRange -> {-.09, .02}, Frame -> True, Axes -> False]

which produces

Mathematica graphics

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文