A133977 Home primes whose homeliness is greater than 11.
378997, 747521, 777643, 2333797, 2337397, 2337691, 3127979, 3127997, 3136607, 3173761, 3373547, 3373907, 3374729, 3377999, 3378317, 3379829, 3574657, 3639997, 3733967, 3746507, 3759263, 3774161, 3777419, 3784463, 3789293
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 = 12 - 2; lsu = {}; Do[ If[ lst[[n]] == lst[[n + d]], AppendTo[ lsu, lst[[n]] ]], {n, 188004 - d - 1}]; Take[ Union@ lsu, 30]
Comments