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

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.).

John

Posted 2012-04-17T21:33:00.967

Reputation: 4 161

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 – 2012-04-17T21:41:29.707

Answers

1

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

instead of

{{{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.

Heike

Posted 2012-04-17T21:33:00.967

Reputation: 34 748

@John What are your comments? I can't see them. – Heike – 2012-04-18T20:17:24.540

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_+2604800_, z_},...,{x_+m604800_, z_}}, whereasy<u<z. In case ofy<u=z` the function must return the original list. Please consider the added information at the end of my question. – John – 2012-04-18T20:19:14.913

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 – 2012-04-18T20:27:58.350