|
%I #21 Apr 28 2015 14:55:42
%S 2,23,211,379,773,3389,23251,3761,178069,77773,379811,378997,747521,
%T 2337691,3789293,3574657
%N a(n) = smallest prime p such that p is the home prime (cf. A037274) of exactly n natural numbers.
%C a(17) > 10^7, a(18) = 3784463. - _Robert G. Wilson v_, Oct 01 2007
%F a(n) = A037274(A215408(n)). - _Jonathan Sondow_, Aug 09 2012
%e 23 is the home prime of both 6 and 23, thus a(2) = 23; 211 is the home prime of 4, 22 and 211, thus a(3) = 211.
%e More compactly: (2) -> 2, (6,23) -> 23, (4,22,211) -> 211,
%e (42,74,237,379) -> 379, (10,25,55,511,773) -> 773,
%e (118, 259, 737, 801, 1167, 3389) -> 3389,
%e {250, 1506, 2555, 3865, 5773, 6502, 23251} -> 23251,
%e {140, 332, 514, 566, 1281, 2257, 2283, 3761} -> 3761,
%e {4206, 7402, 10786, 16123, 23701, 25393, 67379, 137173, 178069} -> 178069,
%e {3786, 7262, 10078, 14513, 18417, 23631, 25039, 32449, 37877, 77773} -> 77773,
%e {41933, 50161, 56598, 103487, 192207, 206031, 216959, 239433, 307369, 363007, 379811} -> 379811,
%e {1798, 5982, 22931, 23997, 41315, 53033, 58263, 181293, 184102, 292051, 319421, 378997} -> 378997,
%e {722, 4938, 5718, 7646, 18929, 21919, 23823, 23953, 91277, 97941, 171409, 332647, 747521} -> 747521,
%e {87066, 128055, 138438, 153402, 175611, 226146, 358537, 465734, 588041, 675382, 866893, 1792003, 1564051, 2337691} -> 2337691,
%e {8691, 9725, 23585, 31437, 32897, 55389, 67491, 144995, 168163, 337499, 547617, 964849, 1875153, 3303841, 3789293} -> 3789293,
%e {5978, 10654, 27761, 40307, 47985, 111855, 156657, 172371, 202881, 250519, 357457, 379661, 407507, 488985, 1723971, 3574657} -> 3574657, etc. - _Robert G. Wilson v_, Oct 01 2007
%t 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, 10^7}];
%t lst = Sort@ lst; Table[d = n - 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}]; First@ Union@ lsu, {n, 3, 16}] (* _Robert G. Wilson v_, Oct 01 2007 *)
%Y Cf. A037274, A133956, A133958, A133960, A133962, A133964, A133966, A133968, A133970, A133972, A133974, A133976, A133978, A215408.
%K nonn,base
%O 1,1
%A William Lindgren (william.lindgren(AT)sru.edu), Sep 04 2007, corrected Sep 15 2007
%E a(7)-a(16) from _Robert G. Wilson v_, Sep 27 2007, Oct 01 2007
|
