Finding primes that have certain property

Question

Let S[p] denote the sum of digits of p. A prime p is said to be stubborn if none of S[n] + 1, S[n], S[n] - 1, S[n] - 2 , or S[n] - 3 is a prime. Write a Mathematica code that finds the smallest stubborn prime and tell which prime is it?

@user116988 In that case, you should use the homework tag. — a06e, Dec 20 '13 at 13:59

score 6 · Answer 1 · edited Apr 13 '17 at 12:55

6

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] &

edited Apr 13 '17 at 12:55

Community

1

answered Dec 20 '13 at 14:01

Mr.Wizard

271,378
34
587
1,371

4

999 is not a prime – a06e Dec 20 '13 at 14:06
1

@becko lol -- well, I couldn't be bothered to read someone else's homework too closely. :o) – Mr.Wizard Dec 20 '13 at 14:07
2

+1 for demonstration of Composition usage. – Chris Degnen Dec 20 '13 at 14:11
@Chris Thank you. I tried to show several different styles in this short bit of code hoping it would be instructive to work through. – Mr.Wizard Dec 20 '13 at 14:13
1

@belisarius and Anon; I thought about including additional optimizations but I decided to leave room for improvement for the OP. – Mr.Wizard Dec 20 '13 at 14:43
@Mr.Wizard it never ceases to amaze me how much I learn from your code and how I over complicate measures...:) – ubpdqn Apr 19 '15 at 05:39
@ubpdqn What can I say; thanks. :-) – Mr.Wizard Apr 19 '15 at 16:33

ubpdqn · Answer 2 · 2015-04-19T05:37:49.413

j = 1; 
While[
 Or @@ (PrimeQ@({#-3,# - 2, # - 1, #, # + 1} &@(Total@
        IntegerDigits[Prime[j]]))), j++]
Prime[j]

So 8999 has desired property:

{#-3,# - 2, # - 1, #, # + 1} &@(Total@IntegerDigits[Prime[1117]]))

yields:{32, 33, 34, 35, 36}

for fun:

query[u_] := 
 Nor @@ PrimeQ[# + {-3, -2, -1, 0, 1} &@Total[IntegerDigits@u]]
cand = Prime[#] & /@ Range[1000, 10000]; Grid[
 Partition[PadRight[Pick[cand, query /@ cand], 168, ""], 12]]

The first 167 stubborn primes:

enter image description here

rhennigan · Answer 3 · 2015-04-19T11:16:22.010

1

Here's a functional approach without using loops:

st[p_] := PrimeQ[Total @ IntegerDigits @ p + Range[-3, 1]] ~ AllTrue ~ Not // Not
nextStubborn[p_] := NestWhile[NextPrime, NextPrime[p], st]
stubbornList[n_] := NestList[nextStubborn, 2, n] // Rest
stubbornList[100]

(*  {8999, 18899, 19889, 19979, 19997, 28979, 29789, 29879, 35999, 36899,  *)
(*  37799, 37889, 37997, 38699, 39779, 39869, 39887, 45989, 46889, 46997,  *)
(*  47699, 47969, 48779, 48869, 49499, 49697, 49787, 49877, 55799, 55889,  *)
(*  55997, 56897, 57689, 57977, 58679, 58787, 58967, 59399, 59669, 59957,  *)
(*  64997, 65699, 65789, 66797, 66959, 66977, 67499, 67589, 67679, 67967,  *)
(*  68399, 68489, 68597, 68669, 68687, 68777, 68993, 69389, 69497, 69677,  *)
(*  69767, 69857, 69929, 71999, 74699, 74897, 75689, 75797, 75869, 76679,  *)
(*  76697, 76949, 77489, 77687, 77849, 77867, 78479, 78497, 78569, 78839,  *)
(*  78857, 78893, 78929, 79379, 79397, 79559, 79757, 79829, 79847, 79973}  *)

To just get the smallest:

nextStubborn[1]

(* 8999 *)

edited Apr 19 '15 at 11:16

answered Apr 19 '15 at 10:31

rhennigan

1,783
10
19

1

your code does not produce only primes: note-19980,28980,29790,29880, etc – ubpdqn Apr 19 '15 at 11:08
Oops, it's fixed now. I often forget that Nest-related functions always return the first element. – rhennigan Apr 19 '15 at 11:17
The problem lies in p+1, the necessarily composite p+1 can comply with condition for exiting while – ubpdqn Apr 19 '15 at 11:18
Right, that is what I meant. I should say that "I forget that the function applied zero times is included". My intuition for these things is that the first element to check a condition for in NestWhile[f, x, g] would be g[f[x]], so my intuition often misleads me here since g[x] can also satisfy the break condition. – rhennigan Apr 19 '15 at 11:24

Finding primes that have certain property

3 Answers3