How to find the local minimum points in the multi-dimensional numerical data?

Question

I am trying to get some local minima of an n-dimensional function (which only has numerical form). For two-dimensional function data, we can find the local minimum points from the contour plot easily.

Now, I have a three-dimensional function data.

See the data here.

The variables x1,x2,and x3 are from 1 to 50 and the step is 1. Since I have sorted the data based on the f(x1,x2,x3) values, the global minimum point can be easily obtained, that is, -8.13526987(x1=11,x2=50,x3=50).

The problem is, how to find the other local minimum points for this data ?

Answer 1

You have quite a small data set, so a really inefficient brute force search will still run pretty fast (<1 sec on my computer). I stress that this is STUPID way to do it, and with list manipulation you can surely make it MUCH more efficient. But as I said - it works.

First, transform the data so that you could retrieve the data by calling f[x1,x2,x3], and unset values will be Infinity:

dat = Rest@Import["numdata.txt", "tsv"];
f[i_,j_,k_] := Infinity;
Table[f[d[[1]], d[[2]], d[[3]]] = d[[4]], {d, dat}];

Then simply iterate over all entries, and see which of them is larger than all its neighbors:

Last@Last@Reap@For[i = 1, i <= 50, i++,
   For[j = 1, j <= 50, j++,
    For[k = 1, k <= 50, k++,
     If[
      And[
       f[i, j, k] < f[i + 1, j, k],
       f[i, j, k] < f[i - 1, j, k],
       f[i, j, k] < f[i, j + 1, k],
       f[i, j, k] < f[i, j - 1, k],
       f[i, j, k] < f[i, j, k + 1],
       f[i, j, k] < f[i, j, k - 1]
       ],
      Sow[{i, j, k}]
      ]
     ]
    ]
   ]

Output:

{{4, 3, 3}, {9, 13, 15}, {9, 14, 14}, {10, 17, 2}, {10, 50, 1}, 
 {11, 8, 17}, {11, 15, 2}, {11, 50, 50}, {15, 5, 15}, {15, 10, 3},
 {16, 6, 12}, {16, 7, 9}, {16, 8, 7}, {16, 9, 5}, {16, 10, 4}, 
 {50, 50, 50}}

These are the positions of all the local minima.