# In a given unsorted list, find the maximal ascending sublists of at least two contiguous elements

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

• Strictly ascending or just nondescending? – Henrik Schumacher Sep 30 '18 at 10:58
• For reference this is also a Wolfram Challenge question "Ascending Sublists". – BBirdsell Oct 1 '18 at 2:52

Cases[Split[input, #2 > #1 &], {_, __}]


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

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

ascending[list_]:=Module[{len = Range @ Length @ list},
x = Append @ UnitStep[Differences[list] - 1];
d = Differences[Prepend @ 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)

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

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[] > endpos[], 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[] > endpos[], 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

Map[Take[a, #] &,
SequencePosition[
ListConvolve[{1, -1}, a, 1], {x_, y__} /; AllTrue[{y}, Positive],
Overlaps -> False
]
]