A133967 Home primes whose homeliness is greater than 6.
3761, 13367, 23251, 23761, 31397, 33797, 36389, 37643, 37951, 37967, 77711, 77773, 113779, 131777, 132749, 132953, 134129, 178069, 229751, 233347, 233617, 233743, 233881, 233911, 237547, 293863, 311677, 311821, 312619, 313613, 313619, 313739
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 = 7 - 2; lsu = {}; Do[ If[ lst[[n]] == lst[[n + d]], AppendTo[ lsu, lst[[n]] ]], {n, 188004 - d - 1}]; Take[ Union@ lsu, 35]
Comments