A133971 Home primes whose homeliness is greater than 8.
77773, 178069, 229751, 312619, 313613, 313739, 317741, 317903, 337457, 337853, 352489, 359929, 364627, 374531, 374587, 375743, 375997, 378997, 379103, 379187, 379397, 379811, 379997, 389971, 719239, 733391, 742283, 747521, 749711, 771941
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 = 9 - 2; lsu = {}; Do[ If[ lst[[n]] == lst[[n + d]], AppendTo[ lsu, lst[[n]] ]], {n, 188004 - d - 1}]; Take[ Union@ lsu, 30]
Comments