What is the smallest prime $p$ such that the next prime is greater than $p+2000\ $?

Question

I studied this site

https://en.wikipedia.org/wiki/Prime_gap

and wondered if the smallest prime gap greater than $2000$ can still be determined, in other words :

Which is the smallest prime $p$, such that $q-p>2000$, where $p$ and $q$ are consecutive primes ?

Clearly, $1.4\times 10^{18}$ is a lower bound for $p$, as the calculated prime gaps show.

I tried to estimate the magnitude of the smallest prime gap with difference $2002$, but the useful estimations refer to the definition $g_n=p_{n+1}-p_n$. I did not manage to estimate the desired result with the given estimates for $g_n$ and I think they are far too big.

An example with $61$ digits is $$p=149\# \times 1290 \ + \ 8849$$

s=prod(j=1,35,prime(j))*1290+8849;t=nextprime(s+1);print(isprime(s,2),"   ",is
prime(t,2),"    ",t-s,"    ",truncate(log(s)/log(10)+1))
1   1    2042    61

Answer 1

It doesn't go all the way to 2000 but it addresses your problem. Apparently it is hard to do it exhaustively. It has only been done for primes under $10^{18}$ and the gap they found is $1476$

http://primerecords.dk/primegaps/maximal.htm

Answer 2

I would like to ammend my previous (edited) estimate to a more conservative one: betwen $1.97\times 10^{19}$ and $7.02\times 10^{22},$ with the most likely value being close to $1.18\times 10^{21},$ based purely on data from @dREaM's link (or equivalently this one), but this is highly speculative. Speculation based on following observations:

cc={{0,2},{1,3},{3,7},{5,23},{7,89},{13,113},{17,523},{19,887},{21,1129},{33,1327},{35,9551},{43,15683},{51,19609},{71,31397},{85,155921},{95,360653},{111,370261},{113,492113},{117,1349533},{131,1357201},{147,2010733},{153,4652353},{179,17051707},{209,20831323},{219,47326693},{221,122164747},{233,189695659},{247,191912783},{249,387096133},{281,436273009},{287,1294268491},{291,1453168141},{319,2300942549},{335,3842610773},{353,4302407359},{381,10726904659},{383,20678048297},{393,22367084959},{455,25056082087},{463,42652618343},{467,127976334671},{473,182226896239},{485,241160624143},{489,297501075799},{499,303371455241},{513,304599508537},{515,416608695821},{531,461690510011},{533,614487453523},{539,738832927927},{581,1346294310749},{587,1408695493609},{601,1968188556461},{651,2614941710599},{673,7177162611713},{715,13829048559701},{765,19581334192423},{777,42842283925351},{803,90874329411493},{805,171231342420521},{905,218209405436543},{915,1189459969825483},{923,1686994940955803},{1131,1693182318746371},{1183,43841547845541059},{1197,55350776431903243},{1219,80873624627234849},{1223,203986478517455989},{1247,218034721194214273},{1271,305405826521087869},{1327,352521223451364323},{1355,401429925999153707},{1369,418032645936712127},{1441,804212830686677669},{1475,1425172824437699411}}

With[{c = 4}, ListLinePlot[{(Sqrt@# & /@ (Transpose@cc)[[1]]), -Log[ 
Log[RiemannR@N[#] - Sqrt@#]/#] & /@ ((Transpose@cc)[[2]]), (#/
2 + c & /@ Range@(2 Sqrt@2000)), (#/2 - c & /@ Range@(2 Sqrt@2000)), (#/2 
& /@ Range@(2 Sqrt@2000))}, FillingStyle -> {Directive[{Opacity[.25], 
ColorData[97, "ColorList"][[1]]}]} , PlotStyle -> {{}, {}, {Opacity[0]}, 
{Opacity[0]}, {Darker@Blue, Thin, Dashed}}, Filling -> {3 -> {4}}, 
Frame -> True, PlotRange -> {{Automatic, Automatic}, {0, Automatic}}]]

x /. With[{c = 4}, Table[FindRoot[-Log[Log[-Sqrt@x + RiemannR@N[x]]/
    x] == (#/2 + cc &@(2 Sqrt@2000)), {x, 1000}], {cc, {-c, 0, c}}]]

(*{1.96873*10^19, 1.18074*10^21, 7.02452*10^22}*)

This is of course a huge search area, but is as speculatively tight as possible, I think, given the data known to date. I should be fairly surprised if the value lies significantly outside of these bounds. If you find anything, I should be interested in the results you achieve. Anyway, should give you fairly reasonable bounds in which to search.

Update

In responsse to @DanaJ's comment below, for proven first occurrances, of course uyou will have to start the search at $4\times10^{18},$ since that is the current exhaustive search limit. The upper bound is then $\approx 8.247\times 10^{32}$ see here.

However, I am cannot find any reason to suggest that the merit will be as low as $\approx 35,$ despite current max merits known. Plotting the value of increasing merits for first known occurrances:

ListLinePlot[{Transpose@{Sqrt@cc[[All, 1]], 
N[#[[1]]/Log@#[[2]]] & /@ cc}, # - Sqrt@# & /@ Range@Sqrt@2000, # & /@ 
Range@Sqrt@2000, # - (Sqrt@#)/2 & /@ Range@Sqrt@2000}, 
FillingStyle -> {Directive[{Opacity[.25], 
ColorData[97, "ColorList"][[1]]}]}, PlotStyle -> 
{{Darker@ColorData[97, "ColorList"][[1]]}, {Opacity[0]}, 
{Opacity[0]}, {Darker@Blue, Thin, Dashed}, {Opacity[0]}}, 
Filling -> {3 -> {4}, 2 -> {4}}, Frame -> True]

shows very clear statistical trends which suggest that the merit at $g_n\geq 2000$ yields similar estimated bounds as given in first part of answer, but using completely different methods, with the following merit min, expected & max estimates:

N@{# - Sqrt@# &@Sqrt@2000, # - Sqrt@#/2 &@Sqrt@2000, # &@Sqrt@2000}
(*{38.034, 41.3777, 44.7214}*)

giving estimated prime ranges of

Flatten[x /. NSolve[2000/Log[x] == #, x] & /@ Reverse@{# - Sqrt@# 
&@Sqrt@2000, # - Sqrt@#/2 &@Sqrt@2000, # &@ Sqrt@2000}]

(*{2.64387*10^19, 9.81156*10^20, 6.8738*10^22}*)

which are in clear agreement with initial estimates.

Of course, one could be a little more conservative with these estimates, going for something like

Flatten[x /. NSolve[2000/Log[x] == #, x] & /@ Reverse@{# - (Sqrt@# + 
Log@Log@#) &@ Sqrt@2000, # - (Sqrt@# + Log@Log@#/4)/2 &@
Sqrt@2000, # + Log@Log@# &@Sqrt@2000}] 

(*{7.23125*10^18, 1.19329*10^21, 4.65612*10^23}*)

but I almost certainly don't think it is necessary to go as high as $6.9\times 10^{24}.$ Only time will tell, of course, and the rate at reaseach in this area and the technology to support it are going, I shouldn't think we will have too long to wait before we get a definitive answer to your question :)