A373860 a(n) = n for n <= 4; for n > 4, a(n) is the smallest unused positive number that shares a factor with the most recently appearing even number prior to a(n-1) if a(n-1) is even, otherwise it shares a factor with the most recently appearing odd number prior to a(n-1) if a(n-1) is odd.

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

Offset

1,2

Comments

The terms appear to follow a pattern similar to the EKG sequence A064413, i.e., the terms are concentrated along just three lines of different gradients, and the lower line consists only of primes. The uppermost line appears to be composed only of semiprimes that are divisible by 3, while the middle line contains all other terms. See the attached images. For the first 100000 terms the primes appear in their natural order, implying that is likely true for all n.

The fixed points are 1, 2, 3, 4, 16, 32, 124, and it is likely that no more exist. The sequence is conjectured to be a permutation of the positive numbers.

Links

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

Scott R. Shannon, Image of the first 5000 terms. Numbers with one, two, three, four, or five and more prime factors, counted with multiplicity, are shown as red, yellow, green, blue and violet respectively. The white line is a(n) = n.

Example

a(8) = 12 as a(7) = 9 is odd, and the most recently appearing odd number prior to a(7) is a(3) = 3, and 12 is the smallest unused positive number to share a factor with 3.

Mathematica

c[_] := False; j = 4; nn = 120; q[_] := 0; m[_] := 1;
Array[Set[{a[#], c[#]}, {#, True}] &, j]; q[0] = 4; q[1] = 3; u = 5;
Do[If[EvenQ[j],
  If[PrimePowerQ[q[0]], k = m[2];
   While[c[2 k], k++]; k *= 2; While[c[2 m[2]], m[2]++],
   k = u; While[Or[c[k], CoprimeQ[q[0], k]], k++]],
  If[PrimePowerQ[q[1]],
   (k = m[#]; While[c[k #], k++]; k *= #;
      While[c[#  m[#]], m[#]++]) &[FactorInteger[q[1]][[1, 1]]],
   k = u; While[Or[c[k], CoprimeQ[q[1], k]], k++]]
  ]; q[Mod[j, 2]] = j;
 Set[{a[n], c[k], j}, {k, True, k}];
 If[k == u, While[c[u], u++]], {n, j + 1, nn}];
Array[a, nn] (* Michael De Vlieger, Jun 20 2024 *)

Prog

(Python)
from math import gcd, lcm
from itertools import count, islice
def agen(): # generator of terms
    yield from [1, 2, 3, 4]
    aset, an, eo, mink = {1, 2, 3, 4}, 4, [2, 3], 5
    while True:
        s, prevan = eo[an%2], an
        an = next(k for k in count(mink) if k not in aset and gcd(s, k)>1)
        eo[prevan%2] = prevan
        aset.add(an)
        while mink in aset: mink += 1
        yield an
print(list(islice(agen(), 77))) # Michael S. Branicky, Jun 20 2024

Crossrefs

Cf. A373623, A373546, A064413, A373545, A064413, A005843, A005408.

Sequence in context: A085500 A380136 A265414 * A189291 A155211 A206716

Adjacent sequences: A373857 A373858 A373859 * A373861 A373862 A373863

Keyword

nonn

Author

Scott R. Shannon, Jun 19 2024

Status

approved