%I #21 Apr 14 2022 09:36:08
%S 1,2,3,4,6,8,9,10,12,5,15,20,18,14,7,21,28,24,16,22,26,11,33,44,27,30,
%T 36,25,35,40,42,32,34,38,17,51,68,39,13,52,65,46,23,69,92,45,48,50,54,
%U 55,56,60,49,63,70,57,19,76,95,58,29,87,116,66,62,31,93,124,72,64,74,78,37,111,148,75
%N 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 min(a(n-2),a(n-1)).
%C Although all primes likely appear they do not occur in their natural order, e.g., 17 appears before 13. In the range studied each time a prime appears, beyond the initial 2 and 3, the next term is a multiple of the same prime. The largest multiple in the first 500000 terms is eight, first occurring at a(446271) = 64403, a(446272) = 515224. It is unknown if this ratio is unbounded for large n. Similarly the smaller of the two terms before a prime is a multiple of the prime. The largest ratio found being seven, first occurring at a(446271) = 64403, the same term as above.
%C In the first 500000 terms there are thirty-eight fixed points - 1, 2, 3, 4, 14, 32, 85, ..., 3277, 8651, 9223. It is likely no more exist. The sequence is conjectured to be a permutation of the positive integers.
%H Michael De Vlieger, <a href="/A352968/b352968.txt">Table of n, a(n) for n = 1..10000</a>
%H Michael De Vlieger, <a href="/A352968/a352968_1.png">Annotated log-log scatterplot of a(n)</a>, n = 1..2^14, showing records in red and local minima in blue, highlighting primes in green and fixed points in amber.
%H Scott R. Shannon, <a href="/A352968/a352968.png">Image of the first 200000 terms</a>. The green line is y = n.
%e a(4) = 4 as min(a(2),a(3)) = min(2,3) = 2, and 4 is the smallest unused number that shares a factor with 2.
%e a(5) = 6 as min(a(3),a(4)) = min(3,4) = 3, and 6 is the smallest unused number that shares a factor with 3.
%t nn = 2^10; u = 1; c[_] = 0; MapIndexed[Set[{a[First[#2]], c[#1]}, {#1, First[#2]}], Range[3]]; While[c[u] > 0, u++]; Do[m = Min[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 *)
%Y Cf. A352976, A064413, A270139, A084937, A336957, A098550.
%K nonn
%O 1,2
%A _Scott R. Shannon_, Apr 12 2022