A133966 Home primes whose homeliness is 6.

3389, 23929, 31193, 37199, 37463, 37547, 37607, 37717, 37853, 37907, 41863, 41887, 41941, 73331, 74759, 74771, 77269, 77797, 83383, 112909, 114773, 131321, 131783, 132971, 134753, 191231, 193463, 223241, 223313, 223331, 223337, 223547, 231277

Offset: 1

Author

Robert G. Wilson v, Sep 30 2007

Keywords

• nonn
• base

Comments

Number of terms < 10^n: 0, 0, 0, 1, 19, 197, 1422, ... .

Examples

			Only (118, 259, 737, 801, 1167, 3389) -> 3389, etc.
		

Crossrefs

Cf. A037274, A118756, A133965, A133956, A133957, A133958, A133960, A133962, A133964, 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 = 6 - 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, 35]