Techniques for Minimization over Integers

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开发者_JAVA技巧]:= 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 mathematica?

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.

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}}

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