4
$\begingroup$

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?

$\endgroup$
11
  • 6
    $\begingroup$ Why not DeleteDuplicates@FoldList[Max, s]? $\endgroup$
    – Carl Woll
    Commented Jun 22, 2021 at 17:14
  • 1
    $\begingroup$ 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. $\endgroup$ Commented Jun 22, 2021 at 17:38
  • $\begingroup$ 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. $\endgroup$
    – mikado
    Commented Jun 22, 2021 at 18:03
  • 2
    $\begingroup$ On my computer the DeleteDuplicates version is 4 - 10 times faster than the others. What kind of data are you testing on? $\endgroup$
    – Carl Woll
    Commented Jun 22, 2021 at 18:24
  • 1
    $\begingroup$ @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. $\endgroup$
    – ciao
    Commented Jun 22, 2021 at 19:31

1 Answer 1

3
$\begingroup$

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 *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.