1
$\begingroup$

I have several time series data, each one looking approximately like this:

  data = ReplacePart[
  Table[Partition[
    N@Riffle[#, 20 + #/10 + RandomReal[{-1, 1}]] &@
     Range[i, i + RandomInteger[{4, 7}]], 2], {i, 1, 300, 
    40 + RandomInteger[{-10, 10}]}], {3, 2, 2} -> 
   Style[78.87, Bold, Red]]

enter image description here

This does correspond to measurement sessions. The apparatus we use conducts now and then to errors, which are easy enough to identify. The question for me is how to efficiently filter the data.

I would formulate an Error in a measure (M) like:

enter image description here

But it wouldn't work if the Error is the first (or the last) in a measurement session. In this case, we take:

enter image description here

or

enter image description here

Is it a obvious duplicate? It should be. I didn't find it.

$\endgroup$
1
  • 2
    $\begingroup$ PeakDetect might help. $\endgroup$
    – JEM_Mosig
    Mar 20, 2018 at 21:26

3 Answers 3

3
$\begingroup$

You can do this with MovingMap on the interior and then applying individual tests to your boundary. This lets you build up a Pick spec which will select your data as fast as possible.

Here's a sample version of this for your specific case:

pickMoving2[
   data_,
   testInterior_,
   testStart_,
   testEnd_
   ] :=
  With[{
    interior =
     MovingMap[testInterior, data, 2],
    start =
     testStart[data[[;; 3, 2]]],
    end =
     testEnd[data[[-3 ;;, 2]]]
    },
   Pick[data, Join[{start}, interior[[All, 2]], {end}]]
   ];

And then here's it actually applied to some of the sample data you specified. Note that I just supply the three tests, one for the interior, one for the start, and one for the end.

pickMoving2[
 data[[3]],
 (* Test Interior *)

 Abs[#[[3]] - #[[2]]] <= 2 &&
   Abs[#[[2]] - #[[1]]] <= 2 &&

   Abs[#[[3]] - #[[1]]] <= 1 &,
 (* Test Start *)

 Abs[#[[2]] - #[[1]]] <= 2 &&
   Abs[#[[3]] - #[[2]]] <= 1 &,
 (* Test End *)

 Abs[#[[3]] - #[[2]]] <= 2 &&
   Abs[#[[2]] - #[[1]]] <= 1 &
 ]

{{64., 25.5038}, {65., 25.6038}, {66., 25.7038}, {67., 25.8038}}
$\endgroup$
1
  • $\begingroup$ Thanks a lot, if you replace the <= 2 with >= 2, it works perfectly :) $\endgroup$
    – B-Lertch
    Apr 12, 2018 at 10:05
3
$\begingroup$

For a simple list:

Table[If[Abs[mylist[[i]] - mylist[[i + 1]]] > 2 && 
   Abs[mylist[[i + 1]] - mylist[[i]]] > 2 && 
   Abs[mylist[[i + 1]] - mylist[[i - 1]]] < 1, mylist[[i]], 
  Null], 
   {i, 2, Length[mylist] - 1}]

For your paired list:

Table[If[Abs[mylist[[i,2]] - mylist[[i + 1,2]]] > 2 && 
   Abs[mylist[[i + 1,2]] - mylist[[i,2]]] > 2 && 
   Abs[mylist[[i + 1,2]] - mylist[[i - 1,2]]] < 1, mylist[[i]], 
  Null], 
  {i, 2, Length[mylist] - 1}]

Inelegant... but works!

$\endgroup$
1
$\begingroup$
ClearAll[errorQ]
errorQ[c1_ : (Abs[#] >= 2 &), c2_ : (Abs[#] <= 1 &)] := 
 Module[{s1 = And[c1 @ #, c1 @ #2, c2[# + #2]]&, s2 = And[c1 @ #, c2 @ #2]& , 
   d = MovingMap[Differences, # , {4, Center}, "Fixed"][[All, -1]]},
  Flatten[{s2 @@ d[[1, {3, 4}]] , s1 @@@ d[[2 ;; -2, {2, 3}]], s2 @@ d[[-1, {2, 1}]]}]]&

where the argument c1 (respectively, c2) is a pure function representing the condition applied to differences $\Delta (M, M_{previous})$ and $\Delta (M, M_{next})$ (respectively, $\Delta (M_{previous}, M_{next})$, $\Delta (M_{previous-1}, M_{previous})$ and $\Delta (M_{next}, M_{next+1})$).

Examples:

SeedRandom[1]
data = Table[Partition[N@Riffle[#, 20 + #/10 + RandomReal[{-1, 1}]] &@
        Range[i, i + RandomInteger[{4, 7}]], 2], {i, 1, 300, 
      40 + RandomInteger[{-10, 10}]}]; 
data[[3, 2, 2]] = 78.87; 
parts = Thread[(Append @@@ Thread[{RandomSample[Position[data, _, {2}, Heads -> False], 
        4], -1}] ) -> 100]
datab = ReplacePart[data, parts];  

Pick[datab, errorQ[] /@ datab]

{{{5., 100}}, {}, {{72., 78.87}}, {}, {}, {}, {{211., 100}, {214., 100}}, {{250., 100}}, {}}

Pick[datab, errorQ[Abs[#] > 58 &] /@ datab] 

{{{5., 100}}, {}, {}, {}, {}, {}, {{211., 100}, {214., 100}}, {}, {}}

MapAt[Style[#, 20, Red, Bold] &, datab, Position[errorQ[] /@ datab, True]]

enter image description here

 MapAt[Style[#, 20, Red, Bold] &, datab, Position[errorQ [Abs[#] > 58 &] /@ datab, True]] 

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.