%I #13 Jul 23 2023 01:51:02
%S 1,2,4,6,12,16,22,28,36,52,58,66,82,106,112,136,166,178,256,306,336,
%T 352,448,502,508,556,562,586,616,652,658,718,982,1018,1108,1162,1192,
%U 1228,1498,1708,2002,2026,2086,2686,2776,2998,3136,3412,3526,3592,4078,4918
%N Prime productive numbers m: Let the digits of m be abcd. Then the numbers bcd*a+1, cd*ab+1, d*abc+1, abcd+1 etc. are all primes. If m is a k-digit number it produces k such primes.
%C Conjecture: Sequence is infinite.
%H Harvey P. Dale, <a href="/A089395/b089395.txt">Table of n, a(n) for n = 0..139</a> (all terms up to 1 million)
%e 256 is a term as 2*56 + 1 = 113, 25*6 + 1 = 151 and 256 + 1 = 257 are all primes.
%p with(combinat): ds:=proc(s) local j: RETURN(add(s[j]*10^(j-1),j=1..nops(s))):end: for d from 1 to 6 do sch:=[seq([1,op(i),d+1],i=[[],seq([j],j=2..d)])]: for n from 10^(d-1) to 10^d-1 do sn:=convert(n,base,10): fl:=0: for s in sch do m:=mul(j,j=[seq(ds(sn[s[i]..s[i+1]-1]),i=1..nops(s)-1)])+1: if not isprime(m) then fl:=1: break fi od: if fl=0 then printf("%d, ",n) fi od od: # C. Ronaldo
%t ppnQ[n_]:=Mod[n,10]!=0&&AllTrue[Times@@@Table[FromDigits/@TakeDrop[ IntegerDigits[ n],k]/.(0->1),{k,IntegerLength[n]}]+1,PrimeQ]; Select[Range[5000], ppnQ] (* The program uses the AllTrue and TakeDrop functions from Mathematica version 10 *) (* _Harvey P. Dale_, Mar 23 2019 *)
%Y Cf. A089392, A089393, A089394, A089396, A089397.
%K base,nonn
%O 0,2
%A _Amarnath Murthy_, Nov 10 2003
%E Corrected and extended by C. Ronaldo (aga_new_ac(AT)hotmail.com), Dec 25 2004