# Constructing possibilities of a generating function

I want to find all the possible ways that 4 variables can be summed to a given number. Suppose I have the variables $$x=x_0+x_1+x_2+x_3$$ I want to fill $$x_0,x_1,x_2$$ and $$x_3$$ such that $$x_0$$ and $$x_3$$ can be zero or 1 and $$x_1$$ and $$x_2$$ can be equal or between 0 to 3. For example if I ask $$x=3$$ there will be following possibilities: $$1+1+1+0$$ $$1+1+0+1$$ $$1+0+1+1$$ $$0+1+1+1$$ $$1+2+0+0$$ $$1+0+2+0$$ $$0+2+0+1$$ $$0+0+2+1$$ $$0+2+1+0$$ $$0+1+2+0$$ $$0+3+0+0$$ $$0+0+3+0$$ How can I generate these possibilities in Mathematica. Also what if I have more variables for example: $$x_0+x_1+x_2+x_3+x_4$$ and so on?

Update: In fact this problem is coming from the following generating function: $$1 + 4 x + 8 x^2 + 12 x^3 + 14 x^4 + 12 x^5 + 8 x^6 + 4 x^7 + x^8$$ the coefficients are the possible ways of forming the sum. For instance if we want to make the sum to be equal to 3 then there are 12 possible ways of assigning numbers and so on and so forth. Thus it is important to have that $$x_0$$ and $$x_4$$ must be 0 or 1, and $$x_2$$ and $$x_3$$ must strictly be between zero and 3. So for instance to make the sum equal to 5 one can not have 0+5+0+0 as it is not allowed.

• Could do: In:= Sum[x0^j, {j, 0, 1}]*Sum[x1^j, {j, 0, 3}]* Sum[x2^j, {j, 0, 3}]*Sum[x3^j, {j, 0, 1}] Out= (1 + x0) (1 + x1 + x1^2 + x1^3) (1 + x2 + x2^2 + x2^3) (1 + x3) Not too hard to automate. – Daniel Lichtblau Sep 20 '18 at 19:14

Update 2: You can also use Array as follows:

