Riemann Zeta Function Zeros

Author

Eric W. Weisstein
September 14, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/SpecialFunctions/RiemannZetaFunctionZeros.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/RiemannZetaFunctionZeros.html.

©2008 Wolfram Research, Inc. except for portions noted otherwise

Computation

Length[zeros=ReadList["/Volumes/Users/Data/Math/ZetaZeros.txt"]]//Timing

Take[zeros,2]

Im[ZetaZero[Range[2]]]//N

zeros=Im[ZetaZero[Range[10^2]]//N];//Timing

zeros=Im[ZetaZero[Range[10^3]]//N];//Timing

zeros=Im[ZetaZero[Range[10^4]]//N];//Timing

Product

ζ(s)==((e^((log(2 π)-(ℽ/2)-1) s))/(2 (s-1) Γ((s/2)+1))) (Underoverscript[∏', (n=-∞), ∞])(1-(s/(Subscript[ρ, n]))) (e^(s/(Subscript[ρ, n])))

With[{s=4.},
{Zeta[s],
Exp[(Log[2Pi]-1-EulerGamma/2)s]/(2(s-1)Gamma[1+s/2]) Product[(1.-s/ZetaZero[n])Exp[s/ZetaZero[n]],{n,500}]Product[(1.-s/ZetaZero[-n])Exp[s/ZetaZero[-n]],{n,500}]}
]

Plots of Zeros

<<Utilities`Plot`
<<Utilities`Typesetting`

Complex Plane

MakeBoxes[plotlabel,TraditionalForm]:=SuperscriptBox[RowBox[{"\[LeftBracketingBar]",TagBox[RowBox[{"ζ","(",TagBox[RowBox[{"x","+",RowBox[{"i"," ","y"}]}],Zeta,Editable->True],")"}],InterpretTemplate[Function[BoxForm`e$,Zeta[BoxForm`e$]]]],"\[RightBracketingBar]"}],RowBox[{"-","1"}]]

Show[GraphicsArray[
Plot3D[Evaluate[#1],{x,-3,3},{y,-10,50},
DisplayFunction->Identity,
PlotPoints->2{50,80},ViewPoint->{10,2,4},PlotRange->{0,5},Boxed->False,ClipFill->None,Mesh->False,BoxRatios->{5,10,2},AxesLabel->TraditionalForm/@{x,y,""},
PlotLabel->TraditionalForm[#2],
AxesEdge->{{1,-1},Automatic,Automatic},Ticks->{Automatic,Range[0,50,10],Range[0,4]}]&@@@{{Abs[Zeta[x+I y]],Abs[Zeta[x+I y]]},
{1/Abs[Zeta[x+I y]],plotlabel}}
],GraphicsSpacing->-.2
]//Timing

ComplexPlot3D[Zeta[z],{z,-5-50I,5+50I},PlotPoints->250]//Timing

ComplexContourPlot[Zeta[z],{z,-5-50I,5+50I},PlotPoints->250]//Timing

Show[
Block[{$DisplayFunction=Identity},
ContourPlot[#[[1]][Zeta[x+I y]],{x,-5,2},{y,-50,50},
Contours->{0},PlotPoints->200,ContourShading->False,ContourStyle->#[[2]]]&/@{{Re,Red},{Im,Blue}}
],Epilog->{PointSize[.025],{Point[{1/2,-#}],Point[{1/2,#}]}&/@Take[odlyzko,10],
Point[{#,0}]&/@Range[-10,-2,2]},
FrameLabel->TraditionalForm/@{x,y},
PlotLabel->TraditionalForm[Zeta[z]]
]//Timing

Critical Line

Plot[Abs[Zeta[1/2+I t]],{t,-50,50},
AxesLabel->TraditionalForm/@{t,Abs[Zeta[1/2+I t]]},PlotStyle->Red,AspectRatio->.4]

Plot[Evaluate[#[Zeta[1/2+I t]]&/@{Re,Im,Abs}],{t,-40,40},
AxesLabel->TraditionalForm/@{t,Abs[Zeta[1/2+I t]]},PlotStyle->{Red,Blue,Black}]

Finding the roots

<<Utilities`Plot`

Graphically From Zeta

PlotRoots[Re[Zeta[1/2+I x]],{x,0,50},PlotPoints->100,PlotStyle->Blue,AxesLabel->TraditionalForm/@{x,HoldForm[Zeta[1/2+I x]]}]

PlotRoots[Re[Zeta[x]],{x,-10,1},PlotPoints->100,PlotStyle->Blue,AxesLabel->TraditionalForm/@{x,Zeta[x]}]

PlotRoots[Im[Zeta[1/2+I x]], {x, 0, 100}]//Timing

Graphically From Zeta Combining Re and Im

Timing[re=PlotRoots[Re[Zeta[1/2+I x]], {x,0,1000},DisplayFunction->Identity,WorkingPrecision->20];]

Timing[im=PlotRoots[Im[Zeta[1/2+I x]], {x, 0, 1000},DisplayFunction->Identity,WorkingPrecision->20];]

candidates1=Intersection[re,im,SameTest->(Abs[#1-#2]<10^-4&)]

Length[candidates1]

candidates2=Select[Union[re,im,SameTest->(Abs[#1-#2]<10^-4&)],Abs[Zeta[1/2+I#]]<10^-5&];

Length[candidates2]

Graphically from Xi

V5

xi=PlotRoots[Re[XiFunction[1/2+I t]],{t,0,100},PlotRange->10^-4{-1,1},PlotStyle->Blue,AxesLabel->TraditionalForm/@{t,HoldForm[XiFunction[1/2+I t]]}]

V7

xi=PlotRoots[Re[XiFunction[1/2+I t]],{t,0,50},PlotRange->10^-4{-1,1},PlotStyle->Blue,AxesLabel->{t,HoldForm[XiFunction[1/2+I t]]}]

XiFunction[1/2+I t]

xi[[1]]

Chop[Subtract@@@Transpose[{xi,Select[odlyzko,#<100&]}],10^-9]//Union

SetAttributes[f1, NumericFunction];
f1[t_?InexactNumberQ] := Re[XiFunction[1/2+I t]]
f2[t_] := N[f1[SetPrecision[t, Infinity]], $MachinePrecision + 1]

Factor needed since Plot will not plot (10^(-315))

(xi=PlotRoots[10^300Re[XiFunction[1/2+I t]],{t,0,1000},PlotPoints->1000,
DisplayFunction->Identity])//Length//Timing

(xi=PlotRoots[10^300f2[t],{t,0,100},
DisplayFunction->Identity])//Length//Timing

(xi=PlotRoots[10^300Re[XiFunction[1/2+I t]],{t,0,100},
DisplayFunction->Identity])//Length//Timing

Length[Union[xi,SameTest->(Abs[#1-#2]<10^-3&)]]

Table[Count[xi,_?(#<10^n&)],{n,4}]

Complement[xi,Select[odlyzko,#<1000&],SameTest->(Abs[#1-#2]<10^-3&)]

Complement[Select[odlyzko,#<1000&],xi,SameTest->(Abs[#1-#2]<10^-3&)]

Odlyzko

(odlyzko=ReadList["/Volumes/Users/Data/Math/ZetaZeros.txt"])//Length//Timing

Last[odlyzko]

GramPoint[10^5]

Chop[Abs/@Zeta[1/2+I#]&/@zeros,10^-7]//Union//Timing

Table[Count[odlyzko,_?(#<10^n&)],{n,4}]

Round/@Take[odlyzko,100]

Select[odlyzko,#<100&]

Length[%]

Compute the inverse power sums

(fns=FactorTerms[Numerator[#]]/Denominator[#]&/@FullSimplify[ExpandAll[Together[Table[(1/2-I t)^(-n)+(1/2+I t)^(-n),{n,0,6}]]]])//TraditionalForm

(fns=FullSimplify[Table[(1-σ-I t)^(-n)+(σ+I t)^(-n),{n,0,2}],σ>0])//TraditionalForm

f=(1/((t^2)-2 I σ t+I t-(σ^2)+σ))

(1/(I( t-2t σ)+(t^2)+σ-(σ^2)))

Simplify[ExpandAll[((-I( t-2t σ)+(t^2)+σ-(σ^2))/(((t^2)+σ-(σ^2))^2- (t-2 t σ)^2))]]

Simplify[(((t^2)-(-1+σ) σ+I t (-1+2 σ))/((t^4)+(((-1+σ))^2) (σ^2)+(t^2) (-1+6 σ-6 (σ^2))))/.σ->1/2]

ComplexExpand[Re[Denominator[f]]]

Factor[fns]

Plus@@Function[t,#][nontrivial]&/@fns

Ozlyzko

Plus@@Function[t,#][odlyzko]&/@fns//ColumnForm

Analytic

<<Utilities`Typesetting`

sums={Z(1)->(1/2) (2+ℽ-log(4 π)),
Z(2)->2 (Subscript[γ, 1])-((π^2)/8)+(ℽ^2)+1,
Z(3)->3 ℽ (Subscript[γ, 1])+((3 (Subscript[γ, 2]))/2)-((7 ζ(3))/8)+(ℽ^3)+1,
Z(4)->2 (Subscript[γ, 1]^2)+4 (ℽ^2) (Subscript[γ, 1])+2 ℽ (Subscript[γ, 2])+((2 (Subscript[γ, 3]))/3)-((π^4)/96)+(ℽ^4)+1,Z(5)->((5 (Subscript[γ, 2]) (Subscript[γ, 1]))/2)+5 (ℽ^3) (Subscript[γ, 1])+((5 (ℽ^2) (Subscript[γ, 2]))/2)+(5/6) ℽ (6 (Subscript[γ, 1]^2)+(Subscript[γ, 3]))+((5 (Subscript[γ, 4]))/24)-((31 ζ(5))/32)+(ℽ^5)+1,Z(6)->2 (Subscript[γ, 1]^3)+(Subscript[γ, 3]) (Subscript[γ, 1])+6 (ℽ^4) (Subscript[γ, 1])+((3 (Subscript[γ, 2]^2))/4)+3 (ℽ^3) (Subscript[γ, 2])+(ℽ^2) (9 (Subscript[γ, 1]^2)+(Subscript[γ, 3]))+(1/4) ℽ (24 (Subscript[γ, 1]) (Subscript[γ, 2])+(Subscript[γ, 4]))+((Subscript[γ, 5])/20)-((π^6)/960)+(ℽ^6)+1};

Expand[Last/@sums]//ColumnForm//TraditionalForm

N[Last/@sums,20]//ColumnForm