A226144 - OEIS

%I #22 Dec 20 2021 17:37:37

%S 1301,3989,4931,5387,6803,7451,7703,7753,10303,10657,10723,11971,

%T 12119,12329,12541,12653,12907,12983,13693,13729,13789,14207,14251,

%U 14303,14411,14821,15131,15217,15383,15619,15629,15913,16231,16487,17137,17627,17807,17929

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

%C 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).

%H T. D. Noe, <a href="/A226144/b226144.txt">Table of n, a(n) for n = 1..10000</a>

%H Carlos Rivera, <a href="http://www.primepuzzles.net/puzzles/puzz_690.htm">Puzzle 690 Unreachable Primes</a>

%e 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}.

%p with(StringTools):

%p LL:=Explode("123456789"):

%p IsIsolated:=proc(p)

%p global LL;

%p local L,x,q,i,t;

%p L:=Explode(convert(p,string));

%p    for x in LL do

%p       t:=[x,seq(L[i],i=1..nops(L))];

%p       q:=parse(Implode(t));

%p       if isprime(q) then return false; fi;

%p       t:=[seq(L[i],i=1..nops(L)),x];

%p       q:=parse(Implode(t));

%p       if isprime(q) then return false; fi;

%p    od:

%p    t:=[seq(L[i],i=1..nops(L)-1)];

%p    if t <> [] then

%p       q:=parse(Implode(t));

%p       if isprime(q)  then return false; fi;

%p    fi;

%p    t:=[seq(L[i],i=2..nops(L))];

%p    if t <> [] then

%p       q:=parse(Implode(t));

%p       if isprime(q)  then return false; fi;

%p    fi;

%p return true;

%p end proc:

%p a:=NULL;

%p for i from 1 to 20000 do

%p p:=ithprime(i);

%p if IsIsolated(p) then a:=a,p; fi;

%p od:

%p a;  # _W. Edwin Clark_, May 28 2013

%t 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 *)

%t 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 *)

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

%K nonn,easy,base

%O 1,1

%A _W. Edwin Clark_, May 27 2013