Techniques for Minimization over Integers - wolfram-mathematica

Question

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

Answer 1

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

Answer 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