4
$\begingroup$

There is a problem from the $66th$ Putnam Mathematical Competition, $B2$

Find all positive integers $n,k_1,k_2,...,k_n$ such that $$k_1+\cdots+k_n=5n-4$$ and $$\frac{1}{k_1}+\cdots+\frac{1}{k_n}=1$$

How can I solve this problem with Mathematica?

I tried unsuccessfully something like this:

Reduce[ Sum[ 1/Subscript[k, c], {c, 1, n}] == 1 && 
        Sum[ Subscript[k, s], {s, 1, n}] == 5 n - 4, 
  Flatten[{ n, Table[ Subscript[k, s], {s, 1, n}]}],
  Integers]
$\endgroup$
1
  • 2
    $\begingroup$ using subscripts is not a good idea. You could always just do k[c] $\endgroup$
    – Nasser
    Dec 14, 2017 at 17:29

3 Answers 3

9
$\begingroup$

We can find all solutions avoiding computationally expensive searching for examples of solutions ( other answers find all solutions by chance not proving that all solutions are found) if we exploit an inequality between arithmetic and harmonic means of $n$ positive numbers: $$\frac{k_1+\dots+k_n}{n} \geq \frac{n}{\frac{1}{k_1}+\dots \frac{1}{k_n}}$$
where $k_1>0, \dots, k_n>0.\;$ This inequality ensures that the whole solution space is found.

The system ( version $\geq$ 10.1) knows this relation for $n\leq 4\;$ ( for $n>4$ it is also true however Mathematica fails to decide it), e.g.

Simplify[Mean[#] >= HarmonicMean[#], Min[#] > 0] &[{k1, k2, k3, k4}]
True

It appears that $n\leq 4\;$ is sufficient for our purpose, since from the assumptions we have: $$\frac{k_1+\dots+k_n}{n} \geq n$$ because $\frac{1}{k_1}+\dots \frac{1}{k_n}=1$. On the other hand $k_1+\dots+k_n =5n-4$, therefore we get the following inequality:

Solve[ 5n - 4 >= n^2 && n > 0, n, Integers]
 {{n -> 1}, {n -> 2}, {n -> 3}, {n -> 4}}

There are four possibilities: the first one yields an obvious solution $n=1$ and $k_1=1$. From the assumptions it is clear that, if $(k_1, \dots, k_n)$ is a solution than any permutation $(k_{\sigma(1)}, \dots, k_{\sigma(n)})$ is also a solution. Then for the sake of simplicity and a good performance we define a function yielding solutions ordered by $k_1\leq k_2 \leq \dots \leq k_n$:

sol[l_List] /; Length[l] > 0 := 
  Solve[{ Mean @ l == 5 - 4/Length @ l, HarmonicMean @ l == Length @ l, 
          LessEqual @@ l, Min @ l > 0}, l, Integers]

we can find all solutions

sol /@ Table[Array[k, m], {m, 4}] // Column
 {{k[1] -> 1}}
 {}
 {{k[1] -> 2, k[2] -> 3, k[3] -> 6}}
 {{k[1] -> 4, k[2] -> 4, k[3] -> 4, k[4] -> 4}} 

Reassuming, all possible solutions (up to permutations of $k_1, \dots ,k_n$) are: $$ n=1,\quad k_1=1$$ $$ n=3,\quad k_1=2,\; k_2=3,\; k_3=6$$ $$ n=4, \quad k_1=k_2=k_3=k_4=4$$

$\endgroup$
4
$\begingroup$

Since each variable must be at least one then the largest any variable can be is 5n - 4 - (n - 1), i.e., 4n - 3. To avoid permutations of the solution, require the variables to be ordered, i.e., GreaterEqual[k1, k2, ..., kn]

soln[n_Integer?Positive] := Module[
  {var = Array[k, n], assume},
  assume = 
   Element[var, 
     Integers] && (And @@ Thread[4 n - 3 >= var > 0]) && (GreaterEqual @@ var);
  Solve[{(Total[var] == (5 n - 4)) && (HarmonicMean[var] == n) && assume}, 
    var, Integers] // Flatten]

DeleteCases[{#, soln[#]} & /@ Range[5], {_, {}}] // Grid[#, Frame -> All] &

enter image description here

This becomes unbearably slow for larger values of n

$\endgroup$
3
$\begingroup$

Here is the one way to do it.

 Manipulate[
   Solve[Total@Array[k, n] == 5 n - 4 && Total@(1/Array[k, n]) == 1 && 
       And @@ (# > 0 &) /@ Array[k, n], Array[k, n], Integers], {n, 1, 5, 
      1}]
$\endgroup$
2
  • $\begingroup$ Why is $n \leq 5$ ? $\endgroup$
    – Artes
    Dec 14, 2017 at 17:23
  • $\begingroup$ It can be increased.. $\endgroup$ Dec 14, 2017 at 17:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.