# Finding unique solutions to $w+x + y + z + w = 0$, faster

Using Solve, I can find the solutions to $$w + x + y + z = 0.$$ where $(w,x,y,z)$ are all integers between $-n$ and $n$.

This gives me all solutions, including ones which are identical up to permutation, i.e. $(1,0,1,-2)$ and $(0,1,-2,1)$. But I would like to consider these both to be the same solution.

Using DeleteDuplicates it's easy enough to get the unique solutions (up to permutations), but both of these steps use up much more time than just generating non-duplicate solutions in the first place.

My questions is: is there a way to generate non-duplicate solutions, and efficiently?

A much faster approach using IntegerPartitions

fs[n_]:=IntegerPartitions[0, {4}, Range[-n, n]];


For n=3

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

Timing comparison:

fa[n_] := {w, x, y, z} /.
Solve[w + x + y + z == 0 && LessEqual @@ {-n, w, x, y, z, n}, {w, x,
y, z}, Integers] (*Bob's solution *)

fa;// AbsoluteTiming
fs;// AbsoluteTiming
Sort[(Sort /@ fa)] == Sort[(Sort /@ fs)]


{0.234222, Null}

{0.00182044, Null}

True

• Beat me to it. This is the way to do it +1 – ciao Sep 26 '17 at 5:10

To avoid duplicates order the variables, i.e., w <= x <= y <= z

With[{n = 3},
{w, x, y, z} /.
Solve[w + x + y + z == 0 &&
And @@ Thread[-n <= {w, x, y, z} <= n] &&
w <= x <= y <= z, {w, x, y, z}, Integers]]

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


EDIT: As suggested by jiaoeyushushu this can be written more succinctly as

With[{n = 3}, {w, x, y, z} /.
Solve[w + x + y + z == 0 && LessEqual @@ {-n, w, x, y, z, n}, {w, x, y, z},
Integers]]

• Excellent. Thanks! – oscarafone Sep 25 '17 at 19:22
• And @@ Thread[-n <= {w, x, y, z} <= n] && w <= x <= y <= z -> -n <= w <= x <= y <= z <= n – jiaoeyushushu Sep 26 '17 at 1:06
• @jiaoeyushushu - Thanks. Edited. – Bob Hanlon Sep 26 '17 at 2:09
  falucard[n_] := Reduce[ w + x + y + z == 0   && LessEqual @@ {-n, w, x, y, z, n} , {w, x, y, z}, Integers];
galucard[n_] :=  Apply[List, falucard[n][[All, All, 2]], {0, 1}]

fs; // AbsoluteTiming
fbob; // AbsoluteTiming
galucard; // AbsoluteTiming

galucard*(-1) == fs == fbob*(-1)


{0.000673695,Null}

{0.110799,Null}

{0.0617464,Null}

True