cp's OEIS Frontend

A208746 Size of largest subset of [1..n] containing no three terms in geometric progression.

%I A208746 #37 May 19 2023 01:37:01
%S A208746 1,2,3,3,4,5,6,7,7,8,9,10,11,12,13,13,14,14,15,15,16,17,18,19,19,20,
%T A208746 21,21,22,23,24,24,25,26,27,27,28,29,30,31,32,33,34,34,35,36,37,38,38,
%U A208746 38,39,39,40,41,42,43,44,45,46,46,47,48,49,49,50,51,52,52,53,54,55,55,56,57,57,57,58,59,60,61,61,62,63,64,65,66,67,68,69,70,71,71,72,73,74,74,75,75,75,75
%N A208746 Size of largest subset of [1..n] containing no three terms in geometric progression.
%C A208746 All three-term geometric progressions must be avoided, even those such as 4,6,9 whose ratio is not an integer.
%C A208746 _David Applegate_'s computation used a floating-point IP solver for the packing subproblems, so although it's almost certainly correct there is no proof. First he enumerated geometric progressions using
%C A208746 for (i=1;i<=N;i++) {
%C A208746    for (j=2; j*j<=i; j++) {
%C A208746      if (i % (j*j) != 0) continue;
%C A208746      for (k=1; k<j; k++) {
%C A208746        print i*k*k/(j*j), i*k/j, i;
%C A208746      }
%C A208746    }
%C A208746 }
%C A208746 and then solved the integer program of maximizing the subset of {1..N} subject to not taking all 3 of any progression.
%H A208746 Fausto A. C. Cariboni, <a href="/A208746/b208746.txt">Table of n, a(n) for n = 1..125</a>
%H A208746 K. O'Bryant, <a href="https://cs.uwaterloo.ca/journals/JIS/VOL18/OBryant/obr3.html">Sets of Natural Numbers with Proscribed Subsets</a>, J. Int. Seq. 18 (2015) # 15.7.7.
%H A208746 <a href="/index/No#non_averaging">Index entries for non-averaging sequences</a>
%p A208746 # Maple program for computing the n-th term from _Robert Israel_:
%p A208746 A:= proc(n)
%p A208746      local cons, x;
%p A208746      cons:=map(op,{seq(map(t -> x[t]+x[b]+x[b^2/t]<=2,
%p A208746           select(t -> (t<b) and (t>=b^2/n),
%p A208746        numtheory:-divisors(b^2))),b=2..n-1)});
%p A208746      Optimization:-Maximize(add(x[i],i=1..n),cons, assume=binary)[1]
%p A208746 end proc;
%t A208746 a[n_] := a[n] = If[n <= 2, n, Module[{cons, x}, cons = And @@ Flatten@ Rest@ Union@ Table[x[#] + x[b] + x[b^2/#] <= 2& /@ Select[Divisors[b^2], # < b && # >= b^2/n&], {b, 2, n-1}]; Maximize[{Sum[x[i], {i, 1, n}], cons && AllTrue[Array[x, n], 0 <= # <= 1&]}, Array[x, n], Integers]][[1]]];
%t A208746 Reap[For[n = 1, n <= 100, n++, Print[n, " ", a[n]]; Sow[a[n]]]][[2, 1]] (* _Jean-François Alcover_, May 18 2023, after _Robert Israel_ *)
%Y A208746 Cf. A003002.
%K A208746 nonn
%O A208746 1,2
%A A208746 _David Applegate_ and _N. J. A. Sloane_, Mar 01 2012
%E A208746 a(1)-a(82) confirmed by _Robert Israel_ and extended to a(100), Mar 01 2012