A133975 Home primes whose homeliness is greater than 10.
378997, 379811, 747521, 777643, 1173463, 2314723, 2315641, 2333797, 2337397, 2337607, 2337691, 3127979, 3127997, 3136607, 3173761, 3182561, 3371237, 3372371, 3373547, 3373907, 3374729, 3376991, 3377999, 3378317, 3379829
Offset: 1
Crossrefs
Programs
-
Mathematica
lst = {}; f[n_] := FromDigits@ Flatten[ IntegerDigits@ Table[ #[[1]], {#[[2]]}] & /@ FactorInteger@n, 2]; h[n_] := NestWhileList[f@# &, n, !PrimeQ@# &, 1, 28]; Do[p = h[n][[ -1]]; If[ PrimeQ@p && p < 10^7 && p != n, Print[{n, p}]; AppendTo[lst, p]], {n, 2, 1000}]; d = 11 - 2; lsu = {}; Do[ If[ lst[[n]] == lst[[n + d]], AppendTo[ lsu, lst[[n]] ]], {n, 188004 - d - 1}]; Take[ Union@ lsu, 30]
Comments