1
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – JimB Jul 7 '17 at 14:35
  • $\begingroup$ Running your code gives a bunch of errors, from the consl and int lines. $\endgroup$ – KraZug Jul 7 '17 at 14:54
  • $\begingroup$ For using subscripts for display purpose, see Format and MakeBoxes. Example: mathematica.stackexchange.com/questions/17691/…→x-i $\endgroup$ – Michael E2 Jul 7 '17 at 16:24
3
$\begingroup$

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}}} *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.