# 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}? Commented Dec 5, 2013 at 21:47
• @Peltio I wanted in {5,6,7,8} order Commented 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. Commented 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 Commented 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. Commented 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? Commented 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. Commented 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[#[[1]] - Rest[#]], 0], #[[1]]] &@
{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[#[[1]] - Rest[#]], 0], #[[1]]] &@
{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};? Commented Dec 7, 2013 at 4:27
• @ChrisDegnen Thanks! There was a small bug. Now it returns {5, 6, 7, 8} as expected. Commented Dec 7, 2013 at 10:38
• Shouldn't {5,3,2,4,2,7,5,6,3,8} give {5,7,8}? Commented 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}. Commented 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]; Commented 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. Commented 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}

Using FoldList

Union @ FoldList[Max, list]


{5, 6, 7, 8}

Using SequenceCases (new in 10.1)

First /@ SequenceCases[list, x_ /; Greater @@ x]


{5, 6, 7, 8}

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

asc = SequenceReplace[lst, {a_, b_} /; b <= a :> a]


{5, 6, 7, 8}

FirstPosition[lst, #] & /@ asc


{{1}, {3}, {5}, {7}}

• +1 - I think you don't need the Sequence @@ before the a
– eldo
Commented Mar 23 at 15:53
• Updated/ Thanks for spotting. @eldo
– Syed
Commented Mar 23 at 15:54

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 !

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


An alternative, although slow, is the following:

Last@Select[Subsets[lst, {2, Length@lst}], ContainsOnly[Differences[#], {1}] &]


{5, 6, 7, 8}

lst = {5, 3, 6, 2, 7, 4, 8};
DeleteDuplicates[lst, Greater]


{5, 6, 7, 8}