Generalisation of a generating function

Question

I have asked a question here. I want to reproduce the coefficients of a generating function of the form: $$(1 + x)^2 (1 + x + x^2 + x^3+\cdots+x^n)^{n-1}$$ It is important that $x_0$ and $x_n$ to be strictly 0 or 1 and $x_1$ to $x_2$ can be any number within 0 and n (nothing higher). Here are two examples: For $n=3$ we have:

In: (1 + x)^2 (1 + x + x^2 + x^3)^2 // Expand
Out: 1 + 4 x + 8 x^2 + 12 x^3 + 14 x^4 + 12 x^5 + 8 x^6 + 4 x^7 + x^8

We can produce the coefficients as:

n = 3;
m = n + 1;
tabel = Table[
v = Array[x, m, 0];
eqn = Total[v] == t;
constraints = 
And[0 <= v[[1]] <= 1, 0 <= v[[2]] <= n, 0 <= v[[3]] <= n, 
 0 <= v[[4]] <= 1];
v /. Solve[{eqn, constraints}, v, Integers], {t, 0, 8}];
Table[Length[tabel[[i]]], {i, Length[tabel]}]

which gives:

{1, 4, 8, 12, 14, 12, 8, 4, 1}

as desired. For $n=4$ one had to add extra constraint and change the $t$ range. We have:

In: (1 + x)^2 (1 + x + x^2 + x^3 + x^4)^3 // Expand
Out: 1 + 5 x + 13 x^2 + 25 x^3 + 41 x^4 + 58 x^5 + 70 x^6 + 74 x^7 + 
70 x^8 + 58 x^9 + 41 x^10 + 25 x^11 + 13 x^12 + 5 x^13 + x^14

thus $t$ should be from 0 to 14, so we have:

n = 4;
m = n + 1;
tabel = Table[
v = Array[x, m, 0];
eqn = Total[v] == t;
constraints = 
And[0 <= v[[1]] <= 1, 0 <= v[[2]] <= n, 0 <= v[[3]] <= n, 
 0 <= v[[4]] <= n, 0 <= v[[5]] <= 1];
v /. Solve[{eqn, constraints}, v, Integers], {t, 0, 14}];
Table[Length[tabel[[i]]], {i, Length[tabel]}]

I wonder if these modifications can be done automatically so that one doesn't have to add a constraint by hand and change the range.

Note: I want the output table to be in a format so that I can see all of the possibilities of the sums. For instance, for n=3, table[[2]] should give all of the possibilities such that the total is equal to 1.

{{0, 0, 0, 1}, {0, 0, 1, 0}, {0, 1, 0, 0}, {1, 0, 0, 0}}

Answer 1

Update

An even faster method (I also modified the order of each possibility as requested in the comments):

tups[n_] := Values @ GroupBy[
    Tuples[Join[{Range[2]}, ConstantArray[Range[n+1], n-1], {Range[2]}] - 1],
    Total
]

A comparison with the accepted answer:

r1 = tups[3]; //AbsoluteTiming
r2 = gen[3]; //AbsoluteTiming

Sort /@ r1 === Sort /@ Reverse @ r2[[All, 2]]

{0.000123, Null}

{0.001075, Null}

True

Almost an order of magnitude faster for $n=3$. For $n=7$:

r1 = tups[7]; //AbsoluteTiming
r2 = gen[7]; //AbsoluteTiming

Sort /@ r1 === Sort /@ Reverse @ r2[[All, 2]]

{0.195056, Null}

{29.7257, Null}

True

Original method

Here's a modification of @kglr's answer to your linked question:

sums[n_]:= Last @ Reap[
    Array[Sow[{##}, Plus[##]]&, Join[{2}, ConstantArray[n+1, n-1], {2}], 0],
    _,
    #2&
]

For $n=3$:

sums[3][[2]]

{{0, 0, 0, 1}, {0, 0, 1, 0}, {0, 1, 0, 0}, {1, 0, 0, 0}}

And a couple checks:

Length /@ sums[3]
Length /@ sums[4]

{1, 4, 8, 12, 14, 12, 8, 4, 1}

{1, 5, 13, 25, 41, 58, 70, 74, 70, 58, 41, 25, 13, 5, 1}

Answer 2

One can automate the generating construction readily enough using Product and Sum. Getting total degrees and then the subsets of balues that give them is a bit more work. I show one method below.

gen[n_] := Module[
  {vars, x, t, genFunc, coeffs},
  vars = Array[x, n + 1, 0];
  genFunc = (1 + First[vars])*(1 + Last[vars])*
     Product[Sum[vars[[j]]^k, {k, 0, n}], {j, 2, n}] /. 
    Thread[vars -> t*vars];
  coeffs = GroebnerBasis`DistributedTermsList[genFunc, t][[1]];
  Map[{#[[1, 1]], 
     GroebnerBasis`DistributedTermsList[#[[2]], vars][[1, All, 1]]} &,
    coeffs]
  ]

Example:

gen[3]

(* Out[59]= {{8, {{1, 3, 3, 1}}}, {7, {{1, 3, 3, 0}, {1, 3, 2, 1}, {1, 2,
     3, 1}, {0, 3, 3, 1}}}, {6, {{1, 3, 2, 0}, {1, 3, 1, 1}, {1, 2, 3,
     0}, {1, 2, 2, 1}, {1, 1, 3, 1}, {0, 3, 3, 0}, {0, 3, 2, 1}, {0, 
    2, 3, 1}}}, {5, {{1, 3, 1, 0}, {1, 3, 0, 1}, {1, 2, 2, 0}, {1, 2, 
    1, 1}, {1, 1, 3, 0}, {1, 1, 2, 1}, {1, 0, 3, 1}, {0, 3, 2, 0}, {0,
     3, 1, 1}, {0, 2, 3, 0}, {0, 2, 2, 1}, {0, 1, 3, 1}}}, {4, {{1, 3,
     0, 0}, {1, 2, 1, 0}, {1, 2, 0, 1}, {1, 1, 2, 0}, {1, 1, 1, 
    1}, {1, 0, 3, 0}, {1, 0, 2, 1}, {0, 3, 1, 0}, {0, 3, 0, 1}, {0, 2,
     2, 0}, {0, 2, 1, 1}, {0, 1, 3, 0}, {0, 1, 2, 1}, {0, 0, 3, 
    1}}}, {3, {{1, 2, 0, 0}, {1, 1, 1, 0}, {1, 1, 0, 1}, {1, 0, 2, 
    0}, {1, 0, 1, 1}, {0, 3, 0, 0}, {0, 2, 1, 0}, {0, 2, 0, 1}, {0, 1,
     2, 0}, {0, 1, 1, 1}, {0, 0, 3, 0}, {0, 0, 2, 1}}}, {2, {{1, 1, 0,
     0}, {1, 0, 1, 0}, {1, 0, 0, 1}, {0, 2, 0, 0}, {0, 1, 1, 0}, {0, 
    1, 0, 1}, {0, 0, 2, 0}, {0, 0, 1, 1}}}, {1, {{1, 0, 0, 0}, {0, 1, 
    0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}}}, {0, {{0, 0, 0, 0}}}} *)

Looks spiffier if one uses TableForm or similar.

Answer 3

Perhaps I didn't understand your question, but

Table[ CoefficientList[(1 + x)^2 (Sum[x^i, {i, 0, n}])^(n - 1),x] , {n, 1, 5}]

evaluates the list of coefficients you're looking for.