A352976 a(1) = 1, a(2) = 2; for n > 2, a(n) is the smallest positive number that has not appeared that shares a factor with max(a(n-2),a(n-1)).

1, 2, 4, 6, 3, 8, 10, 5, 12, 9, 14, 7, 16, 18, 15, 20, 22, 11, 24, 21, 26, 13, 28, 30, 25, 27, 33, 36, 32, 34, 17, 38, 19, 40, 35, 42, 39, 44, 46, 23, 48, 45, 50, 52, 54, 51, 56, 49, 58, 29, 60, 55, 57, 63, 66, 62, 64, 68, 70, 65, 72, 69, 74, 37, 76, 78, 75, 80, 82, 41, 84, 77, 81, 87, 90, 85, 86

Offset: 1

Author

Scott R. Shannon, Apr 13 2022

Keywords

• nonn

Comments

Although all primes likely appear they do not occur in their natural order, e.g., 37 appears before 31. In the range studied each time a prime appears, beyond the initial 2, the previous term is a multiple of the same prime. The largest multiple in the first 500000 terms is six, first occurring at a(7782) = 8286, a(7783) = 1381. It is unknown if this ratio is unbounded for large n. As a prime term is less than its previous term the term following the prime will share a factor with previous multiple of the prime. This factor appears to always be a factor of the multiple and thus the term is not another multiple of the prime.

In the first 500000 terms the fixed points are 1, 2, 15, 25, 35. It is likely no more exist. The sequence is conjectured to be a permutation of the positive integers.

Examples

			a(4) = 6 as max(a(2),a(3)) = max(2,4) = 4, and 6 is the smallest unused number that shares a factor with 4.
a(5) = 3 as max(a(3),a(4)) = max(4,6) = 6, and 3 is the smallest unused number that shares a factor with 6.
		

Links

• Michael De Vlieger, Table of n, a(n) for n = 1..10000
• Michael De Vlieger, Annotated log-log scatterplot of a(n), n = 1..2^14, showing records in red and local minima in blue, highlighting primes in green and fixed points in amber.
• Scott R. Shannon, Image of the first 100000 terms. The green line is y = n.

Crossrefs

Cf. A352968, A064413, A270139, A084937, A336957, A098550.

Programs

Mathematica

nn = 2^10; u = 1; c[] = 0; MapIndexed[Set[{a[First[#2]], c[#1]}, {#1, First[#2]}], {1, 2}]; While[c[u] > 0, u++]; Do[m = Max[Array[a[i - #] &, 2]]; k = u; While[Or[c[k] > 0, CoprimeQ[m, k]], k++]; Set[{a[i], c[k]}, {k, i}]; If[k == u, While[c[u] > 0, u++]], {i, Length[s] + 1, nn}]; Array[a, nn] (* _Michael De Vlieger, Apr 14 2022 *)