3
$\begingroup$

Each Prime can (mostly) be generated by having an existing Prime, then padding it either in front or back by a single digit (and the resulting number will be a Prime as well).

example:

23 is a Prime, Add a 2 in front: 223 is also a Prime 11 is a Prime, Add a 3 in the back: 113 is also a Prime 

Now there are some Primes that this pattern does not exist for. I am trying to see which ones do not fit this category.

So If I start by getting a few Primes, then pad them and see if results are Prime:

Front-padding:

FromDigits@*Flatten@*IntegerDigits /@ Select[Tuples[{Range[9], Prime[Range[10]]}], PrimeQ[FromDigits[ Join[IntegerDigits[#[[1]]], IntegerDigits[#[[2]]]]]] &] 

===>

{13, 17, 113, 23, 211, 223, 229, 37, 311, 313, 317, 43, 47, 419, 53, 523, 67, 613, 617, 619, 73, 719, 83, 811, 823, 829, 97, 911, 919, 929} 

Back-padding:

FromDigits@*Flatten@*IntegerDigits /@ Select[Tuples[{Prime[Range[10]], Range[10] - 1}], PrimeQ[FromDigits[ Join[IntegerDigits[#[[1]]], IntegerDigits[#[[2]]]]]] &] 

===>

{23, 29, 31, 37, 53, 59, 71, 73, 79, 113, 131, 137, 139, 173, 179, 191, 193, 197, 199, 233, 239, 293} 

Those are also all Primes - however this is just giving me a list. I need to:

1-Merge them into a single list, ordered.

2-More importantly, see which original primes did not have a resulting Prime. Those need to be identified. (Ex: 773) - If we expand the original Range of 10

$\endgroup$
2
  • $\begingroup$ Have you seen Union[] (for merging and sorting lists)? $\endgroup$ Commented Nov 3, 2024 at 16:08
  • $\begingroup$ The primes that do not satisfy the condition appears to be A240843 in OEIS $\endgroup$ Commented Nov 3, 2024 at 16:36

4 Answers 4

3
$\begingroup$
Select[Prime[Range[1000]], Not[Or @@ PrimeQ[Join[(f |-> FromDigits@Prepend[IntegerDigits[#], f]) /@ Range[9], (f |-> FromDigits@Append[IntegerDigits[#], f]) /@ Range[9]]]] &] 

{773, 1103, 1301, 3947, 3989, 4241, 4637, 4931, 5039, 5387, 5417, 6803, 6917, 6971, 7229, 7451, 7703, 7753} 
$\endgroup$
1
  • 3
    $\begingroup$ Ha! What a coincidence: We both picked the first 1000 primes for a test. (I guess you did it for the same reason I did: The first 100 didn't contain any primes that failed.) $\endgroup$ Commented Nov 3, 2024 at 16:23
4
$\begingroup$

Write a function to check a prime (assumes p is a prime for efficiency):

goodP[p_] := With[{nextPower = 10^Ceiling@Log10[N@p]}, AnyTrue[Join[Range[9] nextPower + p, 10*p + {1, 3, 7, 9}], PrimeQ]]; 

Pick the "bad" primes:

With[{primes = Prime[Range[1000]]}, Pick[primes, goodP /@ primes, False]] (* {773, 1103, 1301, 3947, 3989, 4241, 4637, 4931, 5039, 5387, 5417, 6803, 6917, 6971, 7229, 7451, 7703, 7753} *) 

The following groups primes by whether the task succeeds:

pdata = With[{primes = Prime[Range[1000]]}, GroupBy[primes, goodP]]; pdata[False] (* {773, 1103, 1301, 3947, 3989, 4241, 4637, 4931, 5039, 5387, 5417, 6803, 6917, 6971, 7229, 7451, 7703, 7753} *) pdata[True] // Short (* {2, 3, 5, 7, 11, 13, 17, <<968>>, 7873, 7877, 7879, 7883, 7901, 7907, 7919} *) 
$\endgroup$
3
$\begingroup$

Here is a function that returns True if a prime adheres to the pattern and False otherwise:

check[p_] := Module[{d = IntegerDigits[p], r = Range[0, 9]}, pre = FromDigits /@ (Prepend[d, #] & /@ Rest@r ); end = FromDigits /@ (Append[d, #] & /@ r ); AnyTrue[Join[pre, end], PrimeQ] ] 

To get an ordered list of primes that fullfill the pattern:

Select[Table[Prime[i], {i, 2, 100}], check] {3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, \ 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, \ 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197, 199, 211, 223, \ 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281, 283, 293, \ 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, \ 389, 397, 401, 409, 419, 421, 431, 433, 439, 443, 449, 457, 461, 463, \ 467, 479, 487, 491, 499, 503, 509, 521, 523, 541} 

And a list of primes that do not:

Select[Table[Prime[i], {i, 2, 1000}], ! check[#] &] {773, 1103, 1301, 3947, 3989, 4241, 4637, 4931, 5039, 5387, 5417, \ 6803, 6917, 6971, 7229, 7451, 7703, 7753} 
$\endgroup$
2
$\begingroup$
paddedPrimes[k_Integer /; k > 0] := FromDigits /@ Join[ Thread@Prepend[IntegerDigits[k], Range[1, 9]] , Thread@Append[IntegerDigits[k], Range[1, 9, 2]] ] // Select[PrimeQ] 

Usage

Prime[Range[1, PrimePi[10000]]] // Select[EqualTo[0]@*Length@*paddedPrimes] 

{773, 1103, 1301, 3947, 3989, 4241, 4637, 4931, 5039, 5387, 5417,
6803, 6917, 6971, 7229, 7451, 7703, 7753}

$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.