Remove the right sublist

Question

I've a problem when I try to extract some unwanted sublists from a list. Given a test list:

m2test = {{1, 0, 1, 1, 1, 1}, {2, 0, 1, 1, 2, 2}, {3, 0, 1, 1, 3.1, 
3}, {4, 0, 1, 1, 3.2, 4}, {5, 0, 1, 1, 3.3, 5}, {6, 0, 1, 1, 1.8, 
6}, {7, 0, 1, 1, 1.5, 7}, {8, 0, 1, 1, 1.55, 8}, {9, 0, 1, 1, 1.6,
 9}, {10, 0, 1, 1, 1.4, 10}};

Using the following for loops:

m3 = {{"Index", "Track ID", "x (um)", "y (um)", "z (um)", "t (s)"}};
n = Max[m2test[[All, 2]]] // IntegerPart;
For[i = 0, i <= n, i++,
p = Pick[m2test, m2test[[All, 2]], i];
For[j = 2, j <= Length[p] - 1, j++,
If[Abs[p[[(j), 5]] - p[[j - 1, 5]]] > 1 || 
Abs[p[[(j), 5]] - p[[j + 1, 5]]] > 1, 
p = Cases[p, Except[p[[j]]]], p]];
m3 = Join[m3, p]];

I wanted to remove all those sublists whose 5th elements were greater or smaller than those in the previous and/or following sublists by a value greater than 1 (the first for loop is needed to do this in each subgroup where the 2nd elements are the same, but in m2test there's only a value, so it doesn't matter here).I wanted that, every time a sublist was removed, the list was updated before the next round. Therefore, I was expecting to get:

m3
{{"Index", "Track ID", "x (um)", "y (um)", "z (um)", "t (s)"},{1, 0, 1, 1, 1, 1},{6, 0, 1, 1, 1.8, 
6}, {7, 0, 1, 1, 1.5, 7}, {8, 0, 1, 1, 1.55, 8}, {9, 0, 1, 1, 1.6,
 9}, {10, 0, 1, 1, 1.4, 10}}

But, instead, I get:

m3
{{"Index", "Track ID", "x (um)", "y (um)", "z (um)", "t (s)"}, {1, 0, 
1, 1, 1, 1}, {3, 0, 1, 1, 3.1, 3}, {4, 0, 1, 1, 3.2, 4}, {6, 0, 1, 
1, 1.8, 6}, {7, 0, 1, 1, 1.5, 7}, {8, 0, 1, 1, 1.55, 8}, {9, 0, 1, 
1, 1.6, 9}, {10, 0, 1, 1, 1.4, 10}}

What's wrong? Obviously this code, if working as expected, has the drawback of removing also some desired points, like {2, 0, 1, 1, 2, 2}, or the fact that, if the first point is undesirable, the entire sublist is removed.

Many thanks.

Answer 1

Have a try of this:

 myListExtract[m2test]

where myListExtract is defined as:

myListExtract[lis_List] := Module[{change1, change2, test, data, extractedData},
  change1[x_] := {Join[#1, {First[#2]}], Rest[#2]} & @@ x;
  change2[x_] := {#1, Rest[#2]} & @@ x;
  test[list_] := And @@ ((Abs[#1] <= 1 &) /@ Differences[{#1[[-1]], #2[[1]], #2[[2]]}] &) @@ list;
  data = TakeDrop[lis[[All, 5]] /. {a_, b___, c_} :> {a, a, b, c, c}, 1];
  extractedData = Rest@First@NestWhile[x \[Function] If[test[x], change1[x], change2[x]], data, Length[#[[2]]] > 1 &];
  Extract[lis, Flatten /@ (Position[lis[[All, 5]], #] & /@ extractedData)]
]

with an eye on the selection of the first sublist.

Answer 2

(m2test = {{1, 0, 1, 1, 1, 1}, {2, 0, 1, 1, 2, 2}, {3, 0, 1, 1, 3.1, 
     3}, {4, 0, 1, 1, 3.2, 4}, {5, 0, 1, 1, 3.3, 5}, {6, 0, 1, 1, 1.8,
      6}, {7, 0, 1, 1, 1.5, 7}, {8, 0, 1, 1, 1.55, 8}, {9, 0, 1, 1, 
     1.6, 9}, {10, 0, 1, 1, 1.4, 10}}) // Grid

The highlighted entries need to be filtered since the fifth column entries fall back on row 6 to within an absolute difference of < 1.0 of the entry in the first row, fifth column. The same trend repeats till the end of the list is reached.

dat = {First@#}~Join~# &@m2test;
(t = FoldList[If[#2[[5]] - #1[[5]] < 1, #2, #1] &, m2test] // 
    DeleteDuplicates) // Grid

Answer 3

Using Subsets, GroupBy, Lookup and Complement:

TableForm[
    Join[
        {{"Index", "Track ID", "x (um)", "y (um)", "z (um)", "t (s)"}},
        Complement[m2test,
            Rest[
                    DeleteDuplicates[
                        Lookup[
                            GroupBy[
                                Subsets[m2test, {2}],
                                Function[
                                        Less[
                                            Part[Part[#, 2], 5] - Part[Part[#, 1], 5],
                                            1
                                        ]
                                    ],
                                Apply[Join, #] &
                            ],
                            False
                        ]
                    ]
                ]
        ]
    ]
 ]