A105233 Conjectured numbers n such that the trajectory of n as defined in A003508 is unique.

1, 393, 412, 668, 932, 1096, 1425, 1676, 1706, 1959, 2258, 2476, 2590, 3819, 4162, 4359, 4363, 4569, 4707, 5314, 5462, 5503, 5547, 5949, 6002, 6110, 6207, 6393, 6429, 6484, 6500, 7226, 7706, 8151, 8654, 9566, 9586, 9759, 10085, 10141, 10455, 10774

Offset: 1

Author

R. K. Guy and Robert G. Wilson v, Apr 14 2005

Keywords

• nonn

Comments

The trajectory in A003508, etc., is defined as a(1)=n, for n>1, a(n) = a(n-1) + 1 + sum of distinct prime factors of a(n-1) that are < a(n-1).

If n is a term of this sequence then by definition all later terms in the trajectory of n are excluded.

Crossrefs

Cf. A003508, A105210, A105211, A105212 and A105213.

Programs

Mathematica

a[1] = 1; a[n_] := a[n] = a[n - 1] + 1 + Plus @@ Select[ Flatten[ Table[ #[[1]], {1}] & /@ FactorInteger[ a[n - 1]]], # < a[n - 1] &]; t = Table[ a[n], {n, 1200}]; f[n_] := Module[{b, k = 1}, b[1] = n; b[m_] := b[m] = b[m - 1] + 1 + Plus @@ Select[ Flatten[ Table[ #[[1]], {1}] & /@ FactorInteger[ b[m - 1]]], # < b[m - 1] &]; While[ Position[t, b[k]] == {} && k < 1000, k++ ]; t = Select[ Union[ Join[t, Table[ b[i], {i, 2, k}]]], # > n &]; If[k == 1000, -1, k - 1]]; lst = {1}; Do[ If[ f[n] == -1, AppendTo[lst, n]], {n, 12500}]; lst