login
Number of maximal cubefree binary words of length n.
5

%I #35 Nov 21 2024 05:16:07

%S 0,0,0,0,0,0,0,2,0,0,2,2,4,10,12,14,28,38,56,84,124,184,264,374,544,

%T 836,1190,1746,2544,3712,5410,7890,11470,16666,24436,35574,51892,

%U 75552,110124,160624,234162,341178,497058,725026,1056630,1540158,2244566,3271600

%N Number of maximal cubefree binary words of length n.

%C A word is cubefree if it has no block within it of the form xxx, where x is any nonempty block. A cubefree word w is maximal if it cannot be extended to the right (i.e., both w0 and w1 end in cubes).

%C It appears that a(n) ~ A028445(n-11). - _M. F. Hasler_, May 05 2017

%H Lars Blomberg, <a href="/A282133/b282133.txt">Table of n, a(n) for n = 1..59</a>

%e For n = 8, the two maximal cubefree words of length 8 are 00100100 and its complement 11011011.

%e The first few maximal cubefree words beginning with 1 are:

%e [1, 1, 0, 1, 1, 0, 1, 1],

%e [1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0],

%e [1, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1],

%e [1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0],

%e [1, 1, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1],

%e [1, 0, 0, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0],

%e [1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0],

%e [1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1],

%e [1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 1],

%e [1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0].

%e For those beginning with 0, take the complements. - _N. J. A. Sloane_, May 05 2017

%p # Maple code adapted from that in A286262 by _N. J. A. Sloane_, May 05 2017

%p isCubeFree:=proc(v) local n,L;

%p for n from 3 to nops(v) do for L to n/3 do

%p if v[n-L*2+1 .. n] = v[n-L*3+1 .. n-L] then RETURN(false) fi od od; true end;

%p A282133:=proc(n) local s,m;

%p s:=0;

%p for m from 2^(n-1) to 2^n-1 do

%p if isCubeFree(convert(m,base,2)) then

%p if (not isCubeFree(convert(2*m,base,2))) and

%p (not isCubeFree(convert(2*m+1,base,2))) then

%p s:=s+2; fi;

%p fi;

%p od; s; end;

%p [seq(A282133(n),n=0..18)];

%t CubeFreeQ[v_List] := Module[{n, L}, For[n = 3, n <= Length[v], n++, For[L = 1, L <= n/3, L++, If[v[[n - L*2 + 1 ;; n]] == v[[n - L*3 + 1 ;; n - L]], Return[False]]]]; True];

%t a[n_] := a[n] = Module[{s, m}, s = 0; For[m = 2^(n - 1), m <= 2^n - 1, m++, If[CubeFreeQ[IntegerDigits[m, 2]], If[!CubeFreeQ[IntegerDigits[2*m, 2]] && !CubeFreeQ[IntegerDigits[2*m + 1, 2]], s += 2]]]; s];

%t Table[Print[n, " ", a[n]]; a[n], {n, 0, 25}] (* _Jean-François Alcover_, Mar 08 2023, after Maple code *)

%o (Python)

%o def icf(s): # incrementally cubefree

%o for l in range(1, len(s)//3 + 1):

%o if s[-3*l:-2*l] == s[-2*l:-l] == s[-l:]: return False

%o return True

%o def aupton(nn, verbose=False):

%o alst, cfs = [], set("0")

%o for n in range(1, nn+1):

%o cfsnew = set()

%o an = 0

%o for c in cfs:

%o maximal = True

%o for i in "01":

%o if icf(c+i):

%o cfsnew.add(c+i)

%o maximal = False

%o if maximal: an += 2

%o alst, cfs = alst+[an], cfsnew

%o if verbose: print(n, an)

%o return alst

%o print(aupton(30)) # _Michael S. Branicky_, Mar 18 2022

%Y Cf. A028445, A282317.

%Y For these numbers halved, see A286270.

%K nonn,changed

%O 1,8

%A _Jeffrey Shallit_, Feb 06 2017

%E a(36)-a(48) from _Lars Blomberg_, Feb 09 2019