Minimization with constraints

Question

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[1], x[2],..... (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 07 '17 at 14:35
Running your code gives a bunch of errors, from the consl and int lines. — SPPearce, Jul 07 '17 at 14:54
For using subscripts for display purpose, see Format and MakeBoxes. Example: https://mathematica.stackexchange.com/questions/17691/how-to-automate-xi→x-i — Michael E2, Jul 07 '17 at 16:24

score 3 · Answer 1 · answered Jul 07 '17 at 15:11

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[1])^2/x[1]+(-2.792430871862655`+x[2])^2/x[2]+ 
(-0.30380038433753265`+x[3])^2/x[3]+(-1.9358884828987566`+x[4])^2/x[4]+
(-2.7243908680239306`+x[5])^2/x[5] *)

obj7
(* 2.243489392877124` Log[2.243489392877124`/x[1]]+
2.792430871862655`Log[2.792430871862655`/x[2]]+
0.30380038433753265` Log[0.30380038433753265`/x[3]]+
1.9358884828987566` Log[1.9358884828987566`/x[4]]+
2.7243908680239306` Log[2.7243908680239306`/x[5]] *)

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, #[[1]] == 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, #[[1]] == Min[t7[[All, 1]]] &]
(* {{0.474614, {2, 3, 1, 2, 2}}} *)

Minimization with constraints

1 Answers1