4
$\begingroup$

In a given unsorted list, find the maximal (strictly) ascending sublists of at least two contiguous elements.

input={1, -1, 2, 3, 4, 0, -2, 5, 0} 

and

output={{-1,2,3,4},{-2,5}}
$\endgroup$
2
  • $\begingroup$ Strictly ascending or just nondescending? $\endgroup$ Commented Sep 30, 2018 at 10:58
  • 2
    $\begingroup$ For reference this is also a Wolfram Challenge question "Ascending Sublists". $\endgroup$
    – BBirdsell
    Commented Oct 1, 2018 at 2:52

7 Answers 7

5
$\begingroup$
SequenceCases[input, {a_, b__} /; Less[a, b]]

{{-1, 2, 3, 4}, {-2, 5}}

And, to shed two keystrokes from @1066's answer:

Split[input,Less]/.{_}:>(##&[])

{{-1, 2, 3, 4}, {-2, 5}}

$\endgroup$
2
  • $\begingroup$ Could you explain {_}:>(##&[])? I think that we are replacing singletons {_} with nothing, but don't understand how :>{##&[]) is accomplishing that... $\endgroup$
    – Jonah
    Commented Jul 29, 2021 at 23:38
  • 1
    $\begingroup$ @Jonah, please see this and this . $\endgroup$
    – kglr
    Commented Jul 30, 2021 at 16:18
4
$\begingroup$
Cases[Split[input, #2 > #1 &], {_, __}]

{{-1, 2, 3, 4}, {-2, 5}}

$\endgroup$
4
$\begingroup$

Here is a variation of @Henrik's answer that uses TakeList:

ascending[list_]:=Module[{len = Range @ Length @ list},
    x = Append[0] @ UnitStep[Differences[list] - 1];
    d = Differences[Prepend[0] @ x];
    b = Pick[len, Clip[d, {0, 1}], 1];
    e = Clip[d, {0, 0}, {1, 0}];
    spec = Pick[len, e, 1] + 1 - b;
    TakeList[Pick[list, x+e, 1], spec]
]

And, a variation of @user1066's answer that is a bit faster:

split2[list_] := DeleteCases[Split[list, Less], {_}]

According to my tests, ascending is the fastest:

a = RandomInteger[{-100, 100}, 10^6];

r1 = f[a]; //RepeatedTiming (* Henrik 1 *)
r2 = f2[a]; //RepeatedTiming (* Henrik 2 *)
r3 = ascending[a]; //RepeatedTiming
r4 = Cases[Split[a, #2>#1&], {_, __}]; //RepeatedTiming (* user 1066 *)
r5 = Split[a,Less]/.{_}:>(##&[]); //RepeatedTiming (* kglr 2 *)
r6 = split2[a]; //RepeatedTiming

r1 === r2 === r3 === r4 === r5 === r6

{1.1, Null}

{0.24, Null}

{0.17, Null}

{0.641, Null}

{0.67, Null}

{0.39, Null}

True

(I didn't include @kglr's first answer or @swish's answer because they are orders of magnitude slower)

$\endgroup$
2
$\begingroup$
f[a_] := Module[{b, startpos, endpos},
 
 b = Differences[Subtract[1 , UnitStep[-Differences[a]]]];
 (* for "nondescending" use this instead:*)
 (* b = Differences[UnitStep[Differences[a]]];*)
 startpos = Flatten[Position[b, 1]] + 1;
 endpos = Flatten[Position[b, -1]] + 1;
 If[startpos[[-1]] > endpos[[-1]], endpos = Join[endpos, {Length[a]}]];
 If[startpos[[1]] > endpos[[1]], startpos = Join[{1}, startpos]];
 Take[a, #] & /@ Transpose[{startpos, endpos}]
 ]

Now,

f[{1, -1, 2, 3, 4, 0, -2, 5, 0}]

{{-1, 2, 3, 4}, {-2, 5}}

Edit

Here is the same function accelerated by Nearest (instead of Position) and a compiled routine to produce the sublists (instead of Take):

f2[a_] := Module[{b, startpos, endpos},
  b = Differences[Subtract[1, UnitStep[-Differences[a]]]];
  (*b=Differences[UnitStep[Differences[a]]];*)
  {startpos, endpos} = Nearest[b -> Automatic, {1, -1}] + 1;
  If[startpos[[-1]] > endpos[[-1]], endpos = Join[endpos, {Length[a]}]];
  If[startpos[[1]] > endpos[[1]], startpos = Join[{1}, startpos]];
  Compile[{{a, _Integer, 1}, {startpos, _Integer}, {endpos, _Integer}},
    a[[startpos ;; endpos]],
    RuntimeAttributes -> {Listable},
    Parallelization -> True
    ][a, startpos, endpos]
  ]

Test:

a = RandomInteger[{-100, 100}, {1000000}];
r1 = f[a]; // RepeatedTiming // First
r2 = f2[a]; // RepeatedTiming // First
r1 == r2

1.0

0.23

True

$\endgroup$
0
2
$\begingroup$
Map[Take[a, #] &, 
    SequencePosition[
        ListConvolve[{1, -1}, a, 1], {x_, y__} /; AllTrue[{y}, Positive], 
        Overlaps -> False
    ]
]
$\endgroup$
1
$\begingroup$
list = {1, -1, 2, 3, 4, 0, -2, 5, 0};

Using SequenceSplit (new in 11.3}

Cases[{_, __}] @ SequenceSplit[list, a : {b_, c__} /; b < c :> a]

{{-1, 2, 3, 4}, {-2, 5}}

$\endgroup$
1
$\begingroup$
list = {1, -1, 2, 3, 4, 0, -2, 5, 0};

Grabbing the @eldo's pattern and using ReplaceList:

ReplaceList[Split[list, Less], {___, a : {b_, c__} /; b < c, ___} :> a]

{{-1, 2, 3, 4}, {-2, 5}}

Or using Pick:

AscendingSequenceQ[l_] := AllTrue[Differences[l], # > 0 && Length[#] == 1 &]

Pick[#, Not@*AscendingSequenceQ /@ #] &@Split[list, Less]

{{-1, 2, 3, 4}, {-2, 5}}

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.