A316982 Numbers k such that replacing each digit d in the decimal expansion of k with d^3 yields a prime each time, when done recursively three times.
11, 31, 101, 173, 1307, 1873, 10111, 11923, 12209, 14767, 20357, 20729, 21149, 22003, 22151, 29261, 43681, 43891, 52033, 52211, 55231, 58121, 65011, 70027, 70399, 80569, 100087, 101111, 101401, 102079, 102113, 120091, 151931, 163669, 172001, 200501, 201113, 203831
Offset: 1
Examples
173 is a term because replacing each digit d with d^3, recursively three times, a prime number is obtained: 173 -> 134327 (prime); 134327 -> 12764278343 (prime); 12764278343 -> 18343216648343512276427 (prime). 1873 is a term because replacing each digit d with d^3, recursively three times, a prime number is obtained: 1873 -> 151234327 (prime); 151234327 -> 1125182764278343 (prime); 1125182764278343 -> 11812515128343216648343512276427 (prime).
Links
- Harvey P. Dale, Table of n, a(n) for n = 1..235 (terms up to 2500000)
Programs
-
Mathematica
A316982 = {}; Do[a=FromDigits[Flatten[IntegerDigits /@ (IntegerDigits[n]^3)]]; b=FromDigits[Flatten[IntegerDigits /@ (IntegerDigits[a]^3)]]; c=FromDigits[Flatten[IntegerDigits /@ (IntegerDigits[b]^3)]]; If[PrimeQ[a] && PrimeQ[b] && PrimeQ[c], AppendTo[A316982, n]], {n,300000}]; A316982 (* or *) c[n_] := FromDigits@ Flatten@ IntegerDigits[IntegerDigits[n]^3]; Select[Range[204000], PrimeQ[x = c@#] && PrimeQ[y = c@x] && PrimeQ@c@y &] (* Giovanni Resta, Jul 18 2018 *) p3[n_]:=Rest[NestList[FromDigits[Flatten[IntegerDigits/@(IntegerDigits[#]^3)]]&,n,3]]; Select[Range[205000],AllTrue[p3[#],PrimeQ]&] (* The program uses the AllTrue function from Mathematica version 10 *) (* Harvey P. Dale, Aug 11 2019 *)
-
PARI
eva(n) = subst(Pol(n), x, 10) replace_digits(n) = my(d=digits(n), e=[]); for(x=1, #d, my(f=digits(d[x]^3)); if(f==[], e=concat(e, [0]), for(y=1, #f, e=concat(e, f[y])))); eva(e) is(n) = my(x=n, i=0); while(i < 3, x=replace_digits(x); if(!ispseudoprime(x), break, i++)); i >= 3 \\ Felix Fröhlich, Oct 24 2018