Skip to main content
replaced http://mathematica.stackexchange.com/ with https://mathematica.stackexchange.com/
Source Link

Here is a direct approach:

digitsum = Composition[Total, IntegerDigits]; stubbornQ = PrimeQ[#] && Nor @@ PrimeQ[digitsum[#] - {1, 2, 3, 0, -1}] &; i = 1; While[! stubbornQ[++i]] i 

8999

This was quite sufficient in this case. For larger search spaces see Iterate until condition is metIterate until condition is met.


A bit more efficient for v10+ using NoneTrue for early exit:

stubbornQ = PrimeQ[#] && NoneTrue[digitsum[#] - {1, 2, 3, 0, -1}, PrimeQ] & 

Here is a direct approach:

digitsum = Composition[Total, IntegerDigits]; stubbornQ = PrimeQ[#] && Nor @@ PrimeQ[digitsum[#] - {1, 2, 3, 0, -1}] &; i = 1; While[! stubbornQ[++i]] i 

8999

This was quite sufficient in this case. For larger search spaces see Iterate until condition is met.


A bit more efficient for v10+ using NoneTrue for early exit:

stubbornQ = PrimeQ[#] && NoneTrue[digitsum[#] - {1, 2, 3, 0, -1}, PrimeQ] & 

Here is a direct approach:

digitsum = Composition[Total, IntegerDigits]; stubbornQ = PrimeQ[#] && Nor @@ PrimeQ[digitsum[#] - {1, 2, 3, 0, -1}] &; i = 1; While[! stubbornQ[++i]] i 

8999

This was quite sufficient in this case. For larger search spaces see Iterate until condition is met.


A bit more efficient for v10+ using NoneTrue for early exit:

stubbornQ = PrimeQ[#] && NoneTrue[digitsum[#] - {1, 2, 3, 0, -1}, PrimeQ] & 
added 230 characters in body
Source Link
Mr.Wizard
  • 275.2k
  • 34
  • 606
  • 1.5k

Here is a direct approach:

digitsum = Composition[Total, IntegerDigits]; stubbornQ = PrimeQ[#] && Nor @@ PrimeQ[digitsum[#] - {1, 2, 3, 0, -1}] &; i = 1; While[! stubbornQ[++i]] i 

8999

This was quite sufficient in this case. For larger search spaces see Iterate until condition is met.


A bit more efficient for v10+ using NoneTrue for early exit:

stubbornQ = PrimeQ[#] && NoneTrue[digitsum[#] - {1, 2, 3, 0, -1}, PrimeQ] & 

Here is a direct approach:

digitsum = Composition[Total, IntegerDigits]; stubbornQ = PrimeQ[#] && Nor @@ PrimeQ[digitsum[#] - {1, 2, 3, 0, -1}] &; i = 1; While[! stubbornQ[++i]] i 

8999

This was quite sufficient in this case. For larger search spaces see Iterate until condition is met.

Here is a direct approach:

digitsum = Composition[Total, IntegerDigits]; stubbornQ = PrimeQ[#] && Nor @@ PrimeQ[digitsum[#] - {1, 2, 3, 0, -1}] &; i = 1; While[! stubbornQ[++i]] i 

8999

This was quite sufficient in this case. For larger search spaces see Iterate until condition is met.


A bit more efficient for v10+ using NoneTrue for early exit:

stubbornQ = PrimeQ[#] && NoneTrue[digitsum[#] - {1, 2, 3, 0, -1}, PrimeQ] & 
added 14 characters in body
Source Link
Mr.Wizard
  • 275.2k
  • 34
  • 606
  • 1.5k

Here is a direct approach:

digitsum = Composition[Total, IntegerDigits]; stubbornQ = PrimeQ[#] && Nor @@ PrimeQ[digitsum[#] - {1, 2, 3, 0, -1}] &; i = 1; While[! stubbornQ[++i]] i 

9998999

This was quite sufficient in this case. For larger search spaces see Iterate until condition is met.

Here is a direct approach:

digitsum = Composition[Total, IntegerDigits]; stubbornQ = Nor @@ PrimeQ[digitsum[#] - {1, 2, 3, 0, -1}] &; i = 1; While[! stubbornQ[++i]] i 

999

Here is a direct approach:

digitsum = Composition[Total, IntegerDigits]; stubbornQ = PrimeQ[#] && Nor @@ PrimeQ[digitsum[#] - {1, 2, 3, 0, -1}] &; i = 1; While[! stubbornQ[++i]] i 

8999

This was quite sufficient in this case. For larger search spaces see Iterate until condition is met.

Source Link
Mr.Wizard
  • 275.2k
  • 34
  • 606
  • 1.5k
Loading