6
$\begingroup$

Here is a problem from math folklore. Minimize $$\sum_{j=1}^{j=n} x_j$$ under the constraints $$x_1+x_2\ge 1,\, x_2+x_3\ge 2,\dots,x_n+x_1 \ge n .$$ The Mathematica codes

Minimize[{Sum[x[j], {j, 1, n}],Table[x[j] + x[j + 1] >= j, {j, 1, n - 1}], x[n] + x[1] >= n},Table[x[j], {j, 1, n}]]

and

Minimize[{Sum[x[j],{j, 1, n}], Table[x[j] + x[j + 1] >= j, {j, 1, n - 1}], x[n] + x[1] >= n,Table[x[j] >= 0, {j, 1, n}]}, Table[x[j], {j, 1, n}]]

crack it for values of $n$ of order several hundreds, e.g. for $n=1234$ both codes produce the value $381306$ for the objective function, but slowly.

In fact, this is a linear programming problem. Is it possible to solve it for $n=2019$ in Mathematica (maybe, calling external sources)?

Improve this question
$\endgroup$
10
  • 2
    $\begingroup$ Have you tried LinearProgramming? $\endgroup$
    – Mr Puh
    Commented Oct 15, 2020 at 8:30
  • 1
    $\begingroup$ @MrPuh: Thank you for the idea. No. Up to the documentation "If f and cons are linear or polynomial, Minimize will always find a global minimum ", I think Minimize refers to LinearProgramming itself. $\endgroup$
    – user64494
    Commented Oct 15, 2020 at 8:37
  • $\begingroup$ For $n=2019$ the first code produces $1019595$ and {x[1] -> 505, x[2] -> -504, x[3] -> 506, x[4] -> -503,...,x[2019] -> 1514} in more than hour. $\endgroup$
    – user64494
    Commented Oct 15, 2020 at 8:56
  • $\begingroup$ @MrPuh: Trying to use LinearProgramming, I meet the problem with creating the matrix. $\endgroup$
    – user64494
    Commented Oct 15, 2020 at 8:58
  • $\begingroup$ For $ n=2019$ the second code produces {1020099, {x[1] -> 1009, x[2] -> 0, x[3] -> 2, x[4] -> 1, ..., x[2019] -> 1010}} in 4350.85 sec $\endgroup$
    – user64494
    Commented Oct 15, 2020 at 10:38

3 Answers 3

Reset to default
5
$\begingroup$ 
n = 2019;
c = Table[1, n];
m = SparseArray[{Band[{1, 1}] -> 1, Band[{1, 2}] -> 1, {n, 1} -> 1}, {n, n}];
b = Range[n];
LinearOptimization[N[c], {m, -b}, "PrimalMinimumValue"] // AbsoluteTiming // DecimalForm
(* {0.0275781, 1019595.} *)

Note that the use of N to force machine precision is important, otherwise the result will be exact but much slower. For some reason, the slowdown becomes much more significant at n = 201:

           Exact   Approximate
n = 200    0.35 s     0.002 s
n = 201    8.9 s      0.002 s

Using LinearProgramming gives the same results (and has the same timing issue):

Total @ LinearProgramming[N[c], m, b, -∞] // AbsoluteTiming // DecimalForm
(* {0.0286999, 1019595.} *)

Note the -∞, without it the constraint x ≥ 0 is added.

Improve this answer
$\endgroup$
4
  • $\begingroup$ It looks like LinearProgramming has two methods that only work with machine precision numbers and are much faster than the ones that work for arbitrary precision. $\endgroup$
    – Sjoerd Smit
    Commented Oct 15, 2020 at 18:14
  • $\begingroup$ +1. Thank you. This is a modified approach by Ulrich Neumann. How about the values of the variables? Your phrase "Note the -∞, without it the constraint x ≥ 0 is added" is unclear to me: the constraints imply (by addition) that the target function is greater than $\frac {n(n+1)} 4$. $\endgroup$
    – user64494
    Commented Oct 16, 2020 at 0:20
  • $\begingroup$ Loking in the documentation, I got " Note the -∞, without it the constraint x ≥ 0 is added". $\endgroup$
    – user64494
    Commented Oct 16, 2020 at 0:33
  • $\begingroup$ Having executed LinearOptimization[N[c], {m, -b}] // AbsoluteTiming, I see the optimal values of the variables. $\endgroup$
    – user64494
    Commented Oct 16, 2020 at 1:05
