# Removing elements of a nested list based on tests with previous and next element

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


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:

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

or

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

• PeakDetect might help. Commented Mar 20, 2018 at 21:26

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

• Thanks a lot, if you replace the <= 2 with >= 2, it works perfectly :) Commented Apr 12, 2018 at 10:05

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


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!

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;
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]]


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