# Generalisation of a generating function

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, 0 <= v[] <= n, 0 <= v[] <= n,
0 <= v[] <= 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, 0 <= v[] <= n, 0 <= v[] <= n,
0 <= v[] <= n, 0 <= v[] <= 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[] 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}}


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}, ConstantArray[Range[n+1], n-1], {Range}] - 1],
Total
]


A comparison with the accepted answer:

r1 = tups; //AbsoluteTiming
r2 = gen; //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; //AbsoluteTiming
r2 = gen; //AbsoluteTiming

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


{0.195056, Null}

{29.7257, Null}

True

Original method

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


For $$n=3$$:

sums[]


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

And a couple checks:

Length /@ sums
Length /@ sums


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

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

• Thanks Carl, while it produces the correct answer, I need the elements to be in right place, as I will use them later as a list for other computation, If you try sums[] you'd see the first element is not right, {0, 0, 0, 2} the first and last element of this must be 0 or 1, so the only way to assign 2 is {0, 2, 0, 0} and {0,0,2,0} to produce the sum of 2 without violating the constraints. This was happening at kglr's answer. Sep 21, 2018 at 15:31
• @William I modified the code as requested. Note that my answer is over an order of magnitude faster than the accepted answer. Sep 21, 2018 at 15:46
• Yes, this is much nicer for the task at hand (and I for one upvoted). Sep 21, 2018 at 15:49
• @CarlWoll & Daniel I have changed my acceptation. due to timing. Thanks again. Sep 21, 2018 at 16:01

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}] /.
coeffs = GroebnerBasisDistributedTermsList[genFunc, t][];
Map[{#[[1, 1]],
GroebnerBasisDistributedTermsList[#[], vars][[1, All, 1]]} &,
coeffs]
]


Example:

gen

(* Out= {{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.

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.

• Yes this is wrong. As I said I need to know the possible sum. The table there gives me all the possible sums but yours does not. Sep 21, 2018 at 13:59