5
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ Could do: In[23]:= 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[23]= (1 + x0) (1 + x1 + x1^2 + x1^3) (1 + x2 + x2^2 + x2^3) (1 + x3) Not too hard to automate. $\endgroup$ – Daniel Lichtblau Sep 20 '18 at 19:14
6
$\begingroup$

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]] <= 1, 0 <= v[[2]]<=3, 0 <= v[[3]] <= 3,  0 <= v[[4]] <= 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

enter image description here

Original answer:

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

enter image description here

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

part = Select[
  partition[3, 
   4], (#[[1]] == 0 || #[[1]] == 1) && (#[[4]] == 0 || #[[4]] == 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])]

enter image description here

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], (#[[1]] == 0 || #[[1]] == 1) && (#[[4]] == 0 || #[[4]] == 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}} *)
$\endgroup$
  • $\begingroup$ @kglr - Thanks, corrected error $\endgroup$ – Bob Hanlon Sep 20 '18 at 16:31
  • $\begingroup$ Thanks for this answer, this is almost what I am looking for, just a further question, if I write: part = Select[ partition[5, 4], (#[[1]] == 0 || #[[1]] == 1) && (#[[4]] == 0 || #[[4]] == 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. $\endgroup$ – William Sep 21 '18 at 11:02
  • $\begingroup$ as x_2, and x_3 shall be between 0 to 3 only. How can I fix this? $\endgroup$ – William Sep 21 '18 at 11:03
  • $\begingroup$ 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. $\endgroup$ – William Sep 21 '18 at 12:06
1
$\begingroup$

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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.