|
%I #41 May 24 2022 02:47:37
%S 1,2,3,6,7,14,15,17,18,36,37,39,40,45,46,48,49,98,99,101,102,107,108,
%T 110,111,125,126,128,129,134,135,137,138,276,277,279,280,285,286,288,
%U 289,303,304,306,307,312,313,315,316,357,358,360,361,366,367,369,370
%N Sequence contains no 3-term arithmetic progression, other than its initial terms 1, 2, 3.
%C a(1)=1, a(2)=2, a(3)=3; a(n) is least k such that no three terms of a(1), a(2), ..., a(n-1), k form an arithmetic progression, except for the first triple (1,2,3).
%H David A. Corneth, <a href="/A092482/b092482.txt">Table of n, a(n) for n = 1..8193</a> (first 512 terms by Jean-François Alcover)
%H Eric Weisstein's World of Mathematics, <a href="http://mathworld.wolfram.com/NonarithmeticProgressionSequence.html">Nonarithmetic Progression Sequence.</a>
%H <a href="/index/No#non_averaging">Index entries related to non-averaging sequences</a>
%F For n > 2, a(n+2) = 1 + 2^floor(log_2(n)) + Sum_{k=1..n} (3^A007814(n) + 1)/2 = 1 + A053644(n) + A005836(n) (conjectured and checked up to n=512).
%t a[n_] := a[n] = If[n < 4, n, For[k = a[n - 1] + 1, True, k++, sp = SequencePosition[Append[Array[a, n - 1], k], {x_, ___, y_, ___, z_} /; y - x == z - y, 2]; If[sp == {{1, 3}}, Return[k]]]];
%t Table[Print[n, " ", a[n]]; a[n], {n, 1, 512}]
%t (* Comparing with data from conjectured formula: *)
%t b[n_] := If[n < 4, n, 1 + 2^(Length[id = IntegerDigits[n - 2, 2]] - 1) + FromDigits[id, 3]];
%t Table[b[n], {n, 1, 512}] (* _Jean-François Alcover_, Jan 15 2019 *)
%t (* Second [much faster] program: *)
%t upto[m_] := Module[{n, v, i, j}, n = Max[m, 3]; v = Table[1, {n}]; For[i = 3, i <= n-1, i++, If[v[[i]] == 1, For[j = Max[1, 2i-n], j <= Min[2n-i, i-1], j++, If[v[[j]] == 1, v[[2i-j]] = 0]]]]; Position[v, 1] // Flatten]; upto[12000] (* _Jean-François Alcover_, Jan 16 2019, after _David A. Corneth_ *)
%o (PARI) upto(n) = n=max(n,3); v=vector(n, i, 1); for(i=3, n-1, if(v[i]==1, for(j = max(1, 2*i-n), min(2*n-i,i-1), c=2*i - j; if(v[j]==1, v[2*i-j]=0; )))); select(x -> x==1, v, 1) \\ _David A. Corneth_, Jan 15 2019
%Y Cf. A004793, A033157.
%K nonn
%O 1,2
%A _Ralf Stephan_, Apr 04 2004
%E Name clarified by _Charles R Greathouse IV_, Jan 30 2014
|
