Splitting a list into increasing sublists
Here is a purely functional solution (i.e. not using mutable state), based in FoldList
(since the one based on linked lists has been already taken):
stepF =
Function @ With[{sum = First @ #1 + #2, len = #[[2]], prevsum = #1[[3]]},
If[sum > prevsum, {0, 0, sum, len + 1}, {sum, len + 1, prevsum, 0}]
];
getLengths[lst_List] :=
DeleteCases[0] @ Append[#, Length[lst] - Total[#]] & @
FoldList[stepF, {0, 0, 0, 0}, lst][[All, -1]];
splitInc[lst_] := Internal`PartitionRagged[lst, getLengths[lst]]
For example:
splitInc[lst]
(* {{1}, {2}, {3}, {4}, {3, 2}, {1, 2, 3}, {4, 3}, {2}} *)
The idea is to use FoldList
to determine the lengths of all sublists, and then split. At every iteration in FoldList
the function stepF
takes a list of 4 elements {currentSum, currentLength, previousSum, splitLengthOrZero}
as a first argument, and a next element of the original list as a second argument, and returns a modified list of 4 elements - working basically as a state machine. We then just have to pick those states where the last element (splitLengthOrZero
) is non-zero, and we get a list of lengths. In place of Internal`PartitionRagged
one could also use Mr.Wizard's dynP
.
a = {1, 2, 3, 4, 3, 2, 1, 2, 3, 4, 3, 2};
f = Module[{b, c, d, n},
b = {{First[#]}};
c = Rest[#];
Catch[
While[True,
n = 1; While[Total[d = Quiet@Check[Take[c, n],
Throw[AppendTo[b, c]]]] <= Total@Last[b], n++];
AppendTo[b, d];
c = Drop[c, n]]];
b] &;
f[a]
{{1}, {2}, {3}, {4}, {3, 2}, {1, 2, 3}, {4, 3}, {2}}
A bit more concise, seems at least as fast as those posted so far:
setter[list_] := Module[{fs = 0, t = First@list - 1, f, u},
f[x_] := If[(fs += x) > t, t = fs; fs = 0; True, False];
u = Union[Pick[Range@Length@list, f /@ list], {Length@list}];
MapThread[list[[#1 ;; #2]] &, {Prepend[Most@u, 0] + 1, u}]];