# How to find the integer solution number of a linear system with inequalities?

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))

• FindInstance[eqn, {n1, n2, n3, n4, n5, n6}, Integers, 10] will give you the first ten sols, but there are more ... Aug 24, 2014 at 4:14
• 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. Aug 24, 2014 at 9:28

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"}}] &


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"}}] &


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}

• Thank you! Where can I 学到 learn such insights in using Mathematica this way? It seems the online documents of Wolfram have no such contents. Aug 25, 2014 at 5:00
• 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? Aug 25, 2014 at 5:24
• +1 for a great answer and your first Enlightened badge. :-) Aug 29, 2014 at 12:06