A187072 Prime numbers chosen such that the even numbers that are the sum of two consecutive terms occur only once and occur as early as possible.

3, 3, 5, 5, 7, 7, 11, 5, 17, 3, 23, 5, 19, 11, 23, 13, 19, 19, 23, 17, 29, 19, 31, 13, 41, 11, 47, 13, 43, 19, 47, 17, 53, 19, 59, 17, 67, 7, 61, 19, 67, 23, 59, 29, 67, 31, 61, 41, 53, 47, 59, 53, 61, 43, 67, 41, 79, 37, 89, 29, 101, 23, 109, 13, 127, 7, 131, 5, 137, 7, 139, 11, 137, 17, 139, 13, 149, 11, 157, 7, 151, 19, 109, 67, 107, 59, 113, 67

Offset: 1

Author

Reinhard Zumkeller, Mar 03 2011

Keywords

• nonn
• look

Comments

The even numbers a(n) + a(n+1) are in sequence A187085.

The terms for even n grow rapidly; for odd n they grow slowly. It appears that primes occur at a consistent frequency: in the first 1000000 terms, primes 3 to 23 occur about 4.7%, 4.9%, 3.4%, 2.9%, 2.6%, 2.0%, 1.8%, and 1.4% of the time. - T. D. Noe, Mar 04 2011

Examples

			Primes: 3 3 5  5  7  7  11  5  17  3  23  5  19  11  23  13  19  19  23
Evens:   6 8 10 12 14 18  16 22  20 26  28 24  30  34  36  32  38  42
		

Links

• T. D. Noe, Table of n, a(n) for n = 1..5000
• T. D. Noe, Plot of frequency (%) of primes in the first 10^9 terms
• Index entries for sequences related to Goldbach conjecture

Crossrefs

Cf. A065091, A118371, A187085, A187098.

Programs

Haskell

import Data.Set (Set, empty, member, insert)
a187072 n = a187072_list !! (n-1)
a187072_list = goldbach 0 a065091_list empty where
  goldbach :: Integer -> [Integer] -> Set Integer -> [Integer]
  goldbach q (p:ps) gbEven
      | qp `member` gbEven = goldbach q ps gbEven
      | otherwise          = p : goldbach p a065091_list (insert qp gbEven)
      where qp = q + p
-- performance bug fixed: Reinhard Zumkeller, Mar 06 2011

Mathematica

lastE=10; eList=Range[6,lastE,2]; evens[k_] := If[k<=Length[eList], eList[[k]], lastE+=2; AppendTo[eList,lastE]; lastE]; Join[{lastP=3}, Table[k=1; While[p=evens[k]-lastP; p<0 || !PrimeQ[p], k++]; eList=Delete[eList,k]; lastP=p, {999}]] (* T. D. Noe, Mar 04 2011 *)
s={3,3}; ev={6}; a=3; Do[k=2; While[!FreeQ[ev,(b=a+(p=Prime[k]))],k++]; a=p; AppendTo[ev,b]; AppendTo[s,a], {3000}]; s (* Zak Seidov, Mar 03 2011 *)