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

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

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 *)

Crossrefs

First 0 index given by A005346.

Cf. A378195, A378196.

Sequence in context: A027559 A344614 A337664 * A135492 A164191 A164193

Adjacent sequences: A378192 A378195 A378196 * A378198 A378199 A378200

Keyword

nonn

Author

Ethan Ji, Nov 19 2024

Status

approved