A133962 Home primes whose homeliness is 4.

379, 2347, 2383, 2389, 3331, 3359, 3373, 3719, 3767, 4397, 4759, 7331, 7457, 7523, 7547, 7823, 11251, 13883, 17137, 17317, 19157, 19181, 22367, 22397, 23131, 23173, 23197, 23311, 23593, 23677, 23767, 23911, 29101, 31063, 31123, 31181, 31189

Offset: 1

Author

Robert G. Wilson v, Sep 30 2007

Keywords

• nonn
• base

Comments

Number of terms < 10^n: 0, 0, 1, 16, 146, 1085, 8522, ... .

Examples

			Only (42,74,237,379) -> 379, etc.
		

Crossrefs

Cf. A037274, A118756, A133961, A133956, A133957, A133958, A133960, A133964, 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 = 4 - 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]