A377901 Let Q consist of 1 together with the primes (A008578); form the lexicographically earliest infinite sequence S of distinct positive numbers with the property that a(k) is in Q if and only if k is a term in S.

1, 2, 3, 5, 7, 4, 11, 9, 13, 12, 17, 19, 23, 15, 29, 18, 31, 37, 41, 21, 43, 24, 47, 53, 26, 59, 28, 61, 67, 32, 71, 73, 34, 79, 36, 83, 89, 39, 97, 42, 101, 103, 107, 45, 109, 48, 113, 127, 50, 131, 52, 137, 139, 55, 149, 57, 151, 60, 157, 163, 167, 63, 173, 65

Offset: 1

Author

N. J. A. Sloane, Nov 15 2024

Keywords

• nonn

Comments

In the early 20th century, 1 was regarded as a prime (see A008578). The present sequence is therefore a 20th-century analog of A121053. That is, the sequence answers the question "Which terms are in Q?", and is the lexicographically earliest answer. See A121053 for further information.

Like A121053, this is an example of a "Lexicographically Earliest Sequence" for which there is a greedy algorithm: no backtracking is needed.

Theorem. Let p(k) = k-th prime, c(k) = k-th composite number. For n >= 7, if n is a prime or n = c(2*t) for some t, then a(n) = p(k) where k = floor((n+PrimePi(n)-1)/2); otherwise, n = c(2*t-1) for some t and a(n) = c(2*t).

Examples

			1 is the smallest possible choice for a(1), and 1 is in Q, and it turns out that there is no contradiction in choosing a(1) = 1.
After a(5) = 7, 4 is the smallest number not yet in the sequence, and a(4) = 5 is in Q, so we can try a(6) = 4 (and it turns out that this does not lead to a contradiction later).
		

References

• N. J. A. Sloane, The Remarkable Sequences of Éric Angelini, MS in preparation, December 2024.

Links

• Michael De Vlieger, Table of n, a(n) for n = 1..65536

Crossrefs

Cf. A008578, A121053, A379051, A379053.

Programs

Mathematica

nn = 120; u = 4; v = {}; w = {}; c = 2;
{1}~Join~Reap[Do[
  If[MemberQ[w, n], k = c;
    w = DeleteCases[w, n],
    m = Min[{c, u, v}];
    If[And[PrimeQ[m], n < m],
      AppendTo[v, n]];
      If[Length[v] > 0, If[v[[1]] == m, v = Rest[v]]]; k = m];
    AppendTo[w, k]; If[k == c, c++; While[CompositeQ[c], c++]]; Sow[k];
If[n + 1 >= u, u++; While[PrimeQ[u], u++]], {n, 2, nn}] ][[-1, 1]] (* Michael De Vlieger, Dec 17 2024 *)

Extensions

More terms from Michael De Vlieger, Dec 17 2024