# Finding extremes in discrete data by the fastest code

everybody! I'm new and that's my first post.

I have such a problem: need to extract from a matrix (with dimensions n x 2) such points which have second coordinate smaller than -500 or higher than 500. That's the first step. I did:

momentWysokosc = ParallelTable[{0.001 i, RandomInteger[{-1000, 1000}]}, {i, 1, 100}]
dol = -500;
gora = 500;
doMin = Parallelize[Select[momentWysokosc, #[] < dol &]]
doMax = Parallelize[Select[momentWysokosc, #[] > gora &]]
wszystkie = Parallelize[Union[doMin, doMax]]
Show[ListLinePlot[momentWysokosc, PlotStyle -> Green],
ListPlot[doMin, PlotMarkers -> "*", PlotRange -> All,
PlotStyle -> Directive[PointSize[Large], Blue]],
ListPlot[doMax, PlotMarkers -> "*", PlotRange -> All,
PlotStyle -> Directive[PointSize[Large], Red]],
GridLines -> {{}, {dol, gora}}]


But any point from doMin cannot be next to the point from doMax. I need {min, max, min, max, ...} (or {max, min, max, ...}).

The most important thing for me is to have the code as fast as possible because actually, I have to use that for approximately 1300000 points and do something else. Values dol and gora will change dynamically and the plot will change dynamically because of them, too. But I need a fast code for that. Whatever I wrote was too slow and I couldn't choose only the right points – I always chose some wrong points. Please, help me find only the right extremes. Maybe my approach is wrong from the very beginning, I don't know. I have two computers with Mathematica:

1st: 6 cores, Windows 10, Mathematica 8.0

2st: 16 cores, Windows 10, Mathematica 7.0

Sorry for my possibly poor English, I'm from Poland. Thank You in advance.

• So if you find that there is a value of 600 at position 3, and then one with value 700 at position 5, and then one with value -800 at position 7, what do you do? Do you ignore the one with value 700 because it cannot come after the one with value 600? Assuming that position 4 and 6 are in between -500 och 500, should the final sequence be {600, -800}? – C. E. May 15 '19 at 17:29
• I don't ignore 700 because in "doMax" it's next to 600 (one position after 600) and 700 is higher than 600 so I should choose 700. So the final sequence should be {700, -800}. – Lewis Hamilton-Fan May 15 '19 at 17:45

With large data, you should try to keep it in packed arrays. Since the first column of you matrix consists of real numbers while the second one contains only integers, you sould consider to store the columns as separate vectors like so:

n = 130;
x = 0.001 Range[n];
i = RandomInteger[{-1000, 1000}, n];


Now, the filtering can be done as follows:

lowertreshold = -500;
uppertreshold = 500;
lowerpos = RandomPrivatePositionsOf[UnitStep[lowertreshold - i], 1];
upperpos = RandomPrivatePositionsOf[UnitStep[i - uppertreshold], 1];


RandomPrivatePositionsOf is an undocumented function. In this case, it is equivalent to

lowerpos = Pick[Range[Length[i]], UnitStep[lowertreshold - i], 1];
upperpos = Pick[Range[Length[i]], UnitStep[i - uppertreshold], 1];


but only a bit faster. This gives you the positions of the elements that you put into your lists doMin and doMax.

So the plot could be obtained with, e.g.,

Show[
ListLinePlot[Transpose[{x, i}], PlotStyle -> Darker@Green],
ListPlot[Transpose[{x[[lowerpos]], i[[lowerpos]]}],
PlotMarkers -> "*",
PlotRange -> All,
PlotStyle -> Directive[PointSize[Large], Darker@Blue]
],
ListPlot[Transpose[{x[[upperpos]], i[[upperpos]]}],
PlotMarkers -> "*",
PlotRange -> All,
PlotStyle -> Directive[PointSize[Large], Darker@Red]
],
GridLines -> {{}, {lowertreshold, uppertreshold}}
]

• I believe you have missed the part about selecting only the largest value in a stretch of values larger than 500 or only the smallest number in a stretch of values smaller than -500. – C. E. May 15 '19 at 18:00
• Oh, I knew somehow that it could not be that simple. =| I merely focused on speeding up what was already there. I'll leave it as is for the moment and delete the post later. Maybe one or two things might be of interest for OP. – Henrik Schumacher May 15 '19 at 18:01
• I don't think there is any harm in leaving it. I learned about PositionsOf from it. – C. E. May 15 '19 at 18:07

Here's a way to implement it, not sure the speed at the moment. It can all be lumped together into a one-liner, but breaking it up...

momentWysokosc = Table[{i, RandomInteger[{-1000, 1000}]}, {i, 1, 100}];
dol = -500;
gora = 500;
w2 = Select[momentWysokosc, (#[] < dol || #[] > gora ) &];


The term w2 has only greater than dol or less than gora. Note I used integers for the first term in momentWysokosc too. Didn't see a reason to use floats since it acts like an index.

This splits w2 into continual sublists of positive or negative values.

res = SplitBy[w2, Last[#1] < 0 &]


This finishes off the problem by finding the best point in each sublist.

final = Partition[Flatten@Map[MaximalBy[#, Abs[Last[#]] &] &, res],2]


With number of points = 50...

Show[ListLinePlot[w2, PlotStyle -> Darker@Green],
ListPlot[w2, PlotMarkers -> "*", PlotRange -> All, PlotStyle -> Directive[PointSize[Large], Blue]],
ListLinePlot[final, PlotStyle -> Lighter@Red],
GridLines -> {{}, {dol, gora}}
]


As an experiment, it took 3 seconds for 100,000 points. • Integers as first coordinates are OK, my real data are actually different than random numbers (I import data from files), but wrote random values as an example because it's not a problem. The first coordinates in my files increase by 0.001 so I did it here the same way. Thank You very much for interesting codes (both @Henrik and @Mike). The only issue is neither Mathematica 7.0 nor 8.0 has a function MaximalBy, but probably within a day, I will try to change that function by something else. – Lewis Hamilton-Fan May 15 '19 at 21:39
• There should be a way to sweep through the data in a single pass, I just didn’t run down that rathole. Best of luck! – MikeY May 16 '19 at 0:25