# How to improve the speed of NMaximize function

My problem is as follows: Consider a 5*5 matrix Obj with 0 and 1

Obj = Array[x, {5, 5}];


The objective function is:

 r = Total[Obj, 2];


We need to maximise the objective function with the following constraint: $x_{i,j} + x_{j,k}+x_{k,z} < 2$ where $i,j,k,z \in \{1,2,3,4,5\}$ and $i \neq j \neq k \neq z$. Our coding is as follows:

 vars = Union@Cases[r, x[_, _], Infinity];
t1 = Table[If[i != j, Obj[[i]][[j]], ex], {i, 1, 5}, {j, 1, 5}];

fn1[γ_, p_] :=
p1 = If[ Dimensions[p][[2]] == Dimensions[t1][[2]],  Drop[p, 0, {Flatten[Position[p, γ]][[1]]}], Drop[p, 0, {Flatten[ Position[p, t1[[Flatten[Position[t1, γ]][[2]]]][[ Flatten[Position[t1, γ]][[1]]]]] ][[2]]}] ]

fn2[γ_, p_] :=
Cases[fn1[γ, p][[Flatten[Position[t1, γ]][[2]]]], Except[ex]]

fn3[i_, j_] := { Tuples[{{i}, {Flatten[fn2[i, t1]][[Flatten[Position[Flatten[fn2[i, t1]], j]][[1]]]]}, Flatten[fn2[j, fn1[i, t1]]]}] }

