login
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.
6

%I #24 Dec 18 2024 09:21:23

%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,

%T 59,28,61,67,32,71,73,34,79,36,83,89,39,97,42,101,103,107,45,109,48,

%U 113,127,50,131,52,137,139,55,149,57,151,60,157,163,167,63,173,65

%N 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.

%C 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.

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

%C 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).

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

%H Michael De Vlieger, <a href="/A377901/b377901.txt">Table of n, a(n) for n = 1..65536</a>

%e 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.

%e 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).

%t nn = 120; u = 4; v = {}; w = {}; c = 2;

%t {1}~Join~Reap[Do[

%t If[MemberQ[w, n], k = c;

%t w = DeleteCases[w, n],

%t m = Min[{c, u, v}];

%t If[And[PrimeQ[m], n < m],

%t AppendTo[v, n]];

%t If[Length[v] > 0, If[v[[1]] == m, v = Rest[v]]]; k = m];

%t AppendTo[w, k]; If[k == c, c++; While[CompositeQ[c], c++]]; Sow[k];

%t If[n + 1 >= u, u++; While[PrimeQ[u], u++]], {n, 2, nn}] ][[-1, 1]] (* _Michael De Vlieger_, Dec 17 2024 *)

%Y Cf. A008578, A121053, A379051, A379053.

%K nonn

%O 1,2

%A _N. J. A. Sloane_, Nov 15 2024

%E More terms from _Michael De Vlieger_, Dec 17 2024