A057880 Primes with 4 distinct digits that remain prime (no leading zeros allowed) after deleting all occurrences of its digits d.

6173, 12239, 16673, 19531, 19973, 21613, 22397, 22937, 34613, 36137, 47933, 51193, 54493, 56519, 56531, 56591, 69491, 69497, 72937, 76873, 93497, 96419, 96479, 96497, 98837, 112939, 118213, 131779, 143419, 144497, 159319, 163337

Offset

1,1

Links

Robert Israel, Table of n, a(n) for n = 1..653

Maple

filter:= proc(L) local d, Lp, i;
      if L[-1]=0 then return false fi;
      if not isprime(add(L[i]*10^(i-1), i=1..nops(L))) then return false fi;
      for d in convert(L, set) do
        Lp:= remove(`=`, L, d);
        if Lp[-1] = 0 or not isprime(add(Lp[i]*10^(i-1), i=1..nops(Lp))) then return false fi;
      od;
      true
end proc:
getCands:= proc(n, m) option remember;
   if m = 1 then return [seq([d$n], d=0..9)] fi;
   if n < m then return [] fi;
   [seq(seq([i, op(L)], i= {$0..9} minus convert(L, set)), L = procname(n-1, m-1)),
    seq(seq([i, op(L)], i=convert(L, set)), L = procname(n-1, m))]
end proc:
[seq(op(sort(map(t->add(t[i]*10^(i-1), i=1..nops(t)), select(filter, getCands(d, 4))))), d=4..6)]; # Robert Israel, Jan 19 2017

Mathematica

p4dQ[n_]:=Module[{idn=IntegerDigits[n]}, Count[idn, 0]==0 && Count[ DigitCount[ n], 0]==6&&AllTrue[FromDigits/@Table[DeleteCases[idn, k], {k, Union[idn]}], PrimeQ]]; Select[Prime[Range[ 15000]], p4dQ] (* The program uses the AllTrue function from Mathematica version 10 *) (* Harvey P. Dale, Sep 30 2017 *)

Crossrefs

Cf. A057876-A057883, A051362, A034302-A034305.

Sequence in context: A007992 A033288 A266586 * A151967 A214556 A114930

Adjacent sequences: A057877 A057878 A057879 * A057881 A057882 A057883

Keyword

nonn,base

Author

Patrick De Geest, Oct 15 2000

Extensions

Offset changed by Robert Israel, Jan 19 2017

Status

approved