%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