0
$\begingroup$

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?

$\endgroup$
5
$\begingroup$

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[40];// AbsoluteTiming
fs[40];// AbsoluteTiming
Sort[(Sort /@ fa[40])] == Sort[(Sort /@ fs[40])]

{0.234222, Null}

{0.00182044, Null}

True

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

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]]
$\endgroup$
  • $\begingroup$ Excellent. Thanks! $\endgroup$ – oscarafone Sep 25 '17 at 19:22
  • 1
    $\begingroup$ And @@ Thread[-n <= {w, x, y, z} <= n] && w <= x <= y <= z -> -n <= w <= x <= y <= z <= n $\endgroup$ – jiaoeyushushu Sep 26 '17 at 1:06
  • $\begingroup$ @jiaoeyushushu - Thanks. Edited. $\endgroup$ – Bob Hanlon Sep 26 '17 at 2:09
1
$\begingroup$
  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[28]; // AbsoluteTiming          
fbob[28]; // AbsoluteTiming
galucard[28]; // AbsoluteTiming

galucard[3]*(-1) == fs[3] == fbob[3]*(-1)

{0.000673695,Null}

{0.110799,Null}

{0.0617464,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.