# High-water marks of a sequence

I need to write a function that is, given a sequence of integers, extracts the subsequence of its high-water marks (i.e. distinct values of its running maximum). Here are some naïve implementations that immediately come to mind:

HighWaterMarks[s_?VectorQ] :=
Split[FoldList[Max, s]][[All, 1]]; (* slow *)

HighWaterMarks[s_?VectorQ] :=
Drop[Fold[If[Last[#1] < #2, Append[#1, #2], #1] &, {-∞}, s], 1];

HighWaterMarks[s_?VectorQ] :=
Reap[Block[{max = -∞}, Do[If[n > max, Sow[max = n]], {n, s}]]][[2, 1]];


Is there a simpler or more efficient way to do this?

• Why not DeleteDuplicates@FoldList[Max, s]? Commented Jun 22, 2021 at 17:14
• It is about as slow as my first version (about x1.5 slower than the other two). In general, DeleteDuplicates does not know that the input is a monotone sequence, where all equal elements are adjacent, and it needs to maintains a set of already encountered values. Commented Jun 22, 2021 at 17:38
• Are you optimising for very long lists or lots of short lists? Are your numbers in a random order, or might they tend to increase? This tells you which branch you need to focus on. Commented Jun 22, 2021 at 18:03
• On my computer the DeleteDuplicates version is 4 - 10 times faster than the others. What kind of data are you testing on? Commented Jun 22, 2021 at 18:24
• @DavidG.Stork: See the quotes? It's the OP in comments. But now that I read the comments again, I think the OP is referring to the result of the Fold. Mea culpa.
– ciao
Commented Jun 22, 2021 at 19:31

For comparative timings, starting with a fresh kernel:

\$Version

(* "12.3.0 for Mac OS X x86 (64-bit) (May 10, 2021)" *)

Clear["Global*"]

HighWaterMarks[1][s_?VectorQ] :=
Split[FoldList[Max, s]][[All, 1]];

HighWaterMarks[2][s_?VectorQ] :=
Drop[Fold[If[Last[#1] < #2, Append[#1, #2], #1] &, {-∞}, s], 1];

HighWaterMarks[3][s_?VectorQ] :=
Reap[Block[{max = -∞},
Do[If[n > max, Sow[max = n]], {n, s}]]][[2, 1]];

HighWaterMarks[4][s_?VectorQ] :=
DeleteDuplicates@FoldList[Max, s];


The test sequence is

SeedRandom[1234];
seq = RandomInteger[10^6, 10^6];


The test using RepeatedTiming is

time[n_Integer?Positive] :=
RepeatedTiming[result[n] = HighWaterMarks[n][seq];][[1]]


The average times (trimmed mean) are

times = time /@ Range[4]

(* {0.220534, 0.840865, 0.338244, 0.0717656} *)


The relative times are

times/Min[times]

(* {3.07298, 11.7168, 4.71317, 1.} *)


Verifying that all results are identical

SameQ @@ (result /@ Range[4])

(* True *)


The number of high-water marks is

Length@result[1]

(* 14 *)
`