How can I select the new maximums in a list?

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}}


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]

Mathematica graphics

Timings

Of all the above methods gives in answers and comments

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]

Mathematica graphics

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.


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 *)