# Is there a relatively quick way to solve my integer-valued equation?

This is a very simple problem. It can be solved by nested Forloops that exhaustively test every possible case, throwing out all non-solutions.

Find all the distinct positive integer solutions $0<a_i \leqslant 100$, such that:

$$\sum\limits_{i=1}^{10}\dfrac{1}{a_i}=1$$

There are 69014 solutions in total. But it will take a long time to find them all by nested Forloops. Is there an efficient method for this problem, i.e, one that will find all the solutions in less than 20 minutes?

• This reminds me of my very first question on Stack Exchange: (5018252) – Mr.Wizard Aug 24 '14 at 7:15
• @ Mr. Wizard: how do you create a short cut reference to another problem, like (5018252) here? Thanks in advance for your help. – Dr. Wolfgang Hintze Aug 24 '14 at 8:11
• @Dr.WolfgangHintze I am using a modified version of this. – Mr.Wizard Aug 24 '14 at 8:46

Abstract

This is not exactly the requested solution, but it is parametrized, and I think it will give some insight and can possibly be improved.

With this code (modified 03.09.14 11:30) it is possible to determine all integer solutions to $1=\sum _{i=1}^n \frac{1}{a(i)}$ without the $a(i)$ being bounded by $amax$, by letting $amax=\infty$.

In this sense the code is complementary to the elegant solution of kirma which requires $amax$ to be given explicitly beforehand.

For $amax = 100$ the code runs in "reasonable" time (some minutes) up to $n = 8$. For $n = 9$ time and memory requirements explode.

For $amax=\infty$ the code runs in "reasonable" time (some seconds) up to $n = 6$. For $n = 7$ time and memory requirements explode.

1. Statement of the problem

calculate all solutions of the equation

$\sum _{i=1}^n \frac{1}{a(i)}$

under the conditions

$a(i)\in \mathbb{Z}$ and $0<a(1)<a(2)<...<a(n)\leq \text{amax}$

for $n=10$ and $amax=100$ in "reasonable" time (~ 20 Minutes) with Mathematica.

Although I didn't meet the goal with these parameters I have developed a code which works "in principle" and in reasonable time for "appropriate" parameters.

2. Reduction of possible values of $a(i)$

The main idea is to determine the range of the possible numbers $a(i)$.

Consider the explanatory example $n=4$ and $\text{amax}=\infty$ (i.e. no restriction)

Let us determine the interval of possible values for the first number a.

Because $b>a,c>a,d>a$ we have the inequality

$1=\frac{1}{a}+\frac{1}{b}+\frac{1}{c}+\frac{1}{d}<\frac{4}{a}$

or

$a < 4$

But

$1-\frac{1}{a}=\frac{1}{b}+\frac{1}{c}+\frac{1}{d}$

which is evidently $> 0$. Hence

$a > 1$

so that the range for a becomes

$a\in [2,3]$

In this first step we have thus obtained the following set of two partial solutions

v = {{2}, {3}}


Now we take the first partial solution {2} and calculate the possible range of the next element $b$.

We have with $a = 2$:

$1-\frac{1}{2}=\frac{1}{2}=\frac{1}{b}+\frac{1}{c}+\frac{1}{d}<\frac{3}{b}\to b<6$

and

$\frac{1}{2}-\frac{1}{b}>0\to b>2$

Hence

$b \in [3,4,5]$

and the set of partial solutions starting with 2 becomes

v22 = {{2,3}, {2,4}, {2,5}}


For $a = 3$ we find

$1-\frac{1}{3}=\frac{2}{3}<\frac{3}{b}\to b<\frac{9}{2}=4.5$

and

$\frac{2}{3}-\frac{1}{b}>0 \to b>\frac{3}{2} = 1.5$

or

$b \in [2,3,4]$

But $b$ must also be $> a (=3)$ hence only $b = 4$ remains, and the set of partial solutions starting with 3 is

v23 = {{3,4}}


The total set of partial solutions of length 2 is therefore

v = {{2,3}, {2,4}, {2,5}, {3,4}}


Now the same procedure for each of the four partial solutions

$\{2,3\}\to 1-\left(\frac{1}{2}+\frac{1}{3}\right)=\frac{1}{2}-\frac{1}{3}=\frac{1}{6}=\frac{1}{c}+\frac{1}{d}<\frac{2}{c}\to c<12$

and

$\frac{1}{6}-\frac{1}{c}>0\to c>6$

$\to c \in [7,8,9,10,11]$

v31 = {{2,3,7},{2,3,8},{2,3,9},{2,3,10},{2,3,11}}


$\{2,4\}\to 1-\left(\frac{1}{2}+\frac{1}{4}\right)=\frac{1}{4}=\frac{1}{c}+\frac{1}{d}<\frac{2}{c}\to c<8$

and

$c>4 \to c \in [5,6,7]$

v32 = {{2,4,5},{2,4,6},{2,4,7}}


$\{2,5\}\to 1-\left(\frac{1}{2}+\frac{1}{5}\right)=\frac{3}{10}=\frac{1}{c}+\frac{1}{d}<\frac{2}{c}\to c<\frac{20}{3}=6.666$

Because of $c > b (=5)$ we find $c = 6$, and

v33 = {{2,5,6}}


$\{3,4\}\to 1-\left(\frac{1}{3}+\frac{1}{4}\right)=\frac{5}{12}=\frac{1}{c}+\frac{1}{d}<\frac{2}{c}\to c<\frac{24}{5}=4.8\to c\leq 4$