7
$\begingroup$

Using a different approach: guess the sequence. Then the answer for 2019 returns the right result in 20 microseconds. However, it does not prove that the sequence is the actual answer.

sol = ParallelTable[{n, Minimize[{Sum[x[j], {j, 1, n}], 
      Table[x[j] + x[j + 1] >= j, {j, 1, n - 1}], x[n] + x[1] >= n}, 
     Table[x[j], {j, 1, n}]]}, {n, 2, 50}];

f = FindSequenceFunction[sol[[All, 2, 1]]];
answer[n_] = f[n - 1];
(* 1/8 (-1)^(-1 + n) (-1 + 5 (-1)^(-1 + n) + 2 (-1)^(-1 + n) (-1 + n)) n *)

answer[2019]
(* 1019595 *)
Improve this answer
$\endgroup$
5
  • $\begingroup$ Unfortunately, 1/8 (-1)^(-1 + n) (-1 + 5 (-1)^(-1 + n) + 2 (-1)^(-1 + n) (-1 + n)) /. n -> 1234 performs $309$, whereas the correct answer is $381306$. Thank you anyway. $\endgroup$
    – user64494
    Commented Oct 15, 2020 at 9:31
  • $\begingroup$ @user64494 Try answer[1234]... You did not copy paste properly (missing n at the end). $\endgroup$
    – anderstood
    Commented Oct 15, 2020 at 9:32
  • $\begingroup$ Sorry, my bad. 1/8 (-1)^(-1 + n) (-1 + 5 (-1)^(-1 + n) + 2 (-1)^(-1 + n) (-1 + n)) n /. n -> 1234 performs 381306. The answer is of order $\frac {n^2} 4$. $\endgroup$
    – user64494
    Commented Oct 15, 2020 at 9:49
  • $\begingroup$ I'd like to add the formula $$\frac{1}{8} (-1)^{n-1} \left(2 (-1)^{n-1} (n-1)^2+8 (-1)^{n-1} (n-1)+3 (-1)^{n-1}-3\right)$$ in the case of nonnegative variables. $\endgroup$
    – user64494
    Commented Oct 15, 2020 at 10:24
  • $\begingroup$ My suggestion is to apply dynamic programming to prove the formulas. $\endgroup$
    – user64494
    Commented Oct 16, 2020 at 9:09
5
$\begingroup$

NMinimize calculates the case n==2019

 mini[n_] :=NMinimize[{Sum[x[j], {j, 1, n}],Table[x[j] + x[j + 1] >= j, {j, 1, n - 1}], x[n] + x[1] >= n},Table[x[j], {j, 1, n}]][[1]]
 
 mini[2019] // Rationalize // AbsoluteTiming
 (*{0.118309, 1019595}*)

in .11 seconds!

Improve this answer
$\endgroup$
3
  • $\begingroup$ +1. Nice and useful. $\endgroup$
    – user64494
    Commented Oct 15, 2020 at 10:26
  • $\begingroup$ However, the results of mini2[n_] := NMinimize[{Sum[x[j], {j, 1, n}], Table[x[j] + x[j + 1] >= j, {j, 1, n - 1}], x[n] + x[1] >= n}, Table[x[j], {j, 1, n}]][[2]], e.g. mini2[1234] // Rationalize // AbsoluteTiming which performs {0.130057, {x[1] -> -3.72396*10^14, x[2] -> 3.72396*10^14, ...,x[1234] -> 3.72396*10^14 }} (most of values are as the last) are doubtful. $\endgroup$
    – user64494
    Commented Oct 15, 2020 at 10:35
  • $\begingroup$ Maybe, WorkingPrecision should be increased. $\endgroup$
    – user64494
    Commented Oct 15, 2020 at 10:41

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.