|
%I #10 Mar 13 2022 09:50:17
%S 1,1,3,9,17,44,143,309,825,2641,6036,16310,51451,121475,330611,
%T 1031592,2489179,6806882,21058747,51618081,141626550,435164141,
%U 1079460430,2969133001,9071871281,22716623921,62604444233,190384667595,480402101159,1325982687892
%N The number of words of length n created with the letters a, b, c with at least as many a's as b's and at least as many b's as c's and no adjacent letters forming the pattern aba or bab.
%H Alois P. Heinz, <a href="/A176148/b176148.txt">Table of n, a(n) for n = 0..200</a>
%e For n = 0, there is the empty word. For n = 1, there is one word a. For n = 2, there are three words, aa, ab, ba. For n = 3, there are nine words, aaa, aab, baa, bac, cab, acb, cba, abc, bca.
%p makeabababavoiders:=proc( n ) local out,tout,i; if n=0 then return([]); end if; if n=1 then return([[0],[1],[2]]); end if; if n=2 then return([[0,0],[1,1], [2,2],[0,1],[1,0],[2,0],[0,2],[1,2],[2,1]]); end if; tout:=makeabababavoiders(n-1); out:=[]; for i from 1 to nops(tout) do if tout[ i ][ -1]=0 and tout[ i ][ -2]=1 then out:=[op(out),[op(tout[ i ]),0], [op(tout[ i ]),2]]; elif tout[ i ][ -1]=1 and tout[ i ][ -2]=0 then out:=[op(out),[op(tout[ i ]),1],[op(tout[ i ]),2]]; else out:= [op(out), [op(tout[ i ]),0],[op(tout[ i ]),1],[op(tout[ i ]),2]]; end if; end do; return(out); end: count:=proc( lst, val ); return nops(select(x-> x=val, lst)); end: nops(select(w->count(w,1)>=count(w,2), select(w-> count(w,0)>=count(w,1), makeabababavoiders(5))));
%p # second Maple program
%p a:= n-> add (add (w (na, nb, n-na-nb, 0, 0),
%p nb=ceil((n-na)/2)..min(n-na, na)), na=ceil(n/3)..n):
%p w:= proc(a, b, c, x, y) option remember;
%p `if`([a, b, c]=[0$3], 1, `if`(a>0 and x<2, w(a-1, b, c, 1,
%p `if`(y=1, 2, 0)), 0)+ `if`(b>0 and y<2, w(a, b-1, c,
%p `if`(x=1, 2, 0), 1), 0)+ `if`(c>0, w(a, b, c-1, 0, 0), 0))
%p end:
%p seq (a(n), n=0..40); # _Alois P. Heinz_, May 22 2012
%t a[n_] := Sum[Sum[w[na, nb, n - na - nb, 0, 0],
%t {nb, Ceiling[(n - na)/2], Min[n - na, na]}], {na, Ceiling[n/3], n}];
%t w[a_, b_, c_, x_, y_] := w[a, b, c, x, y] =
%t If[{a, b, c} == {0, 0, 0}, 1, If[a > 0 && x < 2, w[a - 1, b, c, 1,
%t If[y == 1, 2, 0]], 0] + If[b > 0 && y < 2, w[a, b - 1, c,
%t If[x == 1, 2, 0], 1], 0] + If[c > 0, w[a, b, c - 1, 0, 0], 0]];
%t Table[a[n], {n, 0, 40}] (* _Jean-François Alcover_, Mar 13 2022, after _Alois P. Heinz_ *)
%K nonn
%O 0,3
%A Ginger Moorey (gingermoorey(AT)hotmail.com), Apr 10 2010
%E Extended beyond a(11) by _Alois P. Heinz_, May 22 2012
|
