Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2010

[Date Index] [Thread Index] [Author Index]

Search the Archive

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.


  • Prev by Date: Re: understanding code
  • Next by Date: Re: Why does this pattern fail to match?
  • Previous by thread: Re: Can't read a package
  • Next by thread: Re: Finding local maxima in multidimensional array (efficiently)