A378197 Number of 2-colorings of length n without an arithmetic progression of length 5.

1, 2, 4, 8, 16, 30, 58, 112, 216, 400, 740, 1398, 2638, 4710, 8444, 15118, 27690, 48406, 84382, 146928, 255844, 402998, 625824, 956370, 1447476, 2066828, 3225856, 5020232, 7823236, 10975318, 15264202, 21500308, 30004914, 39030820, 50728472, 65402746, 88886116

Offset: 0

Author

Ethan Ji, Nov 19 2024

Keywords

• nonn

Comments

After a(178) = 0, the sequence will continue to be 0. A sequence satisfying this property cannot have a subsequence which violates it, thus there must exist a sequence of length n-1 if there exists a sequence of length n.

Links

• Michael De Vlieger, Table of n, a(n) for n = 0..178

Crossrefs

First 0 index given by A005346.

Cf. A378195, A378196.

Programs

Mathematica

HasEquallySpacedKBits[bits_, k_] :=
 If[k == 1, True,
  Module[{n = Length[bits], found = False},
   Do[If[Count[Table[bits[[start + gap*i]], {i, 0, k - 1}],
       bits[[start]]] == k, found = True; Break[]], {gap, 1,
     Floor[n/(k - 1)]}, {start, 1, n - gap*(k - 1)}];
   found]]
BitSequence[k_] :=
 Module[{prevSequences = {{}}, currSequences, n = 0, ExtendSequence},
  ExtendSequence[seq_] :=
   Module[{newSeq0, newSeq1, result = {}}, newSeq0 = Join[seq, {0}];
    newSeq1 = Join[seq, {1}];
    If[! HasEquallySpacedKBits[newSeq0, k], AppendTo[result, newSeq0]];
    If[! HasEquallySpacedKBits[newSeq1, k], AppendTo[result, newSeq1]];
    result];
  Function[targetN,
   Print["k=", k, ", n=", n, ": count=", Length[prevSequences]];
   While[n < targetN, n++;
    currSequences = Flatten[ExtendSequence /@ prevSequences, 1];
    prevSequences = currSequences;
    Print["k=", k, ", n=", n, ": count=", Length[prevSequences]]; ]; ]]
BitSequence[5][178]
(* Ethan Ji, Nov 19 2024 *)