3

I have to minimize a bunch of functions of n variables that can take values from an integer range.

The functions have the general form:

f[{s1_,... sn_}]:= Kxy KroneckerDelta[sx,sy] + Kwz KroneckerDelta[sw,sz] +/- ..

Where the Kmn are also integers.

As an example,

f[{s1_, s2_, s3_, s4_, s5_}:= KroneckerDelta[s1, s2] - KroneckerDelta[s1, s4] +
                              KroneckerDelta[s1, s5] + KroneckerDelta[s3, s4] + 
                              KroneckerDelta[s3, s5] + KroneckerDelta[s4, s5]; 

Where the si_ must be in Range[3].

I can bruteforce easily, for example:

rulez = Table[s[i] -> #[[i]], {i, 5}] & /@ Tuples[Range[3], 5]; 
k1    = f[Table[s[i], {i, 5}]] /. rulez;

{Min[k1], Tuples[Range[3], 5][[#]] & /@ Position[k1, Min[k1]]}
(*
->
{-1,{{{1, 2, 2, 1, 3}}, {{1, 2, 3, 1, 2}}, {{1, 3, 2, 1, 3}}, {{1, 3, 3, 1, 2}}, 
     {{2, 1, 1, 2, 3}}, {{2, 1, 3, 2, 1}}, {{2, 3, 1, 2, 3}}, {{2, 3, 3, 2, 1}}, 
     {{3, 1, 1, 3, 2}}, {{3, 1, 2, 3, 1}}, {{3, 2, 1, 3, 2}}, {{3, 2, 2, 3, 1}}}}
*)

Obviously, that seems to take forever for large sets of variables and larger value ranges.

I tried Minimize[ ], but get results that don't satisfy the conditions (!):

Minimize[{f[Table[s[i], {i, 5}]],  And @@ Table[1 <= s[i] <= 3, {i, 5}]},
         Table[s[i], {i, 5}], Integers]
(*
-> {2, {s[1] -> 0, s[2] -> 0, s[3] -> 0, s[4] -> 0, s[5] -> 0}}
*)

Or in other cases, it just fails:

g[{s1_, s2_, s3_, s4_, s5_}]:= KroneckerDelta[s1, s3] - KroneckerDelta[s1, s4] +
                               KroneckerDelta[s1, s5] + KroneckerDelta[s3, s4] + 
                               KroneckerDelta[s3, s5] + KroneckerDelta[s4, s5]; 

Minimize[{g[Table[s[i], {i, 5}]],  And @@ Table[1 <= s[i] <= 3, {i, 5}]},
         Table[s[i], {i, 5}], Integers]
(*
-> 
During evaluation of In[168]:= Minimize::infeas: There are no values of
{s[1],s[2],s[3],s[4],s[5]} for which the constraints 1<=s[1]<=3&&1<=s[2]<=3&&
1<=s[3]<=3&&1<=s[4]<=3&&1<=s[5]<=3 are satisfied and the objective function  
KroneckerDelta[s[1],s[3]]-KroneckerDelta[s[1],s[4]]+KroneckerDelta[s[1],s[5]]+
KroneckerDelta[s[3],s[4]]+KroneckerDelta[s[3],s[5]]+KroneckerDelta[s[4],s[5]] 
is real valued.  >>
Out[169]= {\[Infinity], s[1]->Indeterminate, s[2]->Indeterminate, 
                        s[3]->Indeterminate, s[4]->Indeterminate, 
                        s[5]->Indeterminate}}
*)

So the question is twofold:

Why does Minimize[ ] fail?, and What is the better way to tackle this kind of problems with ?

Edit

Just to emphasize, the first question is:

Why does Minimize[ ] fail?

Not that the other part is less important, but I am trying to learn when to invest my time in lurking with Minimize[ ], and when I shouldn't.

Dr. belisarius
  • 60,527
  • 15
  • 115
  • 190
  • In last example missing ] in function g and undefined variable particlesN – Sjoerd C. de Vries Mar 29 '11 at 23:49
  • @Sjoerd particlesN was corrected a few minutes ago. It comes from my real code, where the number of particles is variable. I'll search for the missing bracket. Thanks! – Dr. belisarius Mar 30 '11 at 00:02
  • 1
    I get results of -1 for both examples. Using version 9, but I don't think Minimize has changed since 8.0.1 (caveat: maybe there was a bug fix I did not know about, or else forgot). As to speed, I will surmise that Minimize calls FunctionExpand, and that changes KroneckerDelta to a Piecewise form that, for each one, gives rise to three Or'd subproblems. A LogicalExpand will make this into a big set of (individually small) problems. – Daniel Lichtblau Mar 30 '11 at 17:07

2 Answers2

2

The problem seems to be related to the KroneckerDelta. If I define a function that is equivalent as long as integers are input it works (or at least it looks like it):

In[177]:= kd[x_, y_] := Round[10^-(x - y)^2]

In[179]:= 
g[{s1_, s2_, s3_, s4_, s5_}] := 
  kd[s1, s3] - kd[s1, s4] + kd[s1, s5] + kd[s3, s4] + kd[s3, s5] + 
   kd[s4, s5];
Minimize[{g[{s1, s2, s3, s4, s5}], 
  And @@ Map[1 <= # <= 3 &, {s1, s2, s3, s4, s5}]}, {s1, s2, s3, s4, 
  s5}, Integers]

Out[180]= {-1, {s1 -> 1, s2 -> 1, s3 -> 2, s4 -> 1, s5 -> 3}}
Sjoerd C. de Vries
  • 16,122
  • 3
  • 42
  • 94
  • Thanks! I'm trying this approach with a real size problem, and I'm running out of memory. Will come back after double checking if it's `Minimize[]` or me :*( – Dr. belisarius Mar 30 '11 at 01:08
  • If you can tolerate a heuristic result (not guaranteed, that is), then Sjoerd's method above, but with NMinimize instead of Minimize, should work tolerably well. As a technical detail, you'd need to remove that last argument of Integers, and replace by adding, in the constraints, Element[{s1,...},Integers] – Daniel Lichtblau Mar 30 '11 at 16:08
  • @Daniel Tested the heuristic in some small cases and seems to work reasonably well. But I'm not sure how bad it could be perform in large problems. Is there any way to bound the error? – Dr. belisarius Mar 31 '11 at 16:47
  • @Daniel Also, what "Method" option in `Nminimize` should work better for the Integer case? – Dr. belisarius Mar 31 '11 at 16:50
  • @belisarius Unfortunately I know of no way to bound the error. As for Method, I'm pretty sure NMinimize will be forced to use DifferentialEvolution. To influence parameter settings e.g. #generations or #chromosomes, could do Method->{"NMinimize","SearchPoints"->200} or some such. – Daniel Lichtblau Mar 31 '11 at 22:05
2

You can set it up as an integer linear programming problem, and send it to Minimize in that form. I show one way to do this below. The Kronecker deltas are now just integer variables constrained between 0 and 1, with certain relations that force k[i,j] to be 1 when s[i]==s[j] and zero otherwise (this uses the coefficient signs and the max coefficient value).

I show the full set of constraints below, along with the expression we'll minimize.

highval = 3;
list = {{1, 2}, {1, 4}, {1, 5}, {3, 4}, {3, 5}, {4, 5}};
coeffs = {1, -1, 1, 1, 1, 1};
v1list = Apply[k, list, 1];
expr = coeffs.v1list
v2list = Map[s, Range[5]];
allvars = Flatten[{v1list, v2list}];
c1 = Map[0 <= # <= 1 &, v1list];
c2 = Map[1 <= # <= highval &, v2list];
c3 = Map[# <= 0 &, 
   Sign[coeffs]*
    Map[{highval*(# - 1) - (s[#[[1]]] - s[#[[2]]]), 
       highval*(# - 1) - (s[#[[2]]] - s[#[[1]]])} &, v1list], {2}];
c4 = Element[allvars, Integers];
constraints = Flatten[{c1, c2, c3}]

k[1, 2] - k[1, 4] + k[1, 5] + k[3, 4] + k[3, 5] + k[4, 5]  

{0 <= k[1, 2] <= 1, 0 <= k[1, 4] <= 1, 0 <= k[1, 5] <= 1, 0 <= k[3, 4] <= 1, 
 0 <= k[3, 5] <= 1, 0 <= k[4, 5] <= 1,

 1 <= s[1] <= 3, 1 <= s[2] <= 3, 1 <= s[3] <= 3, 1 <= s[4] <= 3, 1 <= s[5] <= 3, 

 3*(-1 + k[1, 2]) - s[1] + s[2] <= 0, 3*(-1 + k[1, 2]) + s[1] - s[2] <=  0, 
-3*(-1 + k[1, 4]) + s[1] - s[4] <= 0,-3*(-1 + k[1, 4]) - s[1] + s[4] <= 0, 
 3*(-1 + k[1, 5]) - s[1] + s[5] <= 0, 3*(-1 + k[1, 5]) + s[1] - s[5] <= 0,  
 3*(-1 + k[3, 4]) - s[3] + s[4] <= 0, 3*(-1 + k[3, 4]) + s[3] - s[4] <= 0, 
 3*(-1 + k[3, 5]) - s[3] + s[5] <= 0, 3*(-1 + k[3, 5]) + s[3] - s[5] <= 0, 
 3*(-1 + k[4, 5]) - s[4] + s[5] <= 0, 3*(-1 + k[4, 5]) + s[4] - s[5] <= 0}

Now just call Minimize, specifying Integers as domain.

Minimize[{expr, constraints}, allvars, Integers]

Out[235]= {-1, {k[1, 2] -> 0, k[1, 4] -> 1, k[1, 5] -> 0, 
                k[3, 4] -> 0, k[3, 5] -> 0, k[4, 5] -> 0,
                s[1] -> 2, s[2] -> 2, s[3] -> 2, s[4] -> 2, s[5] -> 2}}

Daniel Lichtblau Wolfram Research

Daniel Lichtblau
  • 6,854
  • 1
  • 23
  • 30