# 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}? Dec 5, 2013 at 21:47
• @Peltio I wanted in {5,6,7,8} order Dec 5, 2013 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. Dec 5, 2013 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 Dec 6, 2013 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. Dec 7, 2013 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? Dec 7, 2013 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. Dec 7, 2013 at 17:42

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};? Dec 7, 2013 at 4:27
• @ChrisDegnen Thanks! There was a small bug. Now it returns {5, 6, 7, 8} as expected. Dec 7, 2013 at 10:38
• Shouldn't {5,3,2,4,2,7,5,6,3,8} give {5,7,8}? Dec 7, 2013 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}. Dec 7, 2013 at 18:19

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

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]; Dec 7, 2013 at 4:06

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. Dec 7, 2013 at 18:56

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}