vars3 = Flatten[ Total[Table[Map[fn3[i, #] & , Flatten[fn2[i, t1]]], {i,
Flatten[Cases[Flatten[t1], Except[ex]]]}], {-1}]]


The result from the above functions is that:

 {x[1, 2] + x[2, 3] + x[3, 4], x[1, 2] + x[2, 3] + x[3, 5],
x[1, 2] + x[2, 4] + x[4, 3], x[1, 2] + x[2, 4] + x[4, 5],
x[1, 2] + x[2, 5] + x[5, 3], x[1, 2] + x[2, 5] + x[5, 4],
x[1, 3] + x[2, 4] + x[3, 2], x[1, 3] + x[2, 5] + x[3, 2],
x[1, 3] + x[3, 4] + x[4, 2], x[1, 3] + x[3, 4] + x[4, 5],
x[1, 3] + x[3, 5] + x[5, 2], x[1, 3] + x[3, 5] + x[5, 4],
x[1, 4] + x[2, 3] + x[4, 2], x[1, 4] + x[2, 5] + x[4, 2],
x[1, 4] + x[3, 2] + x[4, 3], x[1, 4] + x[3, 5] + x[4, 3],
x[1, 4] + x[4, 5] + x[5, 2], x[1, 4] + x[4, 5] + x[5, 3],
x[1, 5] + x[2, 3] + x[5, 2], x[1, 5] + x[2, 4] + x[5, 2],
x[1, 5] + x[3, 2] + x[5, 3], x[1, 5] + x[3, 4] + x[5, 3],
x[1, 5] + x[4, 2] + x[5, 4], x[1, 5] + x[4, 3] + x[5, 4],
x[1, 3] + x[2, 1] + x[3, 4], x[1, 3] + x[2, 1] + x[3, 5],
x[1, 4] + x[2, 1] + x[4, 3], x[1, 4] + x[2, 1] + x[4, 5],
x[1, 5] + x[2, 1] + x[5, 3], x[1, 5] + x[2, 1] + x[5, 4],
x[1, 4] + x[2, 3] + x[3, 1], x[1, 5] + x[2, 3] + x[3, 1],
x[2, 3] + x[3, 4] + x[4, 1], x[2, 3] + x[3, 4] + x[4, 5],
x[2, 3] + x[3, 5] + x[5, 1], x[2, 3] + x[3, 5] + x[5, 4],
x[1, 3] + x[2, 4] + x[4, 1], x[1, 5] + x[2, 4] + x[4, 1],
x[2, 4] + x[3, 1] + x[4, 3], x[2, 4] + x[3, 5] + x[4, 3],
x[2, 4] + x[4, 5] + x[5, 1], x[2, 4] + x[4, 5] + x[5, 3],
x[1, 3] + x[2, 5] + x[5, 1], x[1, 4] + x[2, 5] + x[5, 1],
x[2, 5] + x[3, 1] + x[5, 3], x[2, 5] + x[3, 4] + x[5, 3],
x[2, 5] + x[4, 1] + x[5, 4], x[2, 5] + x[4, 3] + x[5, 4],
x[1, 2] + x[2, 4] + x[3, 1], x[1, 2] + x[2, 5] + x[3, 1],
x[1, 4] + x[3, 1] + x[4, 2], x[1, 4] + x[3, 1] + x[4, 5],
x[1, 5] + x[3, 1] + x[5, 2], x[1, 5] + x[3, 1] + x[5, 4],
x[1, 4] + x[2, 1] + x[3, 2], x[1, 5] + x[2, 1] + x[3, 2],
x[2, 4] + x[3, 2] + x[4, 1], x[2, 4] + x[3, 2] + x[4, 5],
x[2, 5] + x[3, 2] + x[5, 1], x[2, 5] + x[3, 2] + x[5, 4],
x[1, 2] + x[3, 4] + x[4, 1], x[1, 5] + x[3, 4] + x[4, 1],
x[2, 1] + x[3, 4] + x[4, 2], x[2, 5] + x[3, 4] + x[4, 2],
x[3, 4] + x[4, 5] + x[5, 1], x[3, 4] + x[4, 5] + x[5, 2],
x[1, 2] + x[3, 5] + x[5, 1], x[1, 4] + x[3, 5] + x[5, 1],
x[2, 1] + x[3, 5] + x[5, 2], x[2, 4] + x[3, 5] + x[5, 2],
x[3, 5] + x[4, 1] + x[5, 4], x[3, 5] + x[4, 2] + x[5, 4],
x[1, 2] + x[2, 3] + x[4, 1], x[1, 2] + x[2, 5] + x[4, 1],
x[1, 3] + x[3, 2] + x[4, 1], x[1, 3] + x[3, 5] + x[4, 1],
x[1, 5] + x[4, 1] + x[5, 2], x[1, 5] + x[4, 1] + x[5, 3],
x[1, 3] + x[2, 1] + x[4, 2], x[1, 5] + x[2, 1] + x[4, 2],
x[2, 3] + x[3, 1] + x[4, 2], x[2, 3] + x[3, 5] + x[4, 2],
x[2, 5] + x[4, 2] + x[5, 1], x[2, 5] + x[4, 2] + x[5, 3],
x[1, 2] + x[3, 1] + x[4, 3], x[1, 5] + x[3, 1] + x[4, 3],
x[2, 1] + x[3, 2] + x[4, 3], x[2, 5] + x[3, 2] + x[4, 3],
x[3, 5] + x[4, 3] + x[5, 1], x[3, 5] + x[4, 3] + x[5, 2],
x[1, 2] + x[4, 5] + x[5, 1], x[1, 3] + x[4, 5] + x[5, 1],
x[2, 1] + x[4, 5] + x[5, 2], x[2, 3] + x[4, 5] + x[5, 2],
x[3, 1] + x[4, 5] + x[5, 3], x[3, 2] + x[4, 5] + x[5, 3],
x[1, 2] + x[2, 3] + x[5, 1], x[1, 2] + x[2, 4] + x[5, 1],
x[1, 3] + x[3, 2] + x[5, 1], x[1, 3] + x[3, 4] + x[5, 1],
x[1, 4] + x[4, 2] + x[5, 1], x[1, 4] + x[4, 3] + x[5, 1],
x[1, 3] + x[2, 1] + x[5, 2], x[1, 4] + x[2, 1] + x[5, 2],
x[2, 3] + x[3, 1] + x[5, 2], x[2, 3] + x[3, 4] + x[5, 2],
x[2, 4] + x[4, 1] + x[5, 2], x[2, 4] + x[4, 3] + x[5, 2],
x[1, 2] + x[3, 1] + x[5, 3], x[1, 4] + x[3, 1] + x[5, 3],
x[2, 1] + x[3, 2] + x[5, 3], x[2, 4] + x[3, 2] + x[5, 3],
x[3, 4] + x[4, 1] + x[5, 3], x[3, 4] + x[4, 2] + x[5, 3],
x[1, 2] + x[4, 1] + x[5, 4], x[1, 3] + x[4, 1] + x[5, 4],
x[2, 1] + x[4, 2] + x[5, 4], x[2, 3] + x[4, 2] + x[5, 4],
x[3, 1] + x[4, 3] + x[5, 4], x[3, 2] + x[4, 3] + x[5, 4]}


Then, we use the NMaximise to solve this problem:

       Incsolution[r_] := NMaximize[{r, And @@ Map[GreaterEqual[ 1, #, 0] &, vars]
&& vars ∈ Integers
&& And @@ Map[GreaterEqual[2, #] &, vars3]}, vars];

solution= Incsolution[r][[1]];


Our problem is that when we try 25*25 matrix, the speed is very slow. Is there any solution to solve this problem like using Compile function (using C)? I have tried Compile but failed.

First, notice that any nxn array of binary numbers corresponds to exactly one integer between 0 and (2^n)^2 - 1. You could, for example, use

Partition[
IntegerDigits[415, 2, 5^2],
5
]


to generate the 5x5 matrix which corresponds to the number 415. Thus, you actually have only one single integer input parameter n, with 0 <= n <= 33554431.

You can use a compiled function to test a given number n for your constraint. A very naive implementation could be

testfun = With[{rank = 5},
Compile[{{n, _Integer}},
Module[{good = True, i, j, k, z},
(* generate the list of binary digits of n *)
With[{q = IntegerDigits[n, 2, rank^2]},
good = True;
(* test the condition for all combinations of i,j,k,z *)
Do[
If[
DuplicateFreeQ[{i, j, k, z}] && (q[[(i - 1) rank + j]] + q[[(j - 1) rank + k]] + q[[(k - 1) rank + z]] >= 2),
(* if a (i,j,k,z)-tuple is encountered for which
the condition does not hold, abort *)
good = False; Return[]
],
{i, 1, rank}, {j, 1, rank}, {k, 1, rank}, {z, 1, rank}
];
(* if this input is good, return the generating number;
otherwise return 0 *)
If[good, n, 0]
]
],
RuntimeAttributes -> Listable
]
]


Here I worked directly with the list of digits (a 1-dimensional array), instead of the partitioned 2-dimensional array, but you may use Partition, as shown above.

Using this compiled function, you can just test all the numbers from 0 to 33554431, and then pick the one for which your objective function Total[IntegerDigits[#,2]]& is maximal. For example

(* find all numbers which survive the test *)
goodNumbers = testfun[Range[0, 33554431]] /. (0) -> Nothing;

MaximalBy[goodNumbers, Total[IntegerDigits[#, 2]] &]


Due to my naive implementation of the test function this is still extremely slow! But I suppose this should give you a good starting point.

• I just discovered a bug using Compile and DuplicateFreeQ (see mathematica.stackexchange.com/q/149343/35390), so be careful with this. It seemed to work with Module[{good = True, ... though. – JEM_Mosig Jun 29 '17 at 12:16