How to pick increasing numbers from the list

Question

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"?

Answer 1

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.

Answer 2

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}

Answer 3

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

Answer 4

Using patterns:

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

{5, 6, 7, 8}

Answer 5

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

Answer 6

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

Answer 7

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.

Answer 8

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]

Answer 9

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}

Answer 10

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}

Answer 11

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

Answer 12

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 !

Answer 13

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}

Answer 14

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

---

{5, 6, 7, 8}