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

%I #15 Mar 31 2023 13:42:21

%S 6173,12239,16673,19531,19973,21613,22397,22937,34613,36137,47933,

%T 51193,54493,56519,56531,56591,69491,69497,72937,76873,93497,96419,

%U 96479,96497,98837,112939,118213,131779,143419,144497,159319,163337

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

%H Robert Israel, <a href="/A057880/b057880.txt">Table of n, a(n) for n = 1..653</a>

%p filter:= proc(L) local d,Lp,i;

%p if L[-1]=0 then return false fi;

%p if not isprime(add(L[i]*10^(i-1),i=1..nops(L))) then return false fi;

%p for d in convert(L,set) do

%p Lp:= remove(`=`,L,d);

%p if Lp[-1] = 0 or not isprime(add(Lp[i]*10^(i-1),i=1..nops(Lp))) then return false fi;

%p od;

%p true

%p end proc:

%p getCands:= proc(n, m) option remember;

%p if m = 1 then return [seq([d$n], d=0..9)] fi;

%p if n < m then return [] fi;

%p [seq(seq([i,op(L)],i= {$0..9} minus convert(L,set)),L = procname(n-1,m-1)),

%p seq(seq([i,op(L)],i=convert(L,set)),L = procname(n-1,m))]

%p end proc:

%p [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

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

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

%K nonn,base

%O 1,1

%A _Patrick De Geest_, Oct 15 2000

%E Offset changed by _Robert Israel_, Jan 19 2017