Function: is n the sum of two primes?

Hi there,

I’d like to define a function for the variable “n” that gives me as Output “True”, if “n” is the sum of two primes (it can be the same primes), and “False” if not.
So for example n = a+b with primes a,b.

I had some ideas, for example:

1.) define a variable

Found=False

2.) First a should be considered to be a fix value, then let b go from 2 to n, for example:
a=2. Then “b” goes 2,3,5,7,11,…,n

3.) If for any combination of a=2 and b we get n, then we’re done and the function gives “True”

4.) Then we set a=3 and “b” goes again from 2,3,5,7,11,…,n

How can I write this with Mathematica? Maybe with “While”?
I’m not very experienced with the software and still learning the basics!

primeSumQ[x_] := Length[IntegerPartitions[x, {2}, Array[Prime, PrimePi[x]]]] > 0

Just for fun, I wrote a little one liner that finds all the two prime sums for a given integer. Surely not as slick as it could be if I played with it a bit, but I only had a few minutes.

twoprimesum[n_] :=  Extract[IntegerPartitions[n, {2}], Position[PrimeQ[IntegerPartitions[n, {2}]], {True, True}]]

twoprimesum[180]
{{173, 7}, {167, 13}, {163, 17}, {157, 23}, {151, 29}, {149,   31}, {139, 41}, {137, 43}, {127, 53}, {113, 67}, {109, 71}, {107, 73}, {101, 79}, {97, 83}}

If the function gives an empty set, then you can say it is False, otherwise True.

Steve C.

that’s pretty short

twoprimesum[n_Integer]:= Length[IntegerPartitions[n,{2},Table[Prime[o],{o,PrimePi[n]}]]] > 0 /; n > 2

you see only True or False …

Somewhat speedier (following Steve’s approach but not necessarilly computing all pairs if not needed):

