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}}
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}}
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}}
{_}:>(##&[])
? I think that we are replacing singletons {_}
with nothing, but don't understand how :>{##&[])
is accomplishing that...
$\endgroup$
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[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)
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}}
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
Map[Take[a, #] &,
SequencePosition[
ListConvolve[{1, -1}, a, 1], {x_, y__} /; AllTrue[{y}, Positive],
Overlaps -> False
]
]
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}}
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}}