Finding local maxima in multidimensional array (efficiently)
- To: mathgroup at smc.vnet.net
- Subject: [mg114201] Finding local maxima in multidimensional array (efficiently)
- From: Julian Francis <julian.w.francis at gmail.com>
- Date: Fri, 26 Nov 2010 05:51:59 -0500 (EST)
Dear all,
How do I find the local maxima in a 4 Dimensional array.
e.g.
randTable = Table[Random[], {a, 1, 40}, {b, 1, 40}, {c, 1, 40}, {d, 1,
40}];
in this case there are 80 neighbours for each point (except at the
edges)
This is my best attempt, NB I take the highest 0.1% to reduce the
computational load:
In[11]:= threshold = Quantile[Flatten[randTable], .999]
Out[11]= 0.998989
In[13]:= top = Position[randTable, x_ /; x > threshold];
In[5]:= arrayBoundsCheck[array_, index_] :=
If[index == {}, True,
First[index] > 0 && First[index] <= Length[array] &&
arrayBoundsCheck[array[[First[index]]], Rest[index]]]
In[6]:= maxKernel =
DeleteCases[
Flatten[Table[{h, w, y, x}, {h, -1, 1}, {w, -1, 1}, {y, -1,
1}, {x, -1, 1}], 3], {0, 0, 0, 0}];
In[8]:= localMax[line_, array_] :=
Extract[array, line] >
Max[Extract[array,
Select[Map[Function[s, s + line], maxKernel],
arrayBoundsCheck[array, #] &]]]
In[15]:= Timing[results = Select[top, localMax[#, randTable] &];]
Out[15]= {80.59, Null}
Taking the top 0.1% as I have done is just done to try to bring the
compute time down, but isn't necessary to the problem.
I'm really just interested in finding a list of all the local maxima.
If someone has a much better solution, I would love to see it.
Thanks very much,
Julian.