Minimizing a function over a bounded domain with binary variables

Question

I want to minimize the following function: $$ f(m,n)= \sum_{i=1}^N\Big\{ \alpha_i(x_i-m)^T(x_i-m) \Big\} + \sum_{i=1}^N\Big\{\beta_i (x_i-n)^T(x_i-n) \Big\} $$ where $m,n$ are all 2-d vectors: $$ m:= (m_1,m_2) \in \mathbb{R}^2 \\ n:= (n_1,n_2)\in \mathbb{R}^2 $$ and $x=x_1,x_2,\ldots,x_N$ with each $x_i\in \mathbb{R}^2$. Here, for $N=4$:

x = {{1.63178, -0.62983}, {0.981694, 0.337312}, {-0.00322503, 3.09137}, {2.19321, 3.3283}}

Finally $\alpha_i$ and $\beta_i$ are supposed to be binary variables, 0 or 1, (there exists one for each $i$). I want to minimize with respect to $m_1,m_2,n_1,n_2$ and all $\alpha_i,\beta_i$.

Questions:

1. Take all $\alpha_i,\beta_i=1$. How exactly can I define this problem in MATHEMATICA?

My attempt: First I substract from $x$ the corresponding variables by hand (I could not achieve it automatically) and then flatten:

I flatten my $x$:

Xa = Flatten[{{0.6327234822658077, -0.048234500163371045} - m, {-0.46270679942806625, 0.3272500354702919} - m, {2.9648320580126826, 1.3635663834593037} - m, {1.5996244007719167, 2.4898065623150427} - m}];

Xb = Flatten[{{0.6327234822658077, -0.048234500163371045} - n, {-0.46270679942806625, 0.3272500354702919} - n, {2.9648320580126826, 1.3635663834593037} - n, {1.5996244007719167, 2.4898065623150427} - n}];

Note: this is a problem if the $x$ vector has length 10000.

Then I simply write down: Minimize[Transpose[Xa].Xa]+Transpose[Xb].Xb],{m1,m2,n1,n2}]. I do get answer ok. The question is: a. How to optimally subtract $m,n$ from $x$ if I have 10000s of entries? and $b. if this is the optimal way to minimize this function (I am doint it correct, right)?

2. How to include the binary variables $\alpha_i$ and $\beta_i$ in the same problem?

I am not sure how to define a $N$-dim binary vector so I write:

a={a1,a2,a3,4}

b={b1,b2,b3,b4}

And then:

$Z_m=\sum_i a_i \, (x_i-m), \quad Z_n=\sum_i b_i \, (x_i-n)$,

And I minimize:

Minimize[{ Transpose[Zm] . Zm + Transpose[Zn] . Zn, Element[{a1, a2, a3, a4, b1, b2, b3, b4}, Integers]}, {m1, m2, n1, n2, a1, a2, a3, a4, b1, b2, b3, b4}]

Of course I get nonsense. Any help?

Answer 1

Some algebraic simplification can be done to get explicit values of the means that minimize $f$. (And minimizing the sum of the two parts is actually unnecessary in this case in that the two sets of means can be estimated separately.)

We can write the summands in the summations in the following manner:

α[i] Transpose[{x[i, 1], x[i, 2]} - {m[1], m[2]}] . ({x[i, 1], x[i, 2]} - {m[1], m[2]}) // Expand
(* m[1]^2 α[i] + m[2]^2 α[i] - 2 m[1] x[i, 1] α[i] + x[i, 1]^2 α[i] - 2 m[2] x[i, 2] α[i] + x[i, 2]^2 α[i] *)

β[i] Transpose[{x[i, 1], x[i, 2]} - {n[1], n[2]}] . ({x[i, 1], x[i, 2]} - {n[1], n[2]}) // Expand
(* n[1]^2 β[i] + n[2]^2 β[i] - 2 n[1] x[i, 1] β[i] + x[i, 1]^2 β[i] - 2 n[2] x[i, 2] β[i] + x[i, 2]^2 β[i] *)

So we can rewrite f as

f = m[1]^2 Sum[α[i], {i, 1, k}] +
  m[2]^2 Sum[α[i], {i, 1, k}] -
  2 m[1] Sum[α[i] x[i, 1], {i, 1, k}] -
  2 m[2] Sum[α[i] x[i, 2], {i, 1, k}] +
  Sum[α[i] (x[i, 1]^x[i, 2]^2), {i, 1, k}] +
  
  n[1]^2 Sum[β[i], {i, 1, k}] +
  n[2]^2 Sum[β[i], {i, 1, k}] -
  2 n[1] Sum[β[i] x[i, 1], {i, 1, k}] -
  2 n[2] Sum[β[i] x[i, 2], {i, 1, k}] +
  Sum[β[i] (x[i, 1]^x[i, 2]^2), {i, 1, k}]

The values of the means that minimize f are found in the following manner:

