|
%I #27 Jul 19 2023 19:20:35
%S 1,1,3,10,21,57,182,426,1167,3679,8991,24873,77492,194449,541194,
%T 1670783,4267991,11926782,36559601,94604822,265135713,808106960,
%U 2111760491,5931204471,17993213402,47385794268,133315710843,402849979395,1067608305030,3007697623335
%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 bba.
%H Alois P. Heinz, <a href="/A204340/b204340.txt">Table of n, a(n) for n = 0..500</a>
%e For n=1 the a(1)=1 solution is: a
%e For n=2 the a(2)=3 solutions are: aa,ab,ba
%e For n=3 the a(3)=10 solutions are: aaa,aab,aba,abc,acb,baa,bac,bca,cab,cba
%p makebbaavoiders := proc (n) local out, tout, i;
%p if n = 0 then return [[]] end if;
%p tout := makebbaavoiders(n-1);
%p out := [];
%p for i to nops(tout) do
%p if 2 <= nops(tout[i]) and tout[i][-1] = 1 and tout[i][-2] = 1 then
%p out := [op(out), [op(tout[i]), 1], [op(tout[i]), 2]]
%p else
%p out := [op(out), [op(tout[i]), 0], [op(tout[i]), 1], [op(tout[i]), 2]]
%p end if end do;
%p return out;
%p end proc;
%p count := proc (lst, val)
%p return nops(select(proc (x) options operator, arrow; x = val end proc, lst))
%p end proc;
%p nops(select(proc (w) options operator, arrow; count(w, 2) <= count(w,1) end proc, select(proc (w) options operator, arrow; count(w, 1) <=count(w, 0) end proc, makebbaavoiders(7))));
%p # second Maple program:
%p a:= n-> add(add(add(w(na, nb, n-na-nb, t), t=0..2),
%p nb=ceil((n-na)/2)..na), na=ceil(n/3)..n):
%p w:= proc(a, b, c, t) option remember;
%p `if`(a=0 and b=0 and c=0, `if`(t=0, 1, 0),
%p `if`(a<0 or b<0 or c<0, 0, `if`(t=0, w(a-1, b, c, 0)+
%p w(a-1, b, c, 1) +w(a, b, c-1, 0) +w(a, b, c-1, 1)+
%p w(a, b, c-1, 2), `if`(t=1, w(a, b-1, c, 0),
%p w(a, b-1, c, 1) +w(a, b-1, c, 2)))))
%p end:
%p seq(a(n), n=0..40); # _Alois P. Heinz_, May 07 2012
%t a[n_] := Sum[Sum[Sum[w[na, nb, n-na-nb, t], {t, 0, 2}], {nb, Ceiling[(n-na)/2], na}], {na, Ceiling[n/3], n}];
%t w[a_, b_, c_, t_] := w[a, b, c, t] =
%t If[a == 0 && b == 0 && c == 0, If[t == 0, 1, 0],
%t If[a < 0 || b < 0 || c < 0, 0, If[t == 0, w[a - 1, b, c, 0] +
%t w[a - 1, b, c, 1] + w[a, b, c - 1, 0] + w[a, b, c - 1, 1] +
%t w[a, b, c - 1, 2], If[t == 1, w[a, b - 1, c, 0],
%t w[a, b - 1, c, 1] + w[a, b - 1, c, 2]]]]];
%t a /@ Range[0, 40] (* _Jean-François Alcover_, Nov 20 2020, after _Alois P. Heinz_ *)
%Y Cf. A174982.
%K nonn
%O 0,3
%A _Jeff McManus_, Jan 14 2012
%E a(1)-a(13) confirmed and a(14) added by _John W. Layman_, Jan 18 2012
%E a(0) inserted and extended beyond a(14) by _Alois P. Heinz_, May 07 2012
|
