A373902 - OEIS

%I #20 Jun 22 2024 14:17:35

%S 2,4,6,2,8,4,10,2,12,3,6,8,10,5,15,3,9,6,10,12,4,14,2,16,4,18,2,20,4,

%T 22,2,24,3,18,6,12,8,14,6,15,9,12,14,7,21,3,27,6,16,8,18,9,21,6,20,5,

%U 25,10,14,16,10,15,12,16,18,10,20,8,22,6,24,4,26,2,28,4,30,2,32,4,34,2,36,3

%N a(1) = 2; for n > 1, a(n) is the smallest positive number that does not equal a(n-1),  shares a factor with a(n-1), and has not appeared as an adjacent term to a(n-1) previously in the sequence.

%C See A371618 for the indices where the primes first appear.

%H Scott R. Shannon, <a href="/A373902/b373902.txt">Table of n, a(n) for n = 1..10000</a>

%H Scott R. Shannon, <a href="/A373902/a373902_2.png">Image of the first 250000 terms</a>. Prime terms are shown in red.

%e a(7) = 10 as a(6) = 4 and, although 2 and 6 share factors with 4, 2 and 4 form a previous adjacent pair, as do 4 and 6. This leaves 10 as the smallest number that shares a factor with 4 while 4 and 10 have not previously appeared as adjacent terms.

%t nn = 120; c[_] := {}; a[1] = j = 2; c[2] = {2};

%t Do[If[PrimePowerQ[j],

%t   (k = 1;

%t      While[Or[j == #  k, CoprimeQ[j, #  k], ! FreeQ[c[j], #  k]], k++];

%t      k *= #) &[FactorInteger[j][[1, 1]]],

%t    k = FactorInteger[j][[1, 1]];

%t      While[Or[j == k, CoprimeQ[j, k], ! FreeQ[c[j], k]], k++] ];

%t   Set[{a[n], c[j], c[k], j},

%t       {k, Union[c[j], {k}], Union[c[k], {j}], k}], {n, 2, nn}];

%t Array[a, nn] (* _Michael De Vlieger_, Jun 22 2024 *)

%o (Python)

%o from math import gcd

%o from itertools import count, islice

%o def agen(): # generator of terms

%o     an, adjacent = 2, {2: set()}

%o     while True:

%o         yield an

%o         A = adjacent[an]

%o         m = next(k for k in count(2) if k!=an and gcd(k, an)>1 and k not in A)

%o         adjacent[an].add(m)

%o         if m not in adjacent: adjacent[m] = set()

%o         adjacent[m].add(an)

%o         an = m

%o print(list(islice(agen(), 84))) # _Michael S. Branicky_, Jun 22 2024

%Y Cf. A371618, A064413, A027748, A364027.

%K nonn,look

%O 1,1

%A _Scott R. Shannon_, Jun 22 2024