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