How can I improve Do loop?

Question

I have very large input of time series data (over 30000 observations) that look like as follows:

    data = {{{2011, 1, 2, 0, 0, 0.}, 439.}, {{2011, 1, 3, 0, 0, 0.}, 
  482.}, {{2011, 1, 4, 0, 0, 0.}, 600.}, {{2011, 1, 5, 0, 0, 0.}, 
  540.}, {{2011, 1, 6, 0, 0, 0.}, 448.}, {{2011, 1, 7, 0, 0, 0.}, 
  409.}, {{2011, 1, 8, 0, 0, 0.}, 427.}, {{2011, 1, 9, 0, 0, 0.}, 
  428.}, {{2011, 1, 10, 0, 0, 0.}, 511.}, {{2011, 1, 11, 0, 0, 0.},....}

My purpose is to clean the outliers. Currently, I have to replace the outliers by using a new calculated mean that based on days of week. That is, mean of Monday will replace the outlier of Monday. The following is my code

Given that newmean variable is as follows:

 newmean =  {{Sunday, 398.231}, {Monday, 495.385}, {Tuesday, 452.}, {Wednesday, 
          440.308}, {Thursday, 427.692}, {Friday, 434.154}, {Saturday, 
          439.583}}

I want to replace newmean to the original input data based on day of week. Currently, I am using the following code:

CleanData[data_,newmean_]:=
Module[{result},
    result = data;
    Do[
    result={#[[1]],(#[[2]]/.val_/;DayName@#[[1]]==newmean[[i,1]]&&NumberQ[val]
    ->newmean[[i,2]])}&/@result,
    {i,Length@newmean}];
    result
] 

My question is how to improve this code ? Are there any better ways to replace data without specifying new variable (result) since the user-defined function (CleanData[data_, newmean_]) does not allow me to replace the input (data) ?

Answer 1

When/if you provide more concrete examples, I'll happily fine-tune this, but this will give you perhaps some ideas on how to approach this.

In general, avoid Do loops, things are usually more clear and better performing when taking advantage of Mathematica's functional capabilities and list comprehensions. Avoid using uppercase initials in variables, symbols, functions, etc. Otherwise, you're asking for name-clash trouble.

I've used a faked-up dataset for the example.

