Restricted accumulation of values

Question

Please consider the following list data. I was trying to accumulate data until the result turns positive the first time and finally found an approach. Maybe it's useful to others and maybe there are other (more efficient) approaches:

data={-1050, 50, 1001, 1950, 1950, 1950, 525, 0};

The same what Accumulate does can be done by FoldList:

Rest@FoldList[Plus, 0, data] == Rest@FoldList[#1 + #2 &, 0, data] == Accumulate@data
(*True*)

Now, one can add constraints to FoldList. For my problem I had to write:

Rest[FoldList[If[#1 + #2 < #2, #1 + #2, #2] &, 0, #]]&@data
(*{-1050, -1000, 1, 1950, 1950, 1950, 525, 0}*)

Question

How can this be improved, either in terms of speed or elegance?

Answer 1

Here is another way:

With[{acc = Accumulate@data}, acc[[;; -#]] ~Join~ data[[-# + 1 ;;]] &@Count[acc, _?Positive]]
(* {-1050, -1000, 1, 1950, 1950, 1950, 525, 0} *)

You can also use Tr@Boole@Thread[acc > 0]] instead of Count[...] or if you want ≥0, then you can use Tr@UnitStep[acc].

Answer 2

You could also do

Join[#, data[[Length@# + 1 ;;]]] &@
 Reap[Fold[If[NonPositive@#1, Sow[#1 + #2], Break[Null, Fold]] &, 0, 
    data]][[-1, 1]]

{-1050, -1000, 1, 1950, 1950, 1950, 525, 0}

Answer 3

Perhaps if you like recursion this might seem more elegant, it certainly doesn't win on speed.

Recursive

NestWhile[{First@#~Plus~#[[2, 1]], Rest@#[[2]]} &, {0, data}, 
 NonPositive@First@# && Length@#[[2]] >= 1 &]

{1, {1950, 1950, 1950, 525, 0}}

Timing:

data = RandomInteger[{-1000, 10}, 100000];

AbsoluteTiming[
 NestWhile[{First@#~Plus~#[[2, 1]], Rest@#[[2]]} &, {0, data}, 
   NonPositive@First@# && Length@#[[2]] >= 1 &];]

{1.005087, Null}

rm -rf

AbsoluteTiming[
 With[{acc=Accumulate@data},acc[[;; -#]]~Join~data[[-# + 1 ;;]] &@Count[acc,_?Positive]];]

{0.024329, Null}

Rojo

AbsoluteTiming[
 Join[#, data[[Length@# + 1 ;;]]] &@
   Reap[Fold[If[NonPositive@#1, Sow[#1 + #2], Break[Null, Fold]] &, 0,
       data]][[-1, 1]];]

{0.104658, Null}

Answer 4

data = {-1050, 50, 1001, 1950, 1950, 1950, 525, 0};

Using SubsetMap (new in 12.0)

SubsetMap[
 Accumulate, 
 data, 
 Range @@ FirstPosition[Accumulate[data], _?Positive]]

{-1050, -1000, 1, 1950, 1950, 1950, 525, 0}

Answer 5

data = {-1050, 50, 1001, 1950, 1950, 1950, 525, 0};

---

Using Table, Take and Split:

RestrictedAccumulate[data_?VectorQ, cond_] := 
Map[If[Length@# > 1, Sequence @@ (Total /@ #), Last @@ #] &]@
Split[Table[Take[#, i], {i, Length@#}] &@data, cond]

RestrictedAccumulate[data, Total@# < 0 &]

{-1050, -1000, 1, 1950, 1950, 1950, 525, 0}

Answer 6

Using Min:

data = {-1050, 50, 1001, 1950, 1950, 1950, 525, 0};
FoldList[Min[#1 + #2, #2] &, data]

-> {-1050, -1000, 1, 1950, 1950, 1950, 525, 0}