# Remove the right sublist

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


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.

• I could not understand how the removal rule you have described would lead to the expected output m3.Could you elaborate it further? Commented Dec 1, 2017 at 11:52
• Hi Pedro, thanks for your question. I'm sure my code is wrong somewhere, but I cannot see where. Consider m2test. Comparing the 5th element of the second sublist to those in the first and third ones, the difference is <1 with the first list and >1 with the 3rd, so the 2nd sublist should be removed. Now the 3rd sublist should be compared to the 1st one and to the 4th one, and since the difference is, again >1 when compared to the 1st sublist, the 3rd sublist should be removed, and so on. But it doesn't work. Why? Commented Dec 1, 2017 at 12:03

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.

• This works perfectly! Thank you! Commented Dec 1, 2017 at 14:52
• Can you please give me a feedback why my code was not working? Thanks Commented Dec 1, 2017 at 14:56
• @MicheleG Trumpets! :) Commented Dec 1, 2017 at 14:58
• @MicheleG Sorry, I am not good at thinking in a procedural way. But I will have a try if possible. Commented Dec 1, 2017 at 14:59
• That's fine, thank you mate! :) Commented Dec 1, 2017 at 15:12
(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


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