       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

In:= threshold = Quantile[Flatten[randTable], .999]

Out= 0.998989

In:= top = Position[randTable, x_ /; x > threshold];

In:= arrayBoundsCheck[array_, index_] :=
If[index == {}, True,
First[index] > 0 && First[index] <= Length[array] &&
arrayBoundsCheck[array[[First[index]]], Rest[index]]]

In:= 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:= localMax[line_, array_] :=
Extract[array, line] >
Max[Extract[array,
Select[Map[Function[s, s + line], maxKernel],
arrayBoundsCheck[array, #] &]]]

In:= Timing[results = Select[top, localMax[#, randTable] &];]

Out= {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.

```

• Prev by Date: Re: understanding code
• Next by Date: Re: Why does this pattern fail to match?