Solve[D[f, {{m[1], m[2], n[1], n[2]}}] == 0, {m[1], m[2], n[1], n[2]}]

These formulas give the same values for the means whether or not one uses f or the two summations separately. Also, this vectorized approach allows for large numbers of observations in little time.

As a check this matches the values given by @ubpdqn:

xx = {{1.63178, -0.62983}, {0.981694, 0.337312}, {-0.00322503, 3.09137}, {2.19321, 3.3283}};
αα = {1, 0, 1, 1};
ββ = {1, 0, 1, 0};
(* m1 *)
xx[[All, 1]] . αα/Total[αα]
(* 1.27392 *)
(* m2 *)
xx[[All, 2]] . αα/Total[αα]
(* 1.92995 *)
(* n1 *)
xx[[All, 1]] . ββ/Total[ββ]
(* 0.814277 *)
(* n2 *)
xx[[All, 2]] . ββ/Total[ββ]
(* 1.23077 *)

Answer 2

I apologize if I have misunderstood. For the small size of the data provided you can use NMinimize as it is a least squares exercise. Firstly, note that there are a number of trivial cases. $\alpha_i=\beta_i=0$ the minimum will be 0. Further, the minimum will be 0 for 1 vector as you just subtract the same values.

For $\alpha_i=\beta_i=1$ for all $i$: you can use:

 x = {{1.63178, -0.62983}, {0.981694, 0.337312}, {-0.00322503, 
    3.09137}, {2.19321, 3.3283}};
xp = # - {m1, m2} & /@ x;
yp = # - {n1, n2} & /@ x;
sqx = # . # & /@ xp;
sqy = # . # & /@ yp;
NMinimize[Total@sqx + Total@sqy, {m1, m2, n1, n2}]

This yields: {28.8548, {m1 -> 1.20086, m2 -> 1.53179, n1 -> 1.20086, n2 -> 1.53179}}

The result is unsurprising as minimizing 2u is the same as minimizing u.

For all 256 binary possibilities:

f[u_, v_] := Quiet[{u, v, 
     Row[{NumberForm[#1, 4], 
       Row[NumberForm[#, 4] & /@ {{m1, m2}, {n1, n2}}, 
         Frame -> True] /. #2}, "   "]} & @@ 
   NMinimize[u . sqx + v . sqy, {m1, m2, n1, n2}, 
    WorkingPrecision -> 20]];

There are some numerical issues, so WorkingPrecision increased and Quiet to suppress errors. There were some negative small maxima for a non negative function. You can remove Quiet if you wish to see.

An example:

f[{1, 0, 1, 1}, {1, 0, 1, 0}]

yields:

where output is argument, minimum, {m1,m2},{n1,n2}: the latter 2 framed.

You can do all 256 but it is a very large output.

You can see it here: I suggest opening in new tab and zooming as desired.

I hope this is helpful.

If I have misunderstood I am happy to delete.

Comment: the computations could be halves as $f(\alpha_i,\beta_i)$ and $f(\beta_i,\alpha_i)$ yield same minimum (with m,n swapping roles).

Answer 3

If I correctly understand the question, this can be done in such a way, doing a loop over a[i] andb[j] (N is reserved in WL, so is replaced by k):

ClearAll["Global`*"]; x = {{1.63178, -0.62983}, {0.981694, 0.337312}, 
{-0.00322503, 3.09137}, {2.19321, 3.3283}};
m = {m1, m2}; n = {n1, n2}; k = 4;
f = Rationalize[Sum[a[i]*Transpose[x[[i]] - m] . (x[[i]] - m), {i, 1, k}], 
10^-10] + Rationalize[Sum[b[j]*Transpose[x[[j]] - n] . (x[[j]] - n), {j, 1, k}], 
10^-10];
Table [{Table[a[i], {i, 1, k}], Table[b[j], {j, 1, k}], Minimize[f, {n1, n2, m1, m2}]},
{a[2], 0, 1}, {a[1], 0, 1}, {a[3], 0, 1}, {a[4], 0, 1}, {b[2], 0, 1}, {b[1], 0, 1}, {b[3], 0, 1}, {b[4], 0, 1}]

{{{{{{{{{{0, 0, 0, 0}, {0, 0, 0, 0}, {0, {n1 -> -(12/5), n2 -> -(1/2), m1 -> -(9/5), m2 -> 3/5}}},...,{{{1, 1, 1, 1}, {1, 1, 1, 0}, {30531465367227314056388526953/ 1313827153041987000000000000, {n1 -> 2731243536997/ 3139060950000, n2 -> 699713/750000, m1 -> 10052233651427/8370829200000, m2 -> 382947/250000}}}, {{1, 1, 1, 1}, {1, 1, 1, 1}, {702042163964416370873686483/ 24330132463740500000000000, {n1 -> 10052233651427/ 8370829200000, n2 -> 382947/250000, m1 -> 10052233651427/8370829200000, m2 -> 382947/250000}}}}}}}}}}}