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