|
MATHEMATICA
|
b[n_, l_] := b[n, l] = Module[{d, f, g, k}, d = Length[l]/3; f = False; Which[n == 0, 1, l[[1 ;; d]] == Array[f &, d], b[n - 1, Join[l[[d + 1 ;; 3*d]], Array[True &, d]]], True, For[k = 1, ! l[[k]], k++]; g = ReplacePart[l, k -> f];
If[k > 1, g = ReplacePart[g, 2*d - 1 + k -> f]];
If[k < d, g = ReplacePart[g, 2*d + 1 + k -> f]];
If[k > 2, g = ReplacePart[g, d - 2 + k -> f]];
If[k < d - 1, g = ReplacePart[g, d + 2 + k -> f]];
Expand[b[n, ReplacePart[l, k -> f]] + b[n, g]*x]]];
a[n_] := Function[p, Sum[Coefficient[p, x, i], {i, 0, Exponent[p, x]}]][ b[n, Array[True &, n*3]]];
|