# List-operations only when restrictions are fulfilled (Part 2)

Consider the following:

data={{{3544128000, 80}, {3544732800, 80}, {3545337600, 80},
{3545942400, 80}, {3545942400, 160}, {3546547200, 160}, {3547152000, 0}}};


After the satisfying answers to my former question (Part 1), another issue occurred, but with the same background (List-operations only when restrictions are fulfilled):

After applying

Transpose[{#[[All, 1, 1]],
Total[#[[All, All, 2]], {2}]}] &[#] & /@ (GatherBy[#, First] & /@
data)


on data (thanks to Andy Ross for the approach), I receive

{{{3544128000, 80}, {3544732800, 80}, {3545337600, 80}, {3545942400, 240},
{3546547200, 160}, {3547152000, 0}}}


which resembles to

{{x_-n*604800_, y_},...,{x_-604800_, y_}, {x_, u_},
{x+604800_, z_},{x_+2*604800_, z_},...,{x_+m*604800_, z_}}


I would like to do the following:

1. u_->y_ (*Transform u_ to y_*)
2. residual=(y_-u_)/(n+1) (*Calculate residual of y_ and u_ and divide it be n+1*)
3. {{x-n*604800_, y_+residual},...,{x-604800_, y_+residual}, {x_, y_+residual},{x+604800_, z_},{x_+2*604800_, z_},...,{x_+m*604800_, z_}} (Distribute residual to all periods from x_-n*604800 to x_)

The result in case of data will then be:

{{{3544128000, 120}, {3544732800, 120}, {3545337600, 120}, {3545942400, 120},
{3546547200, 160}, {3547152000, 0}}}


For better understanding, please consider the following examples:

Example1 = {5, 5, 5, 2, 2, 2, 6, 4, 4, 4};
MyFunction@Example1
{5, 5, 5, 3, 3, 3, 3, 4, 4, 4}

Example2 = {2, 2, 2, 6, 4, 4, 4};
MyFunction@Example2
{3, 3, 3, 3, 4, 4, 4}

Example3 = {2, 2, 2, 4, 4, 4};
MyFunction@Example3
{2, 2, 2, 4, 4, 4}


MyFunction detects a peak within the dataset and "kills" it by replacing the peak and the preceding sequence (with constant values) with y+residual (see 2., Example1 and Example2). It is important that MyFunction returns the original list when no peak occurs in the list (see Example 3.).

-
I thought about something like ModifiedData /. {{a_, y_}, {x_, u_}, {b_, z_}} :> {{a, y + (u - y)/2}, {x, y + (u - y)/2}, {b, z}} but would prefer a generic approach as this only works when data is modified to ModifiedData. – John Apr 17 '12 at 21:41

You could define a transformation function according to

transform[list_] := Module[{n, y, u, res},
y = list[[1, 2]];
n = LengthWhile[list, #[[2]] == y&];
u = list[[n + 1, 2]];
res = (y - u)/n;
Join[Thread[{list[[;; n + 1, 1]], y + res}], list[[n + 2 ;;]]]]


and map that to you transformed data list:

data = {{{3544128000, 80}, {3544732800, 80}, {3545337600, 80}, {3545942400, 80},
{3545942400, 160}, {3546547200, 160}, {3547152000, 0}}};
data1 = Transpose[{#[[All, 1, 1]], Total[#[[All, All, 2]], {2}]}] & /@
(GatherBy[#, First] & /@ data);

transform /@ data1

{{{3544128000, 80/3}, {3544732800, 80/3}, {3545337600, 80/3},
{3545942400, 80/3}, {3546547200, 160}, {3547152000, 0}}}


By the way, I get

data1 == {{{3544128000, 80}, {3544732800, 80}, {3545337600, 80}, {3545942400, 240},
{3546547200, 160}, {3547152000, 0}}}


{{{3544128000, 80}, {3544732800, 80}, {3545337600, 80}, {3545942400, 240},{3546547200, 160}}}

as posted in the question which is why I get an extra term {3547152000, 0} in the result above.
Two comments on your approach: 1. res must be changed to res=(u-y)/(n+1). 2. It is important that the function only runs in case of {{x_-n*604800_, y_},...,{x_-604800_, y_}, {x_, u_}, {x+604800_, z_},{x_+2*604800_, z_},...,{x_+m*604800_, z_}}, whereas y<u<z. In case of y<u=z the function must return the original list. Please consider the added information at the end of my question. – John Apr 18 '12 at 20:19
May be there is a way to use a pattern such as {q___,x___,y___,z___,w___}. y represents the peak and q,x,z and w represent sequences with constant values, whereas x<y<z (q and w can be of any other constant value). – John Apr 18 '12 at 20:27