login
a(n) is the least prime p such that there are exactly n primes q < p with 2*p+q prime.
1

%I #39 Dec 14 2021 16:17:55

%S 2,5,7,13,53,43,47,67,107,137,173,191,163,271,307,277,313,389,461,487,

%T 593,523,563,613,691,739,787,811,797,937,983,887,1039,1069,997,1181,

%U 1117,1249,1301,1453,1303,1597,1399,1483,1567,1721,1871,1783,1693,1697,1987,1877,1847,2311,2143,2309,2281

%N a(n) is the least prime p such that there are exactly n primes q < p with 2*p+q prime.

%H Robert Israel, <a href="/A348671/b348671.txt">Table of n, a(n) for n = 0..1000</a>

%e a(3) = 13 because there are 3 primes q < 13 with 2*13+q prime, namely 2*13+3 = 29, 2*13+5 = 31, 2*13+11 = 37, and no prime < 13 has exactly 3 such primes.

%p P:= [seq(ithprime(i),i=1..10000)]:

%p M:= 100: V:= Array(0..M): count:= 0:

%p for k from 1 to 10000 while count < M+1 do

%p v:= nops(select(isprime, {seq(2*P[k]+P[j],j=1..k-1)}));

%p if v <= M and V[v] = 0 then

%p count:= count+1; V[v]:= P[k];

%p fi

%p od:

%p convert(V,list);

%t cnt[p_] := Count[Range[2, p - 1], _?(PrimeQ[#] && PrimeQ[2*p + #] &)]; seq[m_] := Module[{s = Table[0, {m}], c = 0, p = 1, i}, While[c < m, p = NextPrime[p]; i = cnt[p] + 1; If[i <= m && s[[i]] == 0, c++; s[[i]] = p]]; s]; seq[50] (* _Amiram Eldar_, Dec 13 2021 *)

%K nonn

%O 0,1

%A _J. M. Bergot_ and _Robert Israel_, Dec 13 2021