login
A226144
Primes p that become composite when any nonzero decimal digit is appended or deleted on the right or left of p.
2
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,1
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).
EXAMPLE
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}.
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 *)
CROSSREFS
Cf. A050249 (weakly prime numbers: changing any one decimal digit always produces a composite number).
Sequence in context: A022057 A107521 A374803 * A250728 A071847 A014356
KEYWORD
nonn,easy,base
AUTHOR
W. Edwin Clark, May 27 2013
STATUS
approved