Flatten@Array[If[Plus[##] == 3, HoldForm[Plus[##]], ## &[]] &, {2, 4, 4, 2}, 0]


{0+0+2+1, 0+0+3+0, 0+1+1+1, 0+1+2+0, 0+2+0+1, 0+2+1+0, 0+3+0+0, 1+0+1+1, 1+0+2+0, 1+1+0+1, 1+1+1+0, 1+2+0+0}

Update: You can use Solve:

n = 4;
t = 3;
v = Array[x, n, 0];
eqn = Total[v] == t;
constraints = And[0 <= v[] <= 1, 0 <= v[]<=3, 0 <= v[] <= 3,  0 <= v[] <= 1];
v /. Solve[{eqn, constraints}, v, Integers]


{{0, 0, 2, 1}, {0, 0, 3, 0}, {0, 1, 1, 1}, {0, 1, 2, 0}, {0, 2, 0, 1}, {0, 2, 1, 0}, {0, 3, 0, 0}, {1, 0, 1, 1}, {1, 0, 2, 0}, {1, 1, 0, 1}, {1, 1, 1, 0}, {1, 2, 0, 0}}

Inactive[Plus] @@@ soln // Column You can use Outer or Tuples as follows:

l0 = l3 = Range[0, 1];
l1 = l2 = Range[0, 3];

res1 = Flatten@Outer[Inactive[Plus], l0, l1, l2, l3];
res2 = Tuples[Inactive[Plus][l0, l1, l2, l3]];

res1 == res2


True

Select[res1, Activate[#]==3&] // Column • +1 I think he meant you need also Select[Tuples[...], Total[#] == 3 &] for his case :-) – Vitaliy Kaurov Sep 20 '18 at 15:55
• Thank you @Vitaliy. Missed that part:) – kglr Sep 20 '18 at 15:57
• @kglr Thanks for this but I wanted the first and last integers to be strictly 1 and 0. – Wiliam Sep 21 '18 at 11:21
• @William, missed that part too:) Fixed now. – kglr Sep 21 '18 at 12:51
• William, fixed that too. – kglr Sep 21 '18 at 13:08
partition[total_, nVar_] :=
Flatten[Permutations /@ (PadRight[#, nVar] & /@
IntegerPartitions[total]), 1]

part = Select[
partition[3,
4], (#[] == 0 || #[] == 1) && (#[] == 0 || #[] == 1) &]

(* {{0, 3, 0, 0}, {0, 0, 3, 0}, {1, 2, 0, 0}, {1, 0, 2, 0}, {0, 2, 1,
0}, {0, 2, 0, 1}, {0, 1, 2, 0}, {0, 0, 2, 1}, {1, 1, 1, 0}, {1, 1,
0, 1}, {1, 0, 1, 1}, {0, 1, 1, 1}} *)

Column[StringJoin /@ (Riffle[#, "+"] & /@ part /.
n_Integer :> ToString[n])] EDIT: Corrected definition of partition to cover cases when total > nVar

partition[total_, nVar_] :=
Select[Flatten[
Permutations /@ (PadRight[#, nVar] & /@ IntegerPartitions[total]), 1],
Total[#] == total &]

part = Select[
partition[5,
4], (#[] == 0 || #[] == 1) && (#[] == 0 || #[] == 1) &&
Max[#] <= 3 &]

(* {{0, 3, 2, 0}, {0, 2, 3, 0}, {1, 3, 1, 0}, {1, 3, 0, 1}, {1, 1, 3, 0}, {1, 0,
3, 1}, {0, 3, 1, 1}, {0, 1, 3, 1}, {1, 2, 2, 0}, {0, 2, 2, 1}, {1, 2, 1,
1}, {1, 1, 2, 1}} *)

• @kglr - Thanks, corrected error – Bob Hanlon Sep 20 '18 at 16:31
• Thanks for this answer, this is almost what I am looking for, just a further question, if I write: part = Select[ partition[5, 4], (#[] == 0 || #[] == 1) && (#[] == 0 || #[] == 1) &] I get the following list: {{0, 5, 0, 0}, {0, 0, 5, 0}, {1, 4, 0, 0}, {1, 0, 4, 0}, {0, 4, 1, 0}, {0, 4, 0, 1}, {0, 1, 4, 0}, {0, 0, 4, 1}, {0, 3, 2, 0}, {0, 2, 3, 0}, {1, 3, 1, 0}, {1, 3, 0, 1}, {1, 1, 3, 0}, {1, 0, 3, 1}, {0, 3, 1, 1}, {0, 1, 3, 1}, {1, 2, 2, 0}, {0, 2, 2, 1}, {1, 2, 1, 1}, {1, 1, 2, 1}, {1, 1, 1, 1}} where the first 8 elements are redundant. – Wiliam Sep 21 '18 at 11:02
• as x_2, and x_3 shall be between 0 to 3 only. How can I fix this? – Wiliam Sep 21 '18 at 11:03
• also in this case that I specified, there is a term {1,1,1,1} that is not giving the sum equal to 5 and thus the codes breaks at higher orders. – Wiliam Sep 21 '18 at 12:06

Here is a variation of my answer to the linked question that is much faster than the accepted answer here:

tups[n_, k_] := With[{tuples = Tuples[Join[{Range},ConstantArray[Range[n+1],n-1],{Range}]-1]},
Pick[tuples, Total[tuples, {2}], k]
]


Check:

tups[3,3]


{{0, 0, 2, 1}, {0, 0, 3, 0}, {0, 1, 1, 1}, {0, 1, 2, 0}, {0, 2, 0, 1}, {0, 2, 1, 0}, {0, 3, 0, 0}, {1, 0, 1, 1}, {1, 0, 2, 0}, {1, 1, 0, 1}, {1, 1, 1, 0}, {1, 2, 0, 0}}

Comparison:

r1 = tups[6, 4]; //AbsoluteTiming
r2 = Flatten@Array[If[Plus[##] == 4, HoldForm[Plus[##]], ## &[]] &, {2, 7, 7, 7, 7, 7, 2}, 0]; //AbsoluteTiming

r1 === Replace[r2, HoldForm[Plus[x__]] -> {x}, {1}]


{0.002733, Null}

{0.159457, Null}

True