# 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], 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
Commented Mar 25, 2017 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
Commented Mar 25, 2017 at 23:28
• Yes! Thank you. Commented Mar 25, 2017 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[[1]]]]],#,##&[]]&,a]]&;
f4=Module[{a=#,b={First@#}},While[(a=Rest@DeleteCases[a,_?(#<a[[1]]&)])=!={},AppendTo[b,First@a]];b]&;
g1[lst_]:=Module[{i},Union[Map[Max,Table[Take[lst,i],{i,1,Length[lst]}]]]];
lst=RandomSample[Range[44000],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[[1]]]]], #, ## &[]] &, a]] &;
f4 = Module[{a = #, b = {First@#}},
While[(a = Rest@DeleteCases[a, _?(# < a[[1]] &)])=!={}, 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][[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 *)

list = {6, 9, 2, 4, 3, 10, 8, 1, 7, 5};


Using IncreasingFilter by Sander Huisman

IncreasingFilter = ResourceFunction["IncreasingFilter"];

IncreasingFilter[list, Order, "StrictlyIncreasing" -> True]


{6, 9, 10}

DeleteDuplicates[{6, 9, 2, 4, 3, 10, 8, 1, 7, 5}, Greater]

(* {6,9,10} *)


From the docs->Scope

// Delete elements that are preceded by at least one larger element:

DeleteDuplicates[{1, 7, 8, 4, 3, 4, 1, 9, 8, 9, 2}, Greater]

(* {1, 7, 8, 9, 9} *)


DeleteDuplicates[{1, 7, 8, 4, 3, 4, 1, 9, 8, 9, 2}, GreaterEqual]

(* {1, 7, 8, 9} *)

list = {6, 9, 2, 4, 3, 10, 8, 1, 7, 5};


Using Select:

Select[list, # == Max[Take[list, FirstPosition[list, #][[1]]]] &]


{6, 9, 10}