5
$\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)?

$\endgroup$
10
  • 2
    $\begingroup$ Have you tried LinearProgramming? $\endgroup$ – Mr Puh Oct 15 '20 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 Oct 15 '20 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 Oct 15 '20 at 8:56
  • $\begingroup$ @MrPuh: Trying to use LinearProgramming, I meet the problem with creating the matrix. $\endgroup$ – user64494 Oct 15 '20 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 Oct 15 '20 at 10:38
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.

$\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 Oct 15 '20 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 Oct 16 '20 at 0:20
  • $\begingroup$ Loking in the documentation, I got " Note the -∞, without it the constraint x ≥ 0 is added". $\endgroup$ – user64494 Oct 16 '20 at 0:33
  • $\begingroup$ Having executed LinearOptimization[N[c], {m, -b}] // AbsoluteTiming, I see the optimal values of the variables. $\endgroup$ – user64494 Oct 16 '20 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 *)
$\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 Oct 15 '20 at 9:31
  • $\begingroup$ @user64494 Try answer[1234]... You did not copy paste properly (missing n at the end). $\endgroup$ – anderstood Oct 15 '20 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 Oct 15 '20 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 Oct 15 '20 at 10:24
  • $\begingroup$ My suggestion is to apply dynamic programming to prove the formulas. $\endgroup$ – user64494 Oct 16 '20 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!

$\endgroup$
3
  • $\begingroup$ +1. Nice and useful. $\endgroup$ – user64494 Oct 15 '20 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 Oct 15 '20 at 10:35
  • $\begingroup$ Maybe, WorkingPrecision should be increased. $\endgroup$ – user64494 Oct 15 '20 at 10:41

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.