Iterating over a list, in a functional way

Question

I have learned a lot about functional programming just from messing around in Mathematica, but I've come across a problem that I don't know how to solve in a "functional" way. Any help would be appreciated.

Suppose I have an Association that lists my daily balances (in my checking account). So it might start something like:

balance["3/1"] = 20
balance["3/2"] = -80
balance["3/3"] = -70
balance["3/4"] = 20
balance["3/5"] = -100

What I'd like to do is compute a list of daily deposits (say, a transfer from my savings account), that always ensures my balance is at least 0. For example, I would have to deposit 80 on "3/2".

The problem I'm facing is that once I deposit that 80, as an illustration, that means all the following balances are now changed by 80. So I will not have to make a deposit on "3/3". The actual daily deposits association would start like:

deposit["3/1"] = 0
deposit["3/2"] = 80
deposit["3/3"] = 0
deposit["3/4"] = 0
deposit["3/5"] = 20

Now this is easy to do with a loop over the balance association. But how would I solve this in a "functional" way? In particular, avoiding an explicit loop and also (ideally) avoiding making changes to balance?

Answer 1

I am also going to ignore the "association" aspect of this for the sake of simplicity.

There is nothing wrong with loops conceptually; they just need to be written using the right Mathematica tools if one wants efficiency. (Unless you wish to write the entire thing in a procedural style and compile to C for maximum performance.) In this case FoldList is probably the right tool. At each step we need to input the daily balance value, and we need to keep track of:

1. A running adjustment to balance

2. A daily deposit amount

Therefore I will start a function definition with: f[{adj_, dep_}, bal_] :=. The parameter dep is not actually used in the function; it is merely a value to carry along with the adjustment. My function:

f[{adj_, dep_}, bal_] :=
  With[{x = adj + bal},
    If[x >= 0, {adj, 0}, {adj - x, -x}]
  ]

Now:

balance = {20, -80, -70, 20, -100};

FoldList[f, {0, 0}, balance]

{{0, 0}, {0, 0}, {80, 80}, {80, 0}, {80, 0}, {100, 20}}

In FoldList the {0, 0} represents starting values for adj and dep that we will track. The output is of the form {adj, dep}. To get your deposit list we merely need to add Part:

FoldList[f, {0, 0}, balance][[2 ;;, 2]]

{0, 80, 0, 0, 20}

If performance is a priority we should rewrite f in a way that is compilable:

f2 =
  Compile[{{track, _Real, 1}, {bal, _Real}},
   Module[{x = track[[1]] + bal},
    If[x >= 0, {track[[1]], 0}, {track[[1]] - x, -x}]
   ]
  ];

Comparison:

big = RandomReal[{-99, 99}, 1*^6];

FoldList[f,  {0, 0}, big][[2 ;;, 2]] // AbsoluteTiming // First
FoldList[f2, {0`, 0`}, big][[2 ;;, 2]] // AbsoluteTiming // First

2.543146

0.434025

Note that because f2 is compiled to work with Reals I need to using a starting expression of {0`, 0`} to achieve best performance; I missed this at first.

---

In the example above I used a two term List to hold the two tracked values. This is a generalizable method. However in this case we only care to keep one of these values in the ultimate output, and further we are not actually using this value in subsequent steps. We can therefore use a Symbol assignment and replace FoldList with Map:

fx[bal_] := With[{x = -adj - bal}, If[x < 0, 0, (adj += x; x)]]

adj = 0;

fx /@ balance

{0, 80, 0, 0, 20}

This is a mixed rather than functional style but it is still a useful technique to know. If you use it take precaution to avoid bugs related to global assignments. For example you should make the entire thing a function and adj a scoped Symbol in Module.

---

Freely borrowing from Simon's answer, and acknowledging the same performance limitations, one may also do this:

h[{a_, r___}, p_: {}] := h[{r} + #, Append[p, #]] & @ Max[-a, 0]

h[{}, p_] := p

Test:

h[balance]

{0, 80, 0, 0, 20}

Answer 2

You mentioned Sow and Reap in a comment, so here's a recursive function using those. Performance-wise it's a total disaster but perhaps it's of interest anyway:

f[{first_, rest___}] := f[{rest} + Sow @ Max[-first, 0]]

Reap[f @ balance][[2, 1]]
(* {0, 80, 0, 0, 20} *)

Answer 3

A quick-and-dirty method, so caveat lector, I've tested non-rigorously.

Seems to be quite quick - about 100X faster on real lists, 300X faster on integer than fast answers so far (but see below for faster realization). Did not test against the compiled solution...

bf = Module[{balance = Clip[#, {Min@#, 0}], pos, bb, diff, x = ConstantArray[0, Length@#]},
    pos = f3[balance];
    bb = balance[[pos]];
    diff = Differences[Prepend[bb, 0]];
    x[[pos]] = -diff;
    x] &;

Uses the f3 function I defined in an answer here, expects a list of balances, à la Mr. Wizard's input.

A bit goofy, I suppose: anyone with a balance list of millions of items, I'd like to meet...

A quick timing comparison of f, fx and bf, using RandomReal and RandomInteger on {-1000,1000} over list length ranging from 100 to 500,000 elements, timings of bf normalized to 1 :

Both real and integer lists have the same momentary plateau for f and fx between 5k and 10k elements, I'd venture some auto-compilation is kicking in.

I did not test the pretty, but as noted by Mr. W and Simon, impractical for large lists answers - they are the sweet venus fly-trap of performance killing for such things.

Update: Here's a method that (surprisingly, to me) is faster on my machine as lists get bigger (>=10K elements), and similar to the above on smaller lists.

bf3[list_] := 
 Module[{pos = f3[list], clip, fl, x = ConstantArray[0, Length@list]},
  pos = Pick[pos, UnitStep[list[[pos]]], 0];
  clip = list[[pos]];
  fl = FixedPointList[
    Unitize[#] (# - With[{s = Pick[#, UnitStep@#, 0]}, If[s === {}, 0, First@s]]) &, clip];
  x[[pos]] = -Diagonal[fl];
  x]

On a 2M element list (real or integer) it is 50-70% faster than the above on my machine.

Answer 4

Here's what I have so far; it doesn't change the balance list, but it does incrementally build up a deposit list. I'm guessing something like that has to happen, and I don't know enough (monads?) to write this in a functional way.

[I'm kind of ignoring the fact I wanted a deposit association, because it's easy to build one from the list I get.]

f[list_List] := 
Module[{pos = First@First@Position[list, _?Negative]}, 
deposits[[pos]] = -list[[pos]]; 
list + PadRight[PadLeft[{}, pos - 1], Length[list], 
deposits[[pos]]]]
NestWhile[f, Values[balance], AnyTrue[#, Negative] &];