A384045 a(1) = 1, a(2) = 2; for n > 2, a(n) is the smallest unused positive number that shares a factor with a(n-1) if it is greater than it, else it is coprime to a(n-1) if it is less than it.

1, 2, 4, 3, 6, 5, 10, 7, 14, 9, 8, 12, 11, 22, 13, 26, 15, 18, 17, 16, 20, 19, 38, 21, 24, 23, 46, 25, 30, 29, 27, 33, 28, 32, 31, 62, 35, 34, 36, 39, 37, 74, 41, 40, 42, 44, 43, 86, 45, 48, 47, 94, 49, 56, 51, 50, 52, 54, 53, 106, 55, 60, 59, 57, 63, 58, 64, 61

Offset: 1

Author

Scott R. Shannon, May 18 2025

Keywords

• nonn

Comments

For the terms studied all primes appear in their natural order, and approximately 65% of all primes p are immediately followed by a term 2*p. These later terms form the upper of the two lines in the graph.

In the first 100000 terms the fixed points are 1, 2, 12, 18, 98, 182, 306, 380; it is likely no more exist.

The sequence is a permutation of the positive integers as the lowest unused number after k terms will always appear as it will eventually be coprime to a(j) for some j > k.

Examples

			a(3) = 4 as a(2) = 2 and 4 > 2 and shares a factor with it. Note 3 cannot be chosen as 3 > 2 but is coprime to 2.
a(4) = 3 as a(3) = 4 and 3 < 4 and is coprime to it.
		

Links

• Scott R. Shannon, Table of n, a(n) for n = 1..10000

Crossrefs

Cf. A375563, A375564, A373545, A373546, A064413.

Programs

Mathematica

nn = 120; c[_] := False; j = 2; u = 3; c[1] = c[2] = True;
{1, 2}~Join~Reap[Do[k = u;
  While[And[k < j, Or[c[k], ! CoprimeQ[j, k]]], k++];
    If[k >= j,
      If[PrimePowerQ[j],
        Set[{p, k}, {FactorInteger[j][[1, 1]], 1}]; While[c[k*p], k++]; k *= p,
        While[Or[c[k], CoprimeQ[j, k]], k++] ] ];
    Sow[k]; Set[{c[k], j}, {True, k}];
    If[k == u, While[c[u], u++]],
{n, 3, nn}] ][[-1, 1]] (* Michael De Vlieger, May 27 2025 *)