How to pick increasing numbers from the list

How to pick increasing numbers from the list.

lst = {5, 3, 6, 2, 7, 4, 8};

out:

{5,6,7,8}

So many interesting answers, is it possible know the index of result elements or position of elements with respect to the old "lst"?

• You want increasing numbers with respect to the new list or increasing numbers with respect to the previous element of the old list? Output for {5, 3, 2, 4, 2, 7, 5, 6,3, 8} should be {5,7,8} or {5,4,7,6,8}? – Peltio Dec 5 '13 at 21:47
• @Peltio I wanted in {5,6,7,8} order – Thomas Dec 5 '13 at 21:54
• Problem is that the example you provided produces the same output {5,6,7,8} with both methods. That's why I asked. But it appears the general consensus is to consider increasing with respect to the new list. – Peltio Dec 5 '13 at 21:58

Just to be different:

Block[{i = -∞}, Select[lst, # > i && (i = #) == i &]]

Note: Alexey Popkov points out that this solution relies on Select testing each element in turn from left to right, which is not documented.

• Short and sweet. +1 – Mr.Wizard Dec 6 '13 at 0:47
• +1. This elegant approach is based on the assumption that Select tests elements exactly from left to right, which is not documented. – Alexey Popkov Dec 7 '13 at 6:16
• @Simon I like your solution, but are you sure that mentioned behavior of Select will not be changed in future versions of Mathematica? I do think that it unlikely will be changed but I am not sure. What do you think? – Alexey Popkov Dec 7 '13 at 16:25
• @AlexeyPopkov, the fact that Select has a form which "picks out the first n elements for which crit[ei] is True" certainly suggests that the elements will be tested in order, but we cannot be certain, so it's a good point you raise. Of course even if the behaviour was documented, there would be no guarantee that it would not change in a future version. – Simon Woods Dec 7 '13 at 17:42

Folding is fine, but Flattening a nested list is faster than repeated Joining,
and Compileing is more than an order of magnitude faster yet.

upseq = Compile[{{a, _Integer, 1}}, Module[{b = a, n = 1},
Do[If[a[[i]] > b[[n]], b[[++n]] = a[[i]]], {i,2,Length[a]}]; b[[;;n]]]];

a = With[{n = 10^5}, Range@n + RandomInteger[999,n]];
Timing@Length[a1 =         Fold[If[#2 > Last@#1, Join[#1,{#2}], #1] &, {First@a}, Rest@a]]
Timing@Length[a2 = Flatten@Fold[If[#2 > Last@#1,      {#1,#2} , #1] &, {First@a}, Rest@a]]
Timing@Length[a3 = upseq@a]
SameQ[a1,a2,a3]

{1.19, 3942}
{0.55, 3942}
{0.02, 3942}
True

One can use LongestAscendingSequence with a small modification (you need to fix the first element)

Prepend[LongestAscendingSequence@Pick[Rest[#], UnitStep[#[] - Rest[#]], 0], #[]] &@
{5, 3, 6, 2, 7, 4, 8}

{5, 6, 7, 8}

It should be fast for a very long list.

Update

After OP's comment I propose

Prepend[Sort@Pick[Rest[#], UnitStep[#[] - Rest[#]], 0], #[]] &@
{5, 3, 2, 4, 2, 7, 5, 6, 3, 8}

{5, 6, 7, 8}

• What is your update doing with lst = {5, 3, 6, 2, 7, 4, 8};? – Chris Degnen Dec 7 '13 at 4:27
• @ChrisDegnen Thanks! There was a small bug. Now it returns {5, 6, 7, 8} as expected. – ybeltukov Dec 7 '13 at 10:38
• Shouldn't {5,3,2,4,2,7,5,6,3,8} give {5,7,8}? – Ray Koopman Dec 7 '13 at 17:58
• @RayKoopman I don't understand this logic, see OP's comment under the question. I prefer my first solution which gives {5,6,8}. – ybeltukov Dec 7 '13 at 18:19

For example:

lst = {5, 3, 6, 2, 7, 4, 8};
f = Fold[If[#2 > Last[#1], Join[#1, {#2}], #1] &, {First@lst}, Rest@lst]
(*
{5, 6, 7, 8}
*)

Edit:

You may get the corresponding indices by:

Position[lst, #] & /@ f

or

Position[lst, Alternatives @@ f]
(*
{{{1}}, {{3}}, {{5}}, {{7}}}
*)

Although there are probably faster alternatives

• If lst may contain duplicates then use Position[lst,#,1,1]& /@ f. – Ray Koopman Dec 7 '13 at 18:56

Using patterns:

lst //. {u___, v_, w___, x_, y___} /; x <= v :> {u, v, w, y}

{5, 6, 7, 8}

• This pattern is much slower than belisarius' version. Many seconds for lst = RandomInteger[3000, 3000]; – Chris Degnen Dec 7 '13 at 4:06

Another way via patterns:

{5, 3, 6, 2, 7, 4, 6, 8} //. {u___, v_, w_, z___} /; w <= v :> {u, v, z}
(*
{5, 6, 7, 8}
*)

This is a rough translation of how I would solve this problem in Haskell: Find maximum element so far, and then filter (which Mathematica calls Select) the elements that are equal to the max (and hence bigger than all previous elements).

list = {5, 3, 6, 2, 7, 4, 8};
maxUntil[{prev_, max_}, elem_] := {elem, Max[max, elem] };
listWithMax = FoldList[maxUntil, {First@list, First@list}, Rest@list]
(* listWithMax = {{5, 5}, {3, 5}, {6, 6}, {2, 6}, {7, 7}, {4, 7}, {8, 8}}*)
bothEqual[{p_, q_}] := p == q;
First /@ Select[listWithMax, bothEqual]
(* {5, 6, 7, 8} *)

Another approach to do the same thing is using zips (for which Mathematica has no nice name):

maxList = FoldList[Max, First@list, Rest@list]
listWithMax = Transpose[ {list, maxList} ]

and the rest of the code remains the same.

In Haskell, such maps and filters will be fused together; that is not the case in Mathematica, so these are not the most efficient implementation for large lists.

Hum, this is quite amusing. The code in my answer here also answers this question. The only adaptation that has to be made is that you have to change val != max into val > max, which was equivalent anyway. The positions that can be found by using getPositions (getPos) are the positions of the duplicate (in this case not increasing) elements. However, we can then easily find the positions of the elements of the increasing sequence in the original list, by doing something like

wrongPositions = getPos[];
Complement[Range[input//Length], wrongPositions]

Somewhat pedestrian :

lst = {5, 3, 6, 2, 7, 4, 8};

Module[{new = {}, a = 1, b, c, d},
While[True,
If[lst == {}, Break[]];
AppendTo[new, b = lst[[a]]];
If[a == Length[lst], Break[]];
c = Select[lst[[a + 1 ;;]], # > b &, 1];
If[c == {}, Break[], d = First[c]];
a = Position[lst, d][[1, 1]]];
new]

{5, 6, 7, 8}

This works as well :

DeleteDuplicates[ Table[ Max[Take[lst, i]], {i, 1, Length[lst]}]]

although I suspect it is not very efficient, $O(n^2)$ whereas $O(n)$ is achievable. Would be more pleasing if I knew how to do that without Table though !

With MovingMap

lst = {5, 3, 6, 2, 7, 4, 8};

Union @ Block[{m = -Infinity}, MovingMap[(m = Max[m, Max[#]]) &, lst, 1]]

{5, 6, 7, 8}