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, z},
"Edited"}
]