# How can I select the new maximums in a list?

I want to select the new maximums from a random permutation. For example if RandomSample[Range, 10] returns {6, 9, 2, 4, 3, 10, 8, 1, 7, 5}

I want the list of elements that are greater than each of their predecessors. I want the list {6,9,10}.

• DeleteDuplicates@FoldList[Max, {6, 9, 2, 4, 3, 10, 8, 1, 7, 5}]? – kglr Mar 25 '17 at 23:25
• or lst={6, 9, 2, 4, 3, 10, 8, 1, 7, 5}; Union[Map[Max, Table[Take[lst, i], {i, 1, Length[lst]}]]] – user46676 Mar 25 '17 at 23:28
• Yes! Thank you. – Geoffrey Critzer Mar 25 '17 at 23:38

direct[lst_] := Module[{n, max = -Infinity},
Do[
If[lst[[n]] > max,
max = lst[[n]];
Sow[max]
],
{n, 1, Length@lst}
]
]

lst={6,9,2,4,3,10,8,1,7,5};
Last@Reap@direct[lst] ## Timings

ClearAll[f1,f2,f3,f4,g1]
f1=DeleteDuplicates@FoldList[Max,#]&;
f2=Module[{a=#,b=Range[Length@#]},a[[Pick[b,a[[#]]>=Max[a[[;;#]]]&/@b]]]]&;
f3=Module[{a=#},MapIndexed[If[#>=Max[a[[;;#2[]]]],#,##&[]]&,a]]&;
f4=Module[{a=#,b={First@#}},While[(a=Rest@DeleteCases[a,_?(#<a[]&)])=!={},AppendTo[b,First@a]];b]&;
g1[lst_]:=Module[{i},Union[Map[Max,Table[Take[lst,i],{i,1,Length[lst]}]]]];
lst=RandomSample[Range,44000];


And

data={First@AbsoluteTiming[Last@Reap@direct[lst]],
First@AbsoluteTiming[f1[lst]],
First@AbsoluteTiming[f2[lst]],
First@AbsoluteTiming[f3[lst]],
First@AbsoluteTiming[f4[lst]],
First@AbsoluteTiming[g1[lst]]};
Grid[{{"direct","f1","f2","f3","f4","g1"},data},Frame->All] Warning. do not run g1 method on more than 50,000. Mathematica will hang and the PC will hang as well. I have 16 GB and Mathematica always almost crash the PC when using something close to 50,000 with g1 method.

ClearAll[f1, f2, f3, f4]
f1 = DeleteDuplicates@FoldList[Max, #] &;
f2 = Module[{a = #, b = Range[Length@#]}, a[[Pick[b, a[[#]] >= Max[a[[;; #]]] & /@ b]]]] &;
f3 = Module[{a = #}, MapIndexed[If[# >= Max[a[[;; #2[]]]], #, ## &[]] &, a]] &;
f4 = Module[{a = #, b = {First@#}},
While[(a = Rest@DeleteCases[a, _?(# < a[] &)])=!={}, AppendTo[b, First@a]]; b] &;

# @ {6, 9, 2, 4, 3, 10, 8, 1, 7, 5} & /@ {f1, f2, f3, f4}


{{6, 9, 10}, {6, 9, 10}, {6, 9, 10}, {6, 9, 10}}

It is efficient to do this in reverse. Find the maximum of the whole list, then everything to the right of that can be removed. Then repeat this process recursively.

f[x_] := With[{p = Ordering[x, -1][]}, Sow[x[[p]]]; If[p > 1, f[x[[;; p - 1]]]]]
f[{x_}] := Sow[x]
maxes[x_] := Reverse[Reap[f[x]][[2, 1]]]


The speed compares favourably with kglr's f1:

x = RandomSample[Range[10^6]];

RepeatedTiming[a = f1[x];]
(* {0.164, Null} *)

RepeatedTiming[b = maxes[x];]
(* {0.00571, Null} *)

a == b
(* True *)