A378196 Number of 2-colorings of length n without an arithmetic progression of length 4.

1, 2, 4, 8, 14, 26, 48, 78, 132, 230, 356, 548, 842, 1078, 1344, 1764, 1744, 1850, 1948, 1708, 1442, 1342, 1032, 702, 524, 316, 168, 136, 136, 144, 152, 160, 168, 176, 28, 0

Offset: 0

Author

Ethan Ji, Nov 19 2024

Keywords

• nonn

Comments

After 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.

Crossrefs

First 0 index given by A005346.

Cf. A378195, A378197.

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[4][35]
(* Ethan Ji, Nov 19 2024 *)