twoPrimeSumQ[n_Integer] :=
 Catch@Module[{partitions},
   partitions = IntegerPartitions[n, {2}];
   If[And @@ PrimeQ[#], Throw[True]] & /@ partitions;
   False
   ]

Compare timing in an example where all possibilties must be computed…

In[24]:= twoprimesum[1234567] // Timing
Out[24]= {5.739735, False}


In[25]:= twoPrimeSumQ[1234567] // Timing
Out[25]= {1.853211, False}

A factor of roughly 3…
And in a longer True case…

In[26]:= twoprimesum[12345678] // Timing
Out[26]= {472.768436, True}


In[27]:= twoPrimeSumQ[12345678] // Timing
Out[27]= {7.682962, True}

Yeaps! Somewhere in the factor of 62 territory.
Threre presumably is a way to speed all of this up still more…

Yeaps! Somewhere in the factor of 62 territory.
Threre presumably is a way to speed all of this up still more…

of course this happens; so have another try with a built-in One-Liner

twoprimesum[n_Integer]:= Length[IntegerPartitions[n,{2},Table[Prime[o],{o,PrimePi[n]}], 1]] > 0 /; n > 2

if only the Yes Or No question has to be answered - if that does not perform, then either the table of prime numbers is slow or IntegerPartitions[¨] does too much work to pull out a single partition

Simple optimisation:

sumOfTwoPrimesQ[x_?(# < 3 &)] := False
sumOfTwoPrimesQ[x_?(OddQ[#] && # >= 3 &)] := PrimeQ[x - 2]
sumOfTwoPrimesQ[4] = True

Once these are evaluated, we only need to worry about even numbers greater than 4, and we can stop bothering about 2 being prime.

the built-in One-Liner is not too bad

In[3]:= Remove[twoprimesum]
twoprimesum[n_Integer] := Length[IntegerPartitions[n, {2}, Table[Prime[o], {o, PrimePi[n]}], 1]] > 0 /; n > 2

In[7]:= twoprimesum[12345678] // Timing
Out[7]= {2.480416, True}

but of course, in this specific case one can do better

In[37]:= Remove[twoPrimeSumQ]
twoPrimeSumQ[n_Integer?Positive] :=  Which[n < 4, False, 3 < n < 7, True, True, Return[$Failed]] /; n < 7
twoPrimeSumQ[n_Integer?Positive] := Block[{s, bContinue = True},
   s = NextPrime[n, -1];
   While[bContinue && s > Floor[n/2],
    If[PrimeQ[n - s],
     bContinue = False, (* else *)
     s = NextPrime[s, -1]
     ]
    ];
   If[!bContinue, Print[n " = ", n - s, " + ", s]];
   !bContinue
   ] /; n > 6

In[40]:= twoPrimeSumQ[12345678] // Timing
During evaluation of In[40]:= 12345678  = 31 + 12345647
Out[40]= {0., True}

In[41]:= twoprimesum[12345678] // Timing
Out[41]= {2.496016, True}

In[42]:= twoPrimeSumQ[12345677] // Timing
Out[42]= {15.288098, False}

In[43]:= TimeConstrained[twoprimesum[12345677], 300] // Timing
Out[43]= {296.807503, $Aborted}

and this new twoPrimeSumQ[] is rather stupid because it simply drops down the ladder of primes. Possibly one could do better by dropping down and stepping up from NextPrime[Floor[n/2]] and so on and so on and so on … in any case NextPrime[] is a very good work horse, because of

In[44]:= NextPrime[100000000000000000000000000000000000000000000000000000000000000] // Timing
Out[44]= {0.015600, 100000000000000000000000000000000000000000000000000000000000447}

it may look smarter, but is the same and does not run faster

In[1]:= Remove[twoPrimeSumQ]
twoPrimeSumQ[n_Integer?Positive] :=  Which[n < 4, False, 3 < n < 7, True, True, Return[$Failed]] /; n < 7
twoPrimeSumQ[n_Integer?Positive] := Block[{s},
   s = NestWhile[NextPrime[#, -1]&, NextPrime[n, -1], (!PrimeQ[n - #] && # > Floor[n/2])&];
   If[PrimeQ[n - s], Print[n " = ", n - s, " + ", s]];
   PrimeQ[n - s]
  ] /; n > 6

In[4]:= twoPrimeSumQ[12345678] // Timing
During evaluation of In[4]:= 12345678  = 31 + 12345647
Out[4]= {0., True}

In[5]:= twoPrimeSumQ[12345677] // Timing
Out[5]= {16.473706, False}

Sorry for the above time waster

In[5]:= twoPrimeSumQ[12345677] // Timing
Out[5]= {16.473706, False}

because of Patrick’s observation one does

In[15]:= Remove[twoPrimeSumQ]
twoPrimeSumQ[n_Integer?Positive] := Which[n < 4, False, 3 < n < 7, True, True, Return[$Failed]] /; n < 7
twoPrimeSumQ[n_Integer?Positive] := Block[{s},
   s = NestWhile[NextPrime[#, -1] &, NextPrime[n, -1], (!PrimeQ[n - #] && # > Floor[n/2])&];
   If[PrimeQ[n - s],
    Print[n " = ", n - s, " + ", s];
    True,
    False
  ]
] /; n > 6 && EvenQ[n]
twoPrimeSumQ[n_Integer?Positive] := PrimeQ[n - 2] /; n > 6 && OddQ[n]

In[19]:= twoPrimeSumQ[12345678] // Timing
During evaluation of In[19]:= 12345678  = 31 + 12345647
Out[19]= {0., True}

In[20]:= twoPrimeSumQ[12345677] // Timing
Out[20]= {0., False}

In[21]:= twoPrimeSumQ[7832671947367256182764386372561892746]
During evaluation of In[21]:= 7832671947367256182764386372561892746  = 1303 + 7832671947367256182764386372561891443
Out[21]= True

In[22]:= twoPrimeSumQ[7832671947367256182764386372561892747]
Out[22]= False

see also Goldbach’s conjecture http://en.wikipedia.org/wiki/Goldbach%27s_conjecture and it’s verification project http://sweet.ua.pt/tos/goldbach.html there researchers search also for the biggest least prime in a Goldbach partition and the current record is 9781

In[5]:= twoPrimeSumQ[3325581707333960528]
During evaluation of In[5]:= 3325581707333960528  = 9781 + 3325581707333950747
Out[5]= True

of course, by simply typing something in you can unfortunately not improve it

In[10]:= twoPrimeSumQ[7832671947367256182764386372561892746783267423671981236788912762351253\
653256156356123787432781267123673216612903289178123670]

During evaluation of In[10]:= 7832671947367256182764386372561892746783267423671981236788912762351253653256156356123787432781267123673216612903289178123670  = 2647 + 7832671947367256182764386372561892746783267423671981236788912762351253653256156356123787432781267123673216612903289178121023
Out[10]= True

Here is a new record (according to Goldbach conjecture verification) for the biggest least prime in a Goldbach partition: 11719

In[94]:= twoPrimeSumQ[FromDigits[First[RealDigits[E, 10, 390]]] + 1]
During evaluation of In[94]:= 271828182845904523536028747135266249775724709369995957496696762772407663035354759457138217852516642742746639193200305992181741359662904357290033429526059563073813232862794349076323382988075319525101901157383418793070215408914993488416750924476146066808226480016847741185374234544243710753907774499206955170276183860626133138458300075204493382656029760673711320070932870912744374704723069698  = 11719 + 271828182845904523536028747135266249775724709369995957496696762772407663035354759457138217852516642742746639193200305992181741359662904357290033429526059563073813232862794349076323382988075319525101901157383418793070215408914993488416750924476146066808226480016847741185374234544243710753907774499206955170276183860626133138458300075204493382656029760673711320070932870912744374704723057979
Out[94]= True

In[95]:= PrimeQ[11719]
Out[95]= True

In[96]:= PrimeQ[\
2718281828459045235360287471352662497757247093699959574966967627724076\
6303535475945713821785251664274274663919320030599218174135966290435729\
0033429526059563073813232862794349076323382988075319525101901157383418\
7930702154089149934884167509244761460668082264800168477411853742345442\
4371075390777449920695517027618386062613313845830007520449338265602976\
0673711320070932870912744374704723057979]
Out[96]= True

but the partitioned even integer is not smaller than 4 10^18.

Here is a newer record (but it’s also not below 4 10^18): 12281

In[112]:= twoPrimeSumQ[FromDigits[First[RealDigits[E, 10, 633]]]]

During evaluation of In[112]:= 271828182845904523536028747135266249775724709369995957496696762772407663035354759457138217852516642742746639193200305992181741359662904357290033429526059563073813232862794349076323382988075319525101901157383418793070215408914993488416750924476146066808226480016847741185374234544243710753907774499206955170276183860626133138458300075204493382656029760673711320070932870912744374704723069697720931014169283681902551510865746377211125238978442505695369677078544996996794686445490598793163688923009879312773617821542499922957635148220826989519366803318252886939849646510582093923982948879332036250944311730123819706841614039701983767932  = 12281 + 271828182845904523536028747135266249775724709369995957496696762772407663035354759457138217852516642742746639193200305992181741359662904357290033429526059563073813232862794349076323382988075319525101901157383418793070215408914993488416750924476146066808226480016847741185374234544243710753907774499206955170276183860626133138458300075204493382656029760673711320070932870912744374704723069697720931014169283681902551510865746377211125238978442505695369677078544996996794686445490598793163688923009879312773617821542499922957635148220826989519366803318252886939849646510582093923982948879332036250944311730123819706841614039701983755651

Out[112]= True

In[113]:= PrimeQ[12281]
Out[113]= True

In[114]:= \
PrimeQ[271828182845904523536028747135266249775724709369995957496696762\
7724076630353547594571382178525166427427466391932003059921817413596629\
0435729003342952605956307381323286279434907632338298807531952510190115\
7383418793070215408914993488416750924476146066808226480016847741185374\
2345442437107539077744992069551702761838606261331384583000752044933826\
5602976067371132007093287091274437470472306969772093101416928368190255\
1510865746377211125238978442505695369677078544996996794686445490598793\
1636889230098793127736178215424999229576351482208269895193668033182528\
8693984964651058209392398294887933203625094431173012381970684161403970\
1983755651]

Out[114]= True

as always, the Euler number is interesting. Earlier this evening I tried with Pi, but no biggest least prime record appeared so far.

See also Sloane A025018 Numbers n such that least prime in Goldbach partition of n increases http://oeis.org/A025018