but this contradicts the condition $c > b (=4)$. Hence there is no extension of the partial solution in this case. Collecting things gives for the partial solutions of length 3

v = {{2,3,7},{2,3,8},{2,3,9},{2,3,10},{2,3,11},{2,4,5},{2,4,6},{2,4,7},{2,5,6}}


Now the last step. Here we simply calculate d for each partial solution from

$\frac{1}{d}=1-\left(\frac{1}{a}+\frac{1}{b}+\frac{1}{c}\right)$

Using the function

is[x_] := Plus @@ (1/x)


we find

(1 - is[#]) & /@ {{2, 3, 7}, {2, 3, 8}, {2, 3, 9}, {2, 3, 10}, {2, 3, 11}, {2, 4, 5}, {2, 4, 6}, {2, 4, 7}, {2, 5, 6}}


$\left\{\frac{1}{42},\frac{1}{24},\frac{1}{18},\frac{1}{15},\frac{5}{66},\frac{1}{20},\frac{1}{12},\frac{3}{28},\frac{2}{15}\right\}$

We observe that there are cases in which the numerator is different from 1. These cases must be ruled out, of couse. This leaves us the 6 solutions for n = 4.

v = {{2, 3, 7, 42}, {2, 3, 8, 24}, {2, 3, 9, 18}, {2, 3, 10, 15}, {2, 4, 5,
20}, {2, 4, 6, 12}}


We could check the result using Reduce:

Reduce[1 == 1/a + 1/b + 1/c + 1/d && 0 < a < b < c < d, Integers]


(* (a == 2 && b == 3 && c == 7 && d == 42) || (a == 2 && b == 3 && c == 8 && d == 24) || (a == 2 && b == 3 && c == 9 && d == 18) || (a == 2 && b == 3 && c == 10 && d == 15) || (a == 2 && b == 4 && c == 5 && d == 20) || (a == 2 && b == 4 && c == 6 && d == 12) *)

We can improve the estimation and increase the lower bound by taking into account that condition $a <= amax$, Taking the example $n=4$ again, we have

$1-\frac{1}{a}=\frac{1}{b}+\frac{1}{c}+\frac{1}{d}$

But because $d <= amax$ the rhs. is $> \frac{3}{amax}$, resulting in $1-\frac{3}{\text{amax}}>\frac{1}{a}\to a>\frac{1}{1-\frac{3}{\text{amax}}}$

This again can be sharpened a bit using

$\frac{1}{\text{amax}}+\frac{1}{\text{amax}-1}+\frac{1}{\text{amax}-2}$

or, generally, the function

sm[n_, k_] := Sum[1/(amax - j), {j, 0, n - k - 1}]


This long example containes all ingredients of the code presented in the next section.

3. The code

The code is not particilarly elegant, and can be improved doublessly.

The solution vectors v[r] are global. I have also left the loop variable k global in order to display its values during the calculation using Dynamic.

First we dfine the two auxiliary functions introduced earlier:

is[x_] := Plus @@ (1/x)

sm[n_, k_] := Sum[1/(amax - j), {j, 0, n - k - 1}]


calcV6 is the main routine. It calculates the partial solution v[r] assuming the previous one, v[r-1], given.

The normal usage of calcV6 is therefore to execute the routine for $r = 2$ first, then for $r = 3$, and so on up to $r = n$.

The routine has some additional "security" measures not mentioned in the example but easily recognizable by the attentive reader.

calcV6[n_, r_] :=
Module[{rr, smr, ss, ss1, z, z1, ymin, ymax, u, us, us1},
If[amax < \[Infinity],
v = Table[{i}, {i, 2, Min[n - 1, amax]}],
v = Table[{i}, {i, 2, n - 1}]];
If[r == n, Goto[mrk]];
v0[r] = {};
If[amax < \[Infinity], smr = sm[n, r], smr = 0]; (* calcV6 *)
For[k = 1, k <= Length[v[r - 1]], k++,
x = v[r - 1][[k]];
ss1 = 1 - is[x];
If[ss1 > 0, z1 = 1/ss1, Goto[cont]];
ss = 1 - is[x] - smr;
z = If[ss > 0, 1/ss, z1];
ymin = Max[1 + x[[-1]], Floor[z]];
If[amax < \[Infinity],
ymax = Min[Ceiling[(n - r + 1) z1] - 1, amax],
ymax = Ceiling[(n - r + 1) z1] - 1];
rr = Range[ymin, ymax];
If[ymin <= ymax, AppendTo[v0[r], Join[x, {#}] & /@ rr]];
Label[cont];
];
v[r] = Flatten[v0[r], 1];
Return[];
Label[mrk];
(* Last step: calculate v[n] *)
u = v[r - 1];
us = Select[u, 1 == Numerator[1 - is @@ {#}] &];
us1 = Join[#, {Denominator[1 - is[#]]}] & /@ us ;
If[amax < \[Infinity], v[n] = Select[us1, #[[-1]] <= amax &],
v[n] = us1]; (* calcV6 *)
]


4. Applications

Now we are going to apply the code in some example cases

Example 1: $n = 4, amax = \infty$ (i.e. no restriction)

amax = \[Infinity];
Clear[v];
calcV6[4, 2]
v
calcV6[4, 3]
v
calcV6[4, 4]
v

(* {{2, 3}, {2, 4}, {2, 5}, {3, 4}} *)

(* {{2, 3, 6}, {2, 3, 7}, {2, 3, 8}, {2, 3, 9}, {2, 3, 10}, {2, 3, 11}, {2, 4,
5}, {2, 4, 6}, {2, 4, 7}, {2, 5, 6}} *)

(* {{2, 3, 7, 42}, {2, 3, 8, 24}, {2, 3, 9, 18}, {2, 3, 10, 15}, {2, 4, 5,
20}, {2, 4, 6, 12}} *)


Example 2 : $n = 4, amax = 13$ (i.e. restriction operating)

amax = 13;
Clear[v];
calcV6[4, 2]
v
calcV6[4, 3]
v
calcV6[4, 4]
v

(* {{2, 3}, {2, 4}, {2, 5}, {3, 4}} *)

(* {{2, 3, 11}, {2, 4, 5}, {2, 4, 6}, {2, 4, 7}, {2, 5, 6}} *)

(* {{2, 4, 6, 12}} *)


Example 3 : $n = 10, amax = 30$ (the required n but much smaller amax)

The output is:

column 1 n column 2 amax column 3 table: for each r = 2 .. n : {r, Timing, number of partial soultions}, number of partial solutions, {shortest (partial) solution vector, longest (partial) solution vector; according to Euclidian norm}

amax = 30;
nmax = 10;
Clear[v];
t = Table[{n, amax,
Table[{r, Timing[calcV6[n, r]][], Length[v[r]]}, {r, 2, n}],
v[n] // Length, {mi = Min[#.# & /@ v[n]];
Select[v[n], #.# == mi &][], mx = Max[#.# & /@ v[n]];
Select[v[n], #.# == mx &][]}}, {n, 3, nmax}];
t // TableForm


$\begin{array}{lllll} 3 & 30 & \begin{array}{lll} 2 & 0. & 1 \\ 3 & 0. & 1 \\ \end{array} & 1 & \begin{array}{lll} 2 & 3 & 6 \\ 2 & 3 & 6 \\ \end{array} \\ 4 & 30 & \begin{array}{lll} 2 & 0. & 4 \\ 3 & 0. & 9 \\ 4 & 0. & 5 \\ \end{array} & 5 & \begin{array}{llll} 2 & 4 & 6 & 12 \\ 2 & 3 & 8 & 24 \\ \end{array} \\ 5 & 30 & \begin{array}{lll} 2 & 0. & 8 \\ 3 & 0. & 26 \\ 4 & 0. & 75 \\ 5 & 0. & 11 \\ \end{array} & 11 & \begin{array}{lllll} 3 & 4 & 5 & 6 & 20 \\ 2 & 3 & 12 & 20 & 30 \\ \end{array} \\ 6 & 30 & \begin{array}{lll} 2 & 0. & 14 \\ 3 & 0. & 50 \\ 4 & 0. & 169 \\ 5 & 0.016 & 458 \\ 6 & 0. & 26 \\ \end{array} & 26 & \begin{array}{llllll} 3 & 4 & 6 & 10 & 12 & 15 \\ 2 & 3 & 20 & 21 & 28 & 30 \\ \end{array} \\ 7 & 30 & \begin{array}{lll} 2 & 0. & 20 \\ 3 & 0. & 73 \\ 4 & 0. & 292 \\ 5 & 0.015 & 959 \\ 6 & 0.047 & 2241 \\ 7 & 0.016 & 36 \\ \end{array} & 36 & \begin{array}{lllllll} 3 & 4 & 9 & 10 & 12 & 15 & 18 \\ 2 & 4 & 12 & 20 & 21 & 28 & 30 \\ \end{array} \\ 8 & 30 & \begin{array}{lll} 2 & 0. & 29 \\ 3 & 0. & 138 \\ 4 & 0.015 & 693 \\ 5 & 0.016 & 2322 \\ 6 & 0.093 & 4688 \\ 7 & 0.234 & 8341 \\ 8 & 0.094 & 43 \\ \end{array} & 43 & \begin{array}{llllllll} 4 & 5 & 6 & 9 & 10 & 15 & 18 & 20 \\ 2 & 6 & 8 & 20 & 21 & 24 & 28 & 30 \\ \end{array} \\ 9 & 30 & \begin{array}{lll} 2 & 0. & 36 \\ 3 & 0. & 158 \\ 4 & 0.016 & 642 \\ 5 & 0.015 & 2256 \\ 6 & 0.109 & 6437 \\ 7 & 0.359 & 14356 \\ 8 & 1.077 & 22835 \\ 9 & 0.265 & 39 \\ \end{array} & 39 & \begin{array}{lllllllll} 4 & 6 & 8 & 9 & 10 & 12 & 15 & 18 & 24 \\ 2 & 8 & 9 & 18 & 20 & 21 & 24 & 28 & 30 \\ \end{array} \\ 10 & 30 & \begin{array}{lll} 2 & 0. & 46 \\ 3 & 0. & 212 \\ 4 & 0.015 & 850 \\ 5 & 0.032 & 2929 \\ 6 & 0.14 & 8261 \\ 7 & 0.515 & 18998 \\ 8 & 1.607 & 34984 \\ 9 & 4.196 & 47403 \\ 10 & 0.577 & 24 \\ \end{array} & 24 & \begin{array}{llllllllll} 5 & 6 & 8 & 9 & 10 & 12 & 15 & 18 & 20 & 24 \\ 3 & 6 & 8 & 9 & 18 & 20 & 21 & 24 & 28 & 30 \\ \end{array} \\ \end{array}$

Example 4 : $amax = 100$ (the required amax, but n only up to n = 8)

amax = 100;
nmax = 8;
Clear[v];
t = Table[{n, amax,
Table[{r, Timing[calcV6[n, r]][], Length[v[r]]}, {r, 2, n}],
v[n] // Length, {mi = Min[#.# & /@ v[n]]; Select[v[n], #.# == mi &][],
mx = Max[#.# & /@ v[n]]; Select[v[n], #.# == mx &][]}}, {n, 3, nmax}];
t // TableForm


$\begin{array}{lllll} 3 & 100 & \begin{array}{lll} 2 & 0. & 1 \\ 3 & 0. & 1 \\ \end{array} & 1 & \begin{array}{lll} 2 & 3 & 6 \\ 2 & 3 & 6 \\ \end{array} \\ 4 & 100 & \begin{array}{lll} 2 & 0. & 4 \\ 3 & 0. & 10 \\ 4 & 0. & 6 \\ \end{array} & 6 & \begin{array}{llll} 2 & 4 & 6 & 12 \\ 2 & 3 & 7 & 42 \\ \end{array} \\ 5 & 100 & \begin{array}{lll} 2 & 0. & 8 \\ 3 & 0. & 30 \\ 4 & 0. & 179 \\ 5 & 0. & 42 \\ \end{array} & 42 & \begin{array}{lllll} 3 & 4 & 5 & 6 & 20 \\ 2 & 3 & 7 & 78 & 91 \\ \end{array} \\ 6 & 100 & \begin{array}{lll} 2 & 0.015 & 14 \\ 3 & 0. & 59 \\ 4 & 0. & 446 \\ 5 & 0.016 & 4045 \\ 6 & 0.047 & 229 \\ \end{array} & 229 & \begin{array}{llllll} 3 & 4 & 6 & 10 & 12 & 15 \\ 2 & 3 & 10 & 22 & 90 & 99 \\ \end{array} \\ 7 & 100 & \begin{array}{lll} 2 & 0. & 20 \\ 3 & 0. & 100 \\ 4 & 0. & 893 \\ 5 & 0.047 & 9437 \\ 6 & 0.811 & 83669 \\ 7 & 0.811 & 1131 \\ \end{array} & 1131 & \begin{array}{lllllll} 3 & 4 & 9 & 10 & 12 & 15 & 18 \\ 2 & 4 & 5 & 70 & 78 & 84 & 91 \\ \end{array} \\ 8 & 100 & \begin{array}{lll} 2 & 0. & 29 \\ 3 & 0. & 152 \\ 4 & 0. & 1330 \\ 5 & 0.078 & 15974 \\ 6 & 2.043 & 185821 \\ 7 & 495.475 & 1523993 \\ 8 & 15.959 & 4934 \\ \end{array} & 4934 & \begin{array}{llllllll} 4 & 5 & 6 & 9 & 10 & 15 & 18 & 20 \\ 2 & 3 & 10 & 55 & 70 & 77 & 90 & 99 \\ \end{array} \\ \end{array}$

Example 5: all Solutions for $n = 6$

amax = \[Infinity];
nmax = 6;
Clear[v];
t = Table[{n, amax,
Table[{r, Timing[calcV6[n, r]][], Length[v[r]]}, {r, 2, n}],
v[n] // Length, {mi = Min[#.# & /@ v[n]];
Select[v[n], #.# == mi &][], mx = Max[#.# & /@ v[n]];
Select[v[n], #.# == mx &][]}}, {n, 3, nmax}];
t // ColumnForm;
t // TableForm


$\begin{array}{lllll} 3 & \infty & \begin{array}{lll} 2 & 0. & 1 \\ 3 & 0. & 1 \\ \end{array} & 1 & \begin{array}{lll} 2 & 3 & 6 \\ 2 & 3 & 6 \\ \end{array} \\ 4 & \infty & \begin{array}{lll} 2 & 0. & 4 \\ 3 & 0. & 10 \\ 4 & 0. & 6 \\ \end{array} & 6 & \begin{array}{llll} 2 & 4 & 6 & 12 \\ 2 & 3 & 7 & 42 \\ \end{array} \\ 5 & \infty & \begin{array}{lll} 2 & 0. & 8 \\ 3 & 0. & 30 \\ 4 & 0. & 231 \\ 5 & 0. & 72 \\ \end{array} & 72 & \begin{array}{lllll} 3 & 4 & 5 & 6 & 20 \\ 2 & 3 & 7 & 43 & 1806 \\ \end{array} \\ 6 & \infty & \begin{array}{lll} 2 & 0. & 14 \\ 3 & 0. & 60 \\ 4 & 0. & 593 \\ 5 & 0.046 & 24690 \\ 6 & 0.234 & 2320 \\ \end{array} & 2320 & \begin{array}{llllll} 3 & 4 & 6 & 10 & 12 & 15 \\ 2 & 3 & 7 & 43 & 1807 & 3263442 \\ \end{array} \\ \end{array}$

Conclusions

We have provided a code which solves the problem for apropriate parameters $n$ and $amax$.

All solutions can be obtained by letting $amax = \infty$.

The reader can play with the code in order to detect the boundaries of reasonable calculation time and memory usage, respectively. A tradeoff between $n$ and $amax$ must be made.

Regards, Wolfgang

I shoot for reasonable clarity instead of performance - in my opinion observed <1.5 hour runtime is acceptable, considering clarity - at least to my eyes - of the solution:

With[{b = LCM @@ Range@100},
Select[b/IntegerPartitions[b, {10}, b/Range@100 // Reverse], Unequal@@#&]]


Here all numbers are multiplied by b, least common multiplier for all needed fractions. b, now representing total sum of 1, is partitioned to ten integer partitions, which have to be the size of listed fractions (multiplied by b). Values of original contributing integers are recovered by dividing b by the results, and finally, values where every integer is distinct are selected from this result.

Only non-obvious part in this is Reverse, which would appear to speed up the partitions search. Otherwise it has no effect, except on the order of results.

• Excellent solution to the problem as stated! It follows the idea of the initial comment of Mr. Wizard (Aug 24 at 7:15). If we ask, however, for all solutions without allowing for a maximum value of the a's, your routine is less well suited because amax is unknown beforehand. I have modified my routine now to explicitly allow for amax = inf. In the case n=6 my routine gives all 2 320 solutions in 0.281 secs, the maximum value of a's being 3 263 442. Putting this into your routine almost immediately blows the memory of my PC. – Dr. Wolfgang Hintze Sep 3 '14 at 9:50
• @Dr.WolfgangHintze Actually I was surprised that IntegerPartitions had all the necessary ingredients to support this solution, and that it can perform specified partitioning at some meaningful (time and space) efficiency. Increasing amax, yes, that wouldn't bode well for partitioning an integer around 7*10^40. :) – kirma Sep 3 '14 at 10:49
• (at) kirma: you're right. But as I said, already amax = 3 263 442 is suffcient, which is, however, necessary for the case n=6. But, anyway, in this type of problem it is very easy with any routine to blow the available computer ressource by increasing the parameters just a bit over those "affordable" :-) – Dr. Wolfgang Hintze Sep 3 '14 at 11:43

One might use integer linear programming (one would perhaps be foolish to do so, but one might all the same). I am posting this not as a competitive choice for this problem, but to give some idea of the possibilities. And I do not by any means rule out that there might be significant improvements to be had. As it stands, this is around 20x slower than what was requested.

So here goes. We begin with 99 variables that are intended as taking values of 0 or 1, with exactly ten of them equal to 1. We impose the constraint that their dot product with the reciprocals of {1/2, 1/3, ..., 1/100} equal 1. Multiply by the lcm of these denominators to get an integer equation.

n = 100;
lcm = LCM @@ Range[n];
vals = Rest[lcm/Range[n]];
vars = Array[a, n - 1, 2];
c0 = vars.vals == lcm;
c1 = Map[0 <= # <= 1 &, vars];
c2 = Total[vars] == 10;


Ignoring the constraints that exactly 10 of them contribute exactly one time, form an obvious solution.

soln = 2*UnitVector[n - 1, 1];


Now we reformulate as an integer problem wherein we want not just one solution but also generators for the null space.

lat = Transpose[Prepend[IdentityMatrix[n - 1], vals]];
hnf = HermiteDecomposition[lat];
nulls = hnf[[2, 2 ;; -1, 2 ;; -1]];
newvars = Array[b, Length[nulls]];
SetSystemOptions[
"LatticeReduceOptions" -> {"LatticeReduceRatioParameter" -> .999}];
rednulls = LatticeReduce[nulls];
c3 = Thread[newvars.rednulls + soln == vars];
constraints = Flatten[{c1, c2, c3}];
allvars = Join[newvars, vars];


Here is a crucial point. The original variables must be an integer linear combination of the solution vector plus integer multiples of the null vectors.

newpolys = newvars.rednulls + soln - vars;


Now we will use some linear programming with machine number coefficients. This next setting gives a modest speed boost but is not something I would admit to having shown.

SetOptions[LinearProgramming, Method -> "CLP"];


We will get extremal values for the new variables, that is, the multipliers of the null vectors. I will repeat this process one time, accounting for prior extrema on the second round. A brief experiment will show that this stabilizes so more repetitions give no improvement.

ctmp = {};
eps = 1/10^5;
Do[mins =
Table[Quiet[
val = NMinimize[{allvars[[j]], Join[constraints, ctmp]}, allvars];
If[Head[val] === NMinimize || ! FreeQ[val, Indeterminate],
val = First[val]; val, NMinimize::"nsol"], {j,
Length[allvars]}];
maxs = Table[
Quiet[val =
NMaximize[{allvars[[j]], Join[constraints, ctmp]}, allvars];
If[Head[val] === NMaximize || ! FreeQ[val, Indeterminate],
val = First[val]; val, NMaximize::"nsol"], {j,
Length[allvars]}];
ctmp = Join[Thread[LessEqual[allvars, Floor[Chop[maxs] + eps]]],
, {2}];


Now we see if we can remove some of the variables, either the 0-1 ones or the null space multipliers. It turns out that several of the 0-1 variables are forced to be zero.

aconstraints = Cases[ctmp, (GreaterEqual | LessEqual)[_a, _]];
bconstraints = DeleteCases[ctmp, Apply[Alternatives, aconstraints]];
aone = Cases[aconstraints, _a >= 1]
azero = Cases[aconstraints, _a <= 0]

(* Out= {}

Out= {a <= 0, a <= 0, a <= 0, a <= 0, a <= 0,
a <= 0, a <= 0, a <= 0, a <= 0, a <= 0,
a <= 0, a <= 0, a <= 0, a <= 0, a <= 0,
a <= 0, a <= 0, a <= 0, a <= 0, a <= 0,
a <= 0, a <= 0, a <= 0, a <= 0, a <= 0,
a <= 0, a <= 0, a <= 0, a <= 0, a <= 0,
a <= 0, a <= 0, a <= 0, a <= 0} *)


Important remark: This means we now have not Binomial[99,10] but "only" Binomial[65,10] possibilities to account for. THis almost brings brute force into the realm of tractability. But wait...

We now remove these variables and begin anew. Some of this, I'm sure, is unnecessary code. But we'll cut to the chase soon enough.

new = Complement[Range[2, n], azero[[All, 1, 1]]]
newn = Length[new];
lcm = LCM @@ new;
vals = lcm/new;
vars = Array[a, newn];
c0 = vars.vals == lcm;
c1 = Map[0 <= # <= 1 &, vars];
c2 = Total[vars] == 10;
soln = 2*UnitVector[newn, 1];

(* Out= {2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, \
18, 19, 20, 21, 22, 24, 25, 26, 27, 28, 30, 32, 33, 34, 35, 36, 38, \
39, 40, 42, 44, 45, 48, 50, 52, 54, 55, 56, 57, 60, 63, 65, 66, 70, \
72, 75, 76, 77, 78, 80, 84, 85, 88, 90, 91, 95, 96, 99, 100} *)


We now rinse and repeat. Again, pardon my confusion, this may be unnecessary.

lat = Transpose[Prepend[IdentityMatrix[newn], vals]];
hnf = HermiteDecomposition[lat];
nulls = hnf[[2, 2 ;; -1, 2 ;; -1]];
newvars = Array[b, Length[nulls]];
SetSystemOptions[
"LatticeReduceOptions" -> {"LatticeReduceRatioParameter" -> .999}];
rednulls = LatticeReduce[nulls];
c3 = Thread[newvars.rednulls + soln == vars];
constraints = Flatten[{c1, c2, c3}];
allvars = Join[newvars, vars];

ctmp = {};
eps = 1/10^5;
Do[mins =
Table[Quiet[
val = NMinimize[{allvars[[j]], Join[constraints, ctmp]}, allvars];
If[Head[val] === NMinimize || ! FreeQ[val, Indeterminate],
val = First[val]; val, NMinimize::"nsol"], {j,
Length[allvars]}];
maxs = Table[
Quiet[val =
NMaximize[{allvars[[j]], Join[constraints, ctmp]}, allvars];
If[Head[val] === NMaximize || ! FreeQ[val, Indeterminate],
val = First[val]; val, NMaximize::"nsol"], {j,
Length[allvars]}];
ctmp = Join[Thread[LessEqual[allvars, Floor[Chop[maxs] + eps]]],
, {2}];


We now recheck size ranges for those null vector multipliers.

bconstraints = DeleteCases[ctmp, Apply[Alternatives, aconstraints]];
vranges =
Transpose[Reverse[Partition[bconstraints[[All, 2]], Length[newvars]]]]
diffs = -Subtract @@@ vranges

(* Out= {{-3, 5}, {-3, 6}, {-4, 3}, {0, 1}, {-4, 5}, {-5, 5}, {-6,
3}, {-3, -1}, {-4, 4}, {0, 3}, {-4, 1}, {-2, 4}, {-4, 1}, {0,
4}, {0, 1}, {-1, 2}, {-2, 1}, {0, 1}, {-1, 1}, {-2, 0}, {-1,
2}, {-1, 0}, {-3, 0}, {-1, 2}, {-1, 2}, {0, 1}, {0, 1}, {-1,
1}, {-1, 1}, {-2, -1}, {0, 2}, {0, 2}, {-1, 1}, {0, 2}, {0, 1}, {-1,
0}, {0, 1}, {0, 1}, {-1, 1}, {0, 1}, {0, 1}, {-1, 0}, {0, 0}, {0,
2}, {0, 1}, {0, 1}, {0, 1}, {-1, 0}, {0, 1}, {0, 0}, {0, 1}, {0,
1}, {-1, 0}, {0, 0}, {0, 0}, {0, 0}, {0, 0}, {-1, 0}, {-1, 0}, {-1,
0}, {0, 0}, {0, 0}, {0, 0}, {0, 0}}

Out= {8, 9, 7, 1, 9, 10, 9, 2, 8, 3, 5, 6, 5, 4, 1, 3, 3, 1, 2, \
2, 3, 1, 3, 3, 3, 1, 1, 2, 2, 1, 2, 2, 2, 2, 1, 1, 1, 1, 2, 1, 1, 1, \
0, 2, 1, 1, 1, 1, 1, 0, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0} *)


Some have ranges of length zero, that is, they are exactly determined. So we can remove them from further consideration. Moreover we can reorder so that those with smaller ranges come earlier. This will be important for the branch-and-prune loop that comes later. Also we can remove more variables that occur in simple equations of the form v1==v2 or v1==-v2. Actually we could solve the linear system and remove more. I leave it as an exercise as to whether this will give a speed improvement (I did not try it).

ordr = Ordering[diffs];
newvarsordered = Pick[newvars[[ordr]], Sign[diffs[[ordr]]], 1];
restvars = DeleteCases[newvars, Alternatives @@ newvarsordered];
rule3 = Map[# -> 0 &, restvars];
constraints = (Union[constraints, ctmp] /. rule3) /.
True :> Sequence[];
pairs = Cases[constraints, b[_] == a[_]]
rule4 = Apply[Rule, pairs, {1}];
constraints3 = constraints /. rule4 /. True :> Sequence[];
removebs = pairs[[All, 1]];
newvarsordered2 =
DeleteCases[newvarsordered, Alternatives @@ removebs];
pairs2 = Cases[constraints, -b[_] == a[_]]

(* Out= {b == a, b == a, b == a,
b == a, b == a, b == a, b == a,
b == a, b == a, b == a, b == a,
b == a}

Out= {-b == a, -b == a, -b ==
a, -b == a, -b == a, -b == a, -b ==
a, -b == a} *)


We get rid of those null space multiplier vectors that can be removed by these obvious equalities.

rule5 = Map[-#[] -> -#[] &, pairs2];
removebs2 = -pairs2[[All, 1]];
constraints4 = constraints3 /. rule5 /. True :> Sequence[];
newvarsordered3 =
DeleteCases[newvarsordered2, Alternatives @@ removebs2]

(* Out= {b, b, b, b, b, b, b, b,
b, b, b, b, b, b, b, b, b, b,
b, b, b, b, b, b, b, b, b, b,
b, b, b, b, b, b, b, b, b, b,
b, b, b, b} *)


Finally we seek out and remove those 0-1 variables that are equated to one another.

allvars = Join[newvarsordered3, vars];
constraints = constraints4;
eq = Cases[constraints4, Equal[a_, b_]];
aeq = Cases[constraints4, _a == _]

(* Out= {a == a, a == a, a == a,
a == a, a == a, a == a, a == a,
a == a} *)

rule6 = Map[#[] -> #[] &, aeq];
constraints5 = constraints4 /. rule6 /. True :> Sequence[];
vars2 = Complement[vars, aeq[[All, 1]]];
aeq = Cases[constraints5, _a == _];
rule7 = Map[#[] -> #[] &, aeq];
constraints6 = constraints5 /. rule7 /. True :> Sequence[];
vars3 = Complement[vars2, aeq[[All, 1]]];
allvars = Join[newvarsordered3, vars3];
constraints = Complement[Union[constraints6], c1];


On the off chance that I did not omit any critical lines, here is what we have.

In:= allvars

(* Out= {b, b, b, b, b, b, b, b,
b, b, b, b, b, b, b, b, b, b,
b, b, b, b, b, b, b, b, b, b,
b, b, b, b, b, b, b, b, b, b,
b, b, b, b, a, a, a, a, a, a, a,
a, a, a, a, a, a, a, a, a, a,
a, a, a, a, a, a, a, a, a, a,
a, a, a, a, a, a, a, a, a,
a, a, a, a, a, a, a, a, a, a,
a, a, a, a, a, a, a, a, a,
a, a} *)

In:= constraints

(* Out= {a + a == a,
a + a + a + a + a + a + a + a + a +
a + a + a + a + a + a + a + a +
a + a + a + a + a + a + a + 3 a +
a + a + a + a + a + a + a + a +
a + 2 a + a + a + 2 a + a + a + a +
a + a + a + 2 a + a + a + a + a +
a + a + a + a + 2 a + 2 a + a +
2 a == 10, b + b + b == a, -b - b == a,
b + b + b == a, -b - b ==
a, -b + b == a, -b - b == a,
b + b == a, -a - b == a,
b - b == a, b + b == a,
b - b == a,
b - b - b == a, -b - b - b == a,
2 + b == a, b + b == a,
a + a - b + b - b + b + b + b ==
a, b - b - b - b ==
a, -a + b + b - b - b - b == a,
b + b - b + b == a, b - b == a,
b + b == a, b - b == a,
b + b - b - b == a, -b + b == a,
b - b + b == a,
b + b == a, -b - b == a, -b - b ==
a, -a - a - a - b + b - b - b +
b - b + b + b - b + b + b == a,
a + b + b - b + b + b + b + b -
b ==
a, -a - a - a + b + b - b - b + b +
b + b - b + b - b - b - b - b +
b + b + b == a, b + b - b == a,
b + b == a,
b - b == a, -a - b - b + b + b + b ==
a, -a - a + a - a - a + b + b + b -
b + b - b - b - b - b + b == a,
b + b ==
a, -a + b + b + b + b - b ==
a, -b - b == a, -b - b - b ==
a, -a - b + b == a,
b - b + b == a,
a + a + b + b - b - b - b + b -
b + b ==
a, -a - a - a + b - b - b + b - b +
b - b + b == a, a >= 0, a >= 0, a >= 0,
a >= 0, a >= 0, a >= 0, a >= 0, a >= 0, a >= 0,
a >= 0, a >= 0, a >= 0, -a >= -1, a >= 0,
a >= 0, a >= 0, a >= 0, a >= 0, a >= 0,
a >= 0, a >= 0, a >= 0, a >= 0, a >= 0,
a >= 0, -a >= -1, a >= 0, a >= 0, a >= 0,
a >= 0, a >= 0, a >= 0, a >= 0, a >= 0,
a >= 0, a >= 0, a >= 0, a >= 0,
a >= 0, -a >= -1, a >= 0, a >= 0, a >= 0,
a >= 0, a >= 0, a >= 0, a >= 0, a >= 0,
a >= 0, a >= 0, a >= 0, a >= 0, a >= 0,
a >= 0, a >= 0, a >= 0, -a >= -1, a >= 0,
a >= 0, a >= 0, a >= 0, b >= -3, b >= -3,
b >= -4, b >= -4, b >= -5, b >= -6, b >= -3,
b >= -4, b >= 0, b >= -4, b >= -2, b >= -4,
b >= 0, b >= -1, b >= -2, b >= -1, b >= -2,
b >= -1, b >= -3, b >= -1, b >= -1, b >= -1,
b >= -1, b >= -2, b >= 0, b >= 0, b >= -1,
b >= 0, b >= 0, b >= -1, b >= 0, b >= 0,
b >= -1, b >= 0, b >= 0, b >= -1, b >= 0,
b >= -1, b >= 0, b >= 0, b >= 0, b >= -1,
a <= 1, a <= 1, a <= 1, a <= 1, a <= 1, a <= 1,
a <= 1, a <= 1, a <= 1, a <= 1, a <= 1,
a <= 1, -a <= 0, a <= 1, a <= 1, a <= 1,
a <= 1, a <= 1, a <= 1, a <= 1, a <= 1,
a <= 1, a <= 1, a <= 1, a <= 1, -a <= 0,
a <= 1, a <= 1, a <= 1, a <= 1, a <= 1,
a <= 1, a <= 1, a <= 1, a <= 1, a <= 1,
a <= 1, a <= 1, a <= 1, -a <= 0, a <= 1,
a <= 1, a <= 1, a <= 1, a <= 1, a <= 1,
a <= 1, a <= 1, a <= 1, a <= 1, a <= 1,
a <= 1, a <= 1, a <= 1, a <= 1,
a <= 1, -a <= 0, a <= 1, a <= 1, a <= 1,
a <= 1, b <= 5, b <= 6, b <= 3, b <= 5, b <= 5,
b <= 3, b <= -1, b <= 4, b <= 3, b <= 1, b <= 4,
b <= 1, b <= 4, b <= 2, b <= 1, b <= 1,
b <= 0, b <= 2, b <= 0, b <= 2, b <= 2,
b <= 1, b <= 1, b <= -1, b <= 2, b <= 2,
b <= 1, b <= 2, b <= 1, b <= 0, b <= 1,
b <= 1, b <= 1, b <= 1, b <= 1, b <= 0,
b <= 2, b <= 0, b <= 1, b <= 1, b <= 1,
b <= 0} *)


Here is what we do next. With linear programming we can find all values for the a abd b variables (the 0-1 original variables and the null vector multipliers respectively) that give viable solutions. My belief is that when we solve relaxed LPs, that is, when inequalities but not integrality is enforced, it is best to branch on those null space multipler variables that have the smallest ranges. Empirically there is some evidence to suggest that this is the best way to branch (okay, one article on this is mine, but there are others as well). So we look for the first noninteger value from amongst the variables that we had reordered exactly for this purpose.

When a solution is found, we can now make new constraints that enforce that further solutions not be the same, and reenter the branch-and-prune loop.

Timing[sol =
Reap[Module[{vlen = Length[allvars], program, stack, badvar, vvals,
val, counter = 0, var, len, eps = 1/10^5, soln = {}, cnstrnt,
newc, newv, pairdiff, vv, kk = 0, oldj, oneposns, newcons},
program = constraints;
stack = {program, {}};
While[stack =!= {},
counter++;
program = stack[];
stack = stack[];
program = {1, program};
Quiet[vvals = NMinimize[program, allvars]];
vvals = vvals[];
If[! FreeQ[vvals, Indeterminate], Continue[]];
cnstrnt = program[];
Position[allvars /. vvals,
a_ /; Abs[a - Round[a]] >= eps, {1}, 1, Heads -> False];
kk++;
If[Mod[kk, 100] == 0, Print["have soln ", {counter, kk}]];
oneposns =
Cases[vvals, HoldPattern[a[_] -> aa_] /; Round[aa] == 1];
oneposns = oneposns[[All, 1]];
Do[
newcons =
Join[Table[
oneposns[[j]] == 1, {j, k - 1}], {oneposns[[k]] == 0}];
stack = {Join[cnstrnt, newcons], stack};
, {k, Length[oneposns]}];
Sow[vals[[oneposns[[All, 1]]]]/lcm];
Continue[];];
val = var /. vvals;
stack = {Join[cnstrnt, {var <= Floor[val]}], stack};
stack = {Join[cnstrnt, {var >= Ceiling[val]}], stack};];]][[2,
1]];]


After many many print statements, wherein we get around 160 solutions per minute, this finally ends.

(* {26562.945818, Null} *)


How long was that?

In:= 26563./3600

(* Out= 7.37861 *)


That's 7+ hours. Did we get the expected number of solutions?

Length[sol]

(* Out= 69014 *)


Well, that much is good. Further work, using the equalities amongst variables that we found along the way, would be needed to recover all the actual sets of values.

So what are the salient features of this approach? Let me give my best effort at a summary.

(1) It is not an especially compelling method for the problem at hand. Moreover, as @Dr.Wolfgang Hintze observes in a different response, this would not scale at all well were we to allow reciprocals of integers arbitrarily large. I doubt it would scale were we even to allow them to be modestly larger. That said, we managed to recover a correct result in less than glacial time.

(2) We could have avoided the last code and just called Solve, specifying Integers for the domain over which to solve. Or could we? The problem is that Solve and the like will use exact linear programming. This is slow, but guaranteed to be correct. One cannot say the same for the approximate LP method shown above (though with the smallish integers involved, realistically it will not fail). One might ask why Solve does not do similarly. The answer is that we do not have a feel for what precision in the LP solver would be sufficient to guarantee correctness of the result.

(3) It can be a really good method when there are variables for which ranges are not very small (when we are not doing, say, 0-1 programming).

(4) One improvement I did not try would be to reduce to LinearProgramming in lieu of NMinimize. My past experience is that can reduce a run time by a factor of two or more (my past experience also indicates that this can increase the pain of programming by a factor of two or more).

(5) There could be ways to improve upon this, deep in the LP code, by "warm restarts" or use of cutting planes. This would not be trivial to implement though. Also it goes a ways outside of my own limited understanding of the topic.

(6) There are perhaps a few other improvements to be had that I simply never considered.