A046503 - OEIS

%I #17 Oct 12 2019 21:51:40

%S 47,59,79,89,97,139,149,157,179,193,197,227,229,239,263,283,293,337,

%T 347,353,359,367,373,383,389,419,433,443,449,463,479,487,491,499,571,

%U 577,593,619,643,661,673,683,691,719,733,743,751,757,797,823,829,839

%N Primes with multiplicative persistence value 3.

%H Robert Israel, <a href="/A046503/b046503.txt">Table of n, a(n) for n = 1..10000</a>

%H Eric Weisstein's World of Mathematics, <a href="http://mathworld.wolfram.com/MultiplicativePersistence.html">Multiplicative Persistence</a>

%e 47 -> 4 * 7 -> [ 28 ] -> 2 * 8 -> [ 16 ] -> 1 * 6 -> [ 6 ] -> one digit in three steps.

%p filter:= proc(n) local L;

%p   if not isprime(n) then return false fi;

%p   L:= convert(convert(n,base,10),`*`); if L < 10 then return false fi;

%p   L:= convert(convert(L,base,10),`*`); if L < 10 then return false fi;

%p   L:= convert(convert(L,base,10),`*`); evalb(L < 10)

%p end proc:

%p select(filter, [seq(i,i=11..1000,2)]); # _Robert Israel_, Jun 05 2018

%t pr3Q[n_] := Length[NestWhileList[Times @@ IntegerDigits[#] &, n, # > 9 &]] == 4; Select[Prime[Range[147]], pr3Q] (* _Jayanta Basu_, Jun 26 2013 *)

%Y Cf. A046500, A046512.

%K nonn,base

%O 1,1

%A _Patrick De Geest_, Sep 15 1998