A133964 Home primes whose homeliness is 5.

773, 1129, 3137, 3251, 3593, 3797, 7541, 7853, 23167, 23557, 23719, 23743, 23773, 23971, 31973, 33191, 33331, 33769, 33863, 37307, 37573, 37691, 37997, 39733, 39929, 47797, 53101, 61613, 67349, 67709, 71129, 71171, 71443, 71719, 73181

Offset: 1

Author

Robert G. Wilson v, Sep 30 2007

Keywords

• nonn
• base

Comments

Number of terms < 10^n: 0, 0, 1, 8, 44, 417, 3299, ... .

Examples

			Only (10, 25, 55, 511, 773) -> 773, etc.
		

Crossrefs

Cf. A037274, A118756, A133963, A133956, A133957, A133958, A133960, A133962, A133966, A133968, A133970, A133972, A133974, A133976, A133978.

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 = 5 - 2; lsu = {}; Do[ If[ lst[[n]] == lst[[n + d]] && lst[[n - 1]] != lst[[n]] && lst[[n]] != lst[[n + d + 1]], AppendTo[lsu, lst[[n]]]], {n, 188004 - d - 1}]; Take[Union@ lsu, 45]