# Minimization with constraints

Here is a code for the minimization of several objectives with positives constraint and integral constraints. It works nicely for the 5 firsts, but Mathematica doesn't try to solve the two lasts.

f[n_, t_] :=
t Normalize[RandomVariate[UniformDistribution[], n], Total]
q = f[5, 10]
Total[q]
var = Table[Subscript[x, i], {i, Length[q]}]
Total[q]
a1 := Table[Abs[q[[i]] - Subscript[x, i]], {i, Length[q]}]
obj1 = Total[a1];
a12 := Table[Abs[q[[i]] - Subscript[x, i]]^2, {i, Length[q]}]
obj12 = Total[a2];
a2 := Table[Abs[Subscript[x, i]/q[[i]] - 1], {i, Length[q]}]
obj2 = Total[a2];
a3 := Table[(Subscript[x, i] - q[[i]] + .5)^2/q[[i]], {i, Length[q]}]
obj3 = Total[a3];
a4 := Table[(Subscript[x, i] - q[[i]] - .5)^2/q[[i]], {i, Length[q]}]
obj4 = Total[a4];

a5 := Table[(Subscript[x, i] - q[[i]])^2/q[[i]], {i, Length[q]}]
obj5 = Total[a5];
a6 := Table[(Subscript[x, i] - q[[i]])^2/Subscript[x,
i], {i, Length[q]}]
obj6 = Total[a6];

a7 := Table[q[[i]] Log[q[[i]]/Subscript[x, i]], {i, Length[q]}]
obj7 = Total[a7];

consl = ToExpression[
StringReplace[
ToString[Table[x[[i]] >= 0 , {i, Length[q]}]], {"{" -> "",
"}" -> "", "," -> " &&"}]] /. {x[[i_]] -> Subscript[x, i]};
int = ToExpression[
StringReplace[
ToString[
Table[x[[i]] \[Element] Integers, {i, Length[q]}]], {"{" -> "",
"}" -> "", "," -> " &&"}]] /. {x[[i_]] -> Subscript[x, i]};
r1 := Minimize[{obj1, Total[var] == 10 && consl && int}, var]
r12 := Minimize[{obj12, Total[var] == 10 && consl && int}, var]
r2 := Minimize[{obj2, Total[var] == 10 && consl && int}, var]
r3 := Minimize[{obj3, Total[var] == 10 && consl && int}, var]
r4 := Minimize[{obj4, Total[var] == 10 && consl && int}, var]
r5 := Minimize[{obj5, Total[var] == 10 && consl && int}, var]
r6 := Minimize[{obj6, Total[var] == 10 && consl && int}, var]
r7 := Minimize[{obj7, Total[var] == 10 && consl && int}, var]
r1
r2
r3
r4
r5
r6
r7


Furthermore, if for r6 and r7, I change the constraints in such way that every $x_i \geq 1$ the integer condition is no more satisfied. Note that NMaximise is of no help.

• First I would get rid of the subscripts and use x, x,..... (I think the general and good advice given repeatedly in this forum is not to use subscripts unless you really need them for display purposes.) Also you have constraints where x[i] >= 0 when your objective functions involve 1/x[i] (i.e., division by zero issues). Finally, I think just giving obj6 and its minimization issues is all that you need to show. There's too much other code that doesn't matter to solving the issues.
– JimB
Jul 7 '17 at 14:35
• Running your code gives a bunch of errors, from the consl and int lines. Jul 7 '17 at 14:54
• For using subscripts for display purpose, see Format and MakeBoxes. Example: mathematica.stackexchange.com/questions/17691/…→x-i Jul 7 '17 at 16:24

After changing Subscript[x,i] to x[i] things go a bit better. The minimization issues then seem only to be with obj6 and obj7:

obj6
(* (-2.243489392877124+x)^2/x+(-2.792430871862655+x)^2/x+
(-0.30380038433753265+x)^2/x+(-1.9358884828987566+x)^2/x+
(-2.7243908680239306+x)^2/x *)

obj7
(* 2.243489392877124 Log[2.243489392877124/x]+
2.792430871862655Log[2.792430871862655/x]+
0.30380038433753265 Log[0.30380038433753265/x]+
1.9358884828987566 Log[1.9358884828987566/x]+
2.7243908680239306 Log[2.7243908680239306/x] *)


One could do a brute force approach by generating all of the possible integer arrangements of 10, evaluating the objective functions, and selecting the combinations that minimize the objective functions.

z = Flatten[Permutations[#] & /@ IntegerPartitions[10, {5}], 1];

t6 = Table[{obj6 /. Table[x[j] -> z[[i, j]], {j, 5}], z[[i]]}, {i, Length[z]}];
Select[t6, #[] == Min[t6[[All, 1]]] &]
(* {{0.793125, {2, 3, 1, 2, 2}}} *)

t7 = Table[{obj7 /. Table[x[j] -> z[[i, j]], {j, 5}], z[[i]]}, {i, Length[z]}];
Select[t7, #[] == Min[t7[[All, 1]]] &]
(* {{0.474614, {2, 3, 1, 2, 2}}} *)
`