For or While loops in Mathematica code always make me feel a little dirty but I was confusing myself trying to do some list munging all functional-like, and resorted to this:
(* # Given a list of {x,y} pairs, transform the data as follows: every time
# there's a decrease in y-value from one datapoint to the next, say {x1,Y}
# followed by {x2,y}, add Y to the value of every datapoint on or after x2. *)
monotonify[data_] := Module[{data0, i, offset = 0},
data0 = data;
For[i = 2, i <= Length[data], i++,
If[data[[i-1,2]] > data[[i,2]], offset += data[[i-1,2]]];
data0[[i]] += {0,offset}];
data0]
(Think of the y-values as odometer readings where sometimes the odometer gets accidentally reset -- evident because the value decreases, which odometers shouldn't do. So we transform the readings by adding the last known value before each reset to all future values.)
How would you write monotonify in a nice functional style?
(The fact that I don't consider the above For loop perfectly fine is probably a mild form of OCD.)
OK, now I've fixed my approach to work with inputs as originally requested.
Start with a sample dataset:
dataset = {{a, 1}, {b, 2}, {c, 3}, {d, 4}, {e, 5}, {f, 0}, {g, 4},
{h,5}, {i, 6}, {j, 7}, {k, 4}, {l, 7}, {m, 8}, {n, 9}, {o, 0}, {p,2},
{q, 3}};
Take the transpose:
trDataset = Transpose[dataset];
next a function to operate on the Y-values only:
trDataset[[2]] = FoldList[Plus, dataset[[1, 2]], Map[Max[#, 0] &, Differences[dataset[[All, 2]]]]]
Undo the transposition:
dataset = Transpose[trDataset]
and the output is now
{{a, 1}, {b, 2}, {c, 3}, {d, 4}, {e, 5}, {f, 5}, {g, 9}, {h, 10}, {i,
11}, {j, 12}, {k, 12}, {l, 15}, {m, 16}, {n, 17}, {o, 17}, {p,
19}, {q, 20}}
I still haven't tested the performance of this solution.
EDIT: OK, here's the basis of a fix, I'll leave the rest of the work to you @dreeves. This version of monotonify only works on a list of numbers, I haven't integrated it into my previous suggestion to work with your inputs.
monotonify[series_] :=
Split[series, Less] //. {a___, x_List, y_List, z___} /;
Last[x] > First[y] -> {a, x, y + Last[x], z} // Flatten
EDIT 2: Another function which works on a list of numbers. This is much faster than my previous attempt.
monotonify[series_] :=
Accumulate[Flatten[Map[Flatten[{#[[1]], Differences[#]}] &,
Split[series, Less]]]]
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With