(* Define "outliers" for some data *)
outliers[data_] := (Mean[data] - 2 <= # <= Mean[data] + 2) &

(* Patch some data to mean of non-outliers *)
patchdata[data_] := Module[{mean, ok},mean = Mean[ok = Select[data, outliers[data]]];
   Replace[data, _?(FreeQ[ok, #] &) -> mean, 1]];

dataset = {{1, {1, 2, 3, 4, 5, 6}}, {2, {10, 13, 12, 17, 9, 5}}, {3, {4, 3, 2, 1, 3}}};

MapAt[patchdata, dataset, {All, 2}]

(*  {{1, {7/2, 2, 3, 4, 5, 7/2}}, {2, {10, 13, 12, 11, 9, 11}}, {3, {4, 3, 2, 1, 3}}}  *)

Overview: the function outliers defines what an "outlier" is. I chose anything more than 2 away from the mean of the dataset, you can make this whatever you want. patchdata takes some dataset, and replaces "outliers" with new data, I chose the Mean of the non-outlier data, again you can make this whatever fits your needs. Finally, the MapAt applies patchdata to the data elements I'm interested in. You'd jigger this to match the structure of your datasets. This is a very generic way of doing things, with more details on your specifics, a higher-performance realization is likely.

Edit: This answer may be totally irrelevant after your OP edits. If so, comment & I'll delete.

Answer 2

This post is motivating and based on the original post which involved defining control limits. In the following I have merely used the sample mean by day as the replacement mean (for convenience,this is not what was posted but could be adapted ). In the small samples (n=1), StandardDeviation will not work, hence the first line. I agree with comments re: DayName.

sd[x_] := If[Length[x] < 2, First@x, StandardDeviation[x]];
remout[d_, l_, u_] := Module[{dn, lmt, h, f, g, result},
  dn = {DayName[#1], ##2} & @@@ d;
  lmt = {First@#1, Mean@#2 - l sd[#2], Mean@#2 + u sd[#2], 
      Mean[#2]} & @@@ (Transpose /@ GatherBy[dn, #[[1]] &]);
  (h[#1] := #4) & @@@ lmt;
  (f[#1] = Function[x, #2 < x < #3]) & @@@ lmt;
  g = MapThread[#1@#2 &, {(f[DayName[#]] & /@ d[[All, 1]]), 
     d[[All, 2]]}];
  result = 
   Thread[{d, g}] /. {{x_, y_}, False} :> {{x, h@DayName[x]}, "Edited"}
  ]

Essentially, DayName is processed first prior to gathering. The limits by day are defined and temporary functions made. Outliers are identified by processing Bolloean function and then False (outliers) replaced by rule. The new data can be extracted by using #[[All,1].

This could be vey much refined, esp. just by creating augmented list with day names rather than repeatedly calling day names later. Further replacement rules may not scale for very large data. However, I regard this post as motivation to better ideas.

Testing (some extreme values):

data = {{{2011, 1, 2, 0, 0, 0.}, 439.}, {{2011, 1, 3, 0, 0, 0.}, 
    482.}, {{2011, 1, 4, 0, 0, 0.}, 600.}, {{2011, 1, 5, 0, 0, 0.}, 
    540.}, {{2011, 1, 6, 0, 0, 0.}, 448.}, {{2011, 1, 7, 0, 0, 0.}, 
    409.}, {{2011, 1, 8, 0, 0, 0.}, 427.}, {{2011, 1, 9, 0, 0, 0.}, 
    428.}, {{2011, 1, 10, 0, 0, 0.}, 511.}, {{2011, 1, 2, 0, 0, 0.}, 
    10.}, {{2011, 1, 2, 0, 0, 0.}, 2000}};

Just using 0.5,1 standard deviation above and below:

remout[data, 0.5, 1]

yields:

  {{{{2011, 1, 2, 0, 0, 0.}, 439.}, 
  True}, {{{2011, 1, 3, 0, 0, 0.}, 496.5}, 
  "Edited"}, {{{2011, 1, 4, 0, 0, 0.}, 600.}, 
  True}, {{{2011, 1, 5, 0, 0, 0.}, 540.}, 
  True}, {{{2011, 1, 6, 0, 0, 0.}, 448.}, 
  True}, {{{2011, 1, 7, 0, 0, 0.}, 409.}, 
  True}, {{{2011, 1, 8, 0, 0, 0.}, 427.}, 
  True}, {{{2011, 1, 9, 0, 0, 0.}, 428.}, 
  True}, {{{2011, 1, 10, 0, 0, 0.}, 511.}, 
  True}, {{{2011, 1, 2, 0, 0, 0.}, 719.25}, 
  "Edited"}, {{{2011, 1, 2, 0, 0, 0.}, 719.25}, "Edited"}}

If time permits I may improve but hope this is helpful.

EDIT

Revision with only one pass of DayName on data:

rout[d_, l_, u_] := Module[{dn, lmt, h, f, g, result},
  dn = {DayName[#1], #1, ##2} & @@@ d;
  lmt = {First@#1, Mean@#3 - l sd[#3], Mean@#3 + u sd[#3], 
      Mean[#3]} & @@@ (Transpose /@ GatherBy[dn, #[[1]] &]);
  (h[#1] := #4) & @@@ lmt;
  (f[#1] = Function[x, #2 < x < #3]) & @@@ lmt;
  g = MapThread[#1@#2 &, {(f[#] & /@ dn[[All, 1]]), 
     d[[All, 2]]}];
  result = 
   Thread[{dn, g}] /. {{x_, y_, z_}, False} :> {{x, y, h@x}, 
      "Edited"}
  ]