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