A226144 Primes p that become composite when any nonzero decimal digit is appended or deleted on the right or left of p.

1301, 3989, 4931, 5387, 6803, 7451, 7703, 7753, 10303, 10657, 10723, 11971, 12119, 12329, 12541, 12653, 12907, 12983, 13693, 13729, 13789, 14207, 14251, 14303, 14411, 14821, 15131, 15217, 15383, 15619, 15629, 15913, 16231, 16487, 17137, 17627, 17807, 17929

Offset: 1

Author

W. Edwin Clark, May 27 2013

Keywords

• nonn
• easy
• base

Comments

Among the first million primes, 99272 of them are of this type. This sequence was suggested by Carlos Rivera's Puzzle 690 (see link below).

Examples

			1301 is prime, but the numbers 301, 130, x1301, 1301x are composite for any x in {1,2,3,4,5,6,7,8,9}.
		

Links

• T. D. Noe, Table of n, a(n) for n = 1..10000
• Carlos Rivera, Puzzle 690 Unreachable Primes

Crossrefs

Cf. A050249 (weakly prime numbers: changing any one decimal digit always produces a composite number).

Programs

Maple

with(StringTools):
LL:=Explode("123456789"):
IsIsolated:=proc(p)
global LL;
local L,x,q,i,t;
L:=Explode(convert(p,string));
   for x in LL do
      t:=[x,seq(L[i],i=1..nops(L))];
      q:=parse(Implode(t));
      if isprime(q) then return false; fi;
      t:=[seq(L[i],i=1..nops(L)),x];
      q:=parse(Implode(t));
      if isprime(q) then return false; fi;
   od:
   t:=[seq(L[i],i=1..nops(L)-1)];
   if t <> [] then
      q:=parse(Implode(t));
      if isprime(q)  then return false; fi;
   fi;
   t:=[seq(L[i],i=2..nops(L))];
   if t <> [] then
      q:=parse(Implode(t));
      if isprime(q)  then return false; fi;
   fi;
return true;
end proc:
a:=NULL;
for i from 1 to 20000 do
p:=ithprime(i);
if IsIsolated(p) then a:=a,p; fi;
od:
a;  # W. Edwin Clark, May 28 2013

Mathematica

noPrimesQ[p_] := Module[{d = IntegerDigits[p],  tens = 10^Ceiling[Log[10, p]]}, ! PrimeQ[FromDigits[Rest[d]]] && ! PrimeQ[FromDigits[Most[d]]] && ! PrimeQ[10*p + 1] && ! PrimeQ[10*p + 3] && ! PrimeQ[10*p + 7] && ! PrimeQ[10*p + 9] && ! PrimeQ[1*tens + p] && ! PrimeQ[2*tens + p] && ! PrimeQ[3*tens + p] && ! PrimeQ[4*tens + p] && ! PrimeQ[5*tens + p] && ! PrimeQ[6*tens + p] && ! PrimeQ[7*tens + p] && ! PrimeQ[8*tens + p] && ! PrimeQ[9*tens + p]]; t = {}; Do[If[noPrimesQ[p], AppendTo[t, p]], {p, Prime[Range[PrimePi[20000]]]}]; t (* T. D. Noe, May 28 2013 *)
pbcQ[p_]:=Module[{idp=IntegerDigits[p],lm1,rm1,lft,rt},lm1 = FromDigits[ Most[ idp]];rm1=FromDigits[Rest[idp]];lft= Table[ l*10^Length[idp]+p,{l,9}]; rt=Table[10*p+r,{r,9}];AllTrue[ Flatten[ Join[ {lm1,rm1,lft,rt}]],CompositeQ]]; Select[ Prime[ Range[ 2100]],pbcQ] (* Harvey P. Dale, Dec 20 2021 *)