4
$\begingroup$

I have the following system with mixed equality and inequalities defined as:

n = 100;
eqn = (n1 + n3 + n5 == n2 + n4 + n6) && (n1 >= 
    n2) && (n1 - n2 + n3 - n4 >= 0) && (n1 <= n) && (n1 - n2 + n3 <= 
    n) && (n1 - n2 + n3 - n4 + n5 <= n) && (2 n <= 
    n1 + n2 + n3 + n4 + n5 + n6 <= 6 n) && (n1 > 0) && (n2 > 0) && (n3 > 0) && (n4 > 0) && (n5 > 0) && (n6 > 0);

How can I find all the integer solutions and especially the number of all integer solutions?

It seems Reduce or Solve does not work:

sol = Reduce[eqn, {n1, n2, n3, n4, n5, n6}, Integers]

produces:

  (n1 | n2 | n3 | n4 | n5 | n6) \[Element] 
  Integers && ((1 <= n1 <= 99 && 
     0 < n2 <= 
      n1 && ((0 < n3 < 100 - n1 && 0 < n4 <= n1 - n2 + n3 && 
         100 - n1 - n3 <= n5 <= 100 - n1 + n2 - n3 + n4 && 
         n6 == n1 - n2 + n3 - n4 + n5) || (100 - n1 <= n3 <= 
          100 - n1 + n2 && 0 < n4 <= n1 - n2 + n3 && 
         0 < n5 <= 100 - n1 + n2 - n3 + n4 && 
         n6 == n1 - n2 + n3 - n4 + n5))) || (n1 == 100 && 
     1 <= n2 <= 100 && 0 < n3 <= n2 && 0 < n4 <= 100 - n2 + n3 && 
     0 < n5 <= n2 - n3 + n4 && n6 == 100 - n2 + n3 - n4 + n5))
$\endgroup$
2
  • 1
    $\begingroup$ FindInstance[eqn, {n1, n2, n3, n4, n5, n6}, Integers, 10] will give you the first ten sols, but there are more ... $\endgroup$ Aug 24, 2014 at 4:14
  • $\begingroup$ I tried FIndInstance by setting the number 10 as 10,000 instead; it has more than 10,000 solutions! The computation is very slow and has a very high demand on memory. $\endgroup$ Aug 24, 2014 at 9:28

1 Answer 1

10
$\begingroup$
SetSystemOptions[
  "ReduceOptions" -> {"DiscreteSolutionBound" -> 10000000}];
f[n_] := Module[{eqn},
  eqn = (n1 + n3 + n5 == n2 + n4 + n6) && (n1 >= 
      n2) && (n1 - n2 + n3 - n4 >= 0) && (n1 <= n) && (n1 - n2 + n3 <=
       n) && (n1 - n2 + n3 - n4 + n5 <= n) && (2 n <= 
      n1 + n2 + n3 + n4 + n5 + n6 <= 6 n) && (n1 > 0) && (n2 > 
      0) && (n3 > 0) && (n4 > 0) && (n5 > 0) && (n6 > 0);
  Length@Reduce[eqn, {n1, n2, n3, n4, n5, n6}, Integers]]
Flatten[{#, Timing[f@#]}] & /@ Range[5, 15] // 
    TableForm[#, TableHeadings -> {None, {"n", "timing", "numbers"}}] &

enter image description here

Edit: First

Reduce[n1 <= n, n1, Reals]

n1 <= n

Reduce[n1 >= n2, n2, Reals]

n2 <= n1

Reduce[n1 - n2 + n3 <= n, n3, Reals]

n3 <= n - n1 + n2

Reduce[n1 - n2 + n3 - n4 >= 0, n4, Reals]

n4 <= n1 - n2 + n3

Reduce[n1 - n2 + n3 - n4 + n5 <= n, n5, Reals]

n5 <= n - n1 + n2 - n3 + n4

sol = Solve[n1 + n3 + n5 == n2 + n4 + n6, n6]
(2 n <= n1 + n2 + n3 + n4 + n5 + n6 <= 6 n) /. sol

{{n6 -> n1 - n2 + n3 - n4 + n5}}

{2 n <= 2 n1 + 2 n3 + 2 n5 <= 6 n}

Reduce[2 n <= 2 n1 + 2 n3 + 2 n5 <= 6 n && n > 0, n5, Reals]

n > 0 && n - n1 - n3 <= n5 <= 3 n - n1 - n3

Reduce[(n6 /. sol) > 0, n5, Reals]

n5 > -n1 + n2 - n3 + n4

So the range of n5 is:

Max[-n1 + n2 - n3 + n4 + 1, n - n1 - n3, 1]< n5 < Min[3 n - n1 - n3, n - n1 + n2 - n3 + n4]

g1 = Compile[{{n, _Integer}},
   Sum[1, {n1, n}, {n2, n1}, {n3, n - n1 + n2}, {n4, 
     n1 - n2 + n3}, {n5, Max[-n1 + n2 - n3 + n4 + 1, n - n1 - n3, 1], 
     Min[3 n - n1 - n3, n - n1 + n2 - n3 + n4]}], CompilationTarget -> "C"];
Flatten[{#, Timing[g1@#]}] & /@ Range[5, 15] // 
  TableForm[#, TableHeadings -> {None, {"n", "timing", "numbers"}}] &

enter image description here

g1[50] // AbsoluteTiming

{0.999057, 39324265}

g2 = Compile[{{n, _Integer}},
   Sum[Max[0, Min[3 n - n1 - n3, n - n1 + n2 - n3 + n4] - 
      Max[-n1 + n2 - n3 + n4 + 1, n - n1 - n3, 1] + 1], {n1, n}, {n2, 
     n1}, {n3, n - n1 + n2}, {n4, n1 - n2 + n3}], CompilationTarget -> "C"];
g2[50] // AbsoluteTiming
g2[100] // AbsoluteTiming

{0.248014, 39324265}

{3.890223, 1212505405}

$\endgroup$
3
  • $\begingroup$ Thank you! Where can I 学到 learn such insights in using Mathematica this way? It seems the online documents of Wolfram have no such contents. $\endgroup$ Aug 25, 2014 at 5:00
  • $\begingroup$ One possible issue is when $n$ increases, the memory demand becomes high quickly. If only solution number is required, can it be improved to be more efficient and less memory demanding? $\endgroup$ Aug 25, 2014 at 5:24
  • $\begingroup$ +1 for a great answer and your first Enlightened badge. :-) $\endgroup$
    – Mr.Wizard
    Aug 29, 2014 at 12:06

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.