# Filtering elements from a list

Suppose that I have a list

{{{2, 1}, {4, 3}, {2, 4}}, {{2, 1}, {4, 3}, {3, 1}},
{{2, 1}, {2, 4}, {3, 1}}, {{4, 3}, {2, 4}, {1, 2}}}


I want to make a new list that only contains the entries for which the first component of each pair does not repeat itself. So for example, the element

{{2, 1}, {4, 3}, {2, 4}}


would be eliminated since 2 appears in the first component of both {2,1} and {2,4}. Likewise, {{2, 1}, {2, 4}, {3, 1}} will also be eliminated. Is there a simple condition I can use with the Select function to do this? Thanks in advance.

-

Another rather interesting way:

z = {{{2, 1}, {4, 3}, {2, 4}}, {{2, 1}, {4, 3}, {3, 1}}, {{2, 1}, {2, 4},
{3, 1}}, {{4, 3}, {2, 4}, {1, 2}}};

Select[z, Length[Union[#[[All, 1]]]] == Length[#[[All, 1]]] &]

(*{{{2, 1}, {4, 3}, {3, 1}}, {{4, 3}, {2, 4}, {1, 2}}}*)


As noted below by Mr.Wizard, the function can be made slightly faster as such:

Select[z, Length@Union@#[[All, 1]] == Length@# &]


And as Simon Woods points out, it can made even a touch faster using DeleteDuplicates due to the unnecessary sorting:

Select[z, Length@DeleteDuplicates@#[[All, 1]] == Length@# &]

-
Seems the most obvious to me. – Chris Degnen Dec 5 '12 at 19:04
A bit shorter and faster: Select[z, Length @ Union @ #[[All, 1]] == Length @ # &] – Mr.Wizard Dec 6 '12 at 7:39
Using DeleteDuplicates instead of Union will probably be faster, as it doesn't need to sort. – Simon Woods Dec 6 '12 at 10:40
 lst = {{{2, 1}, {4, 3}, {2, 4}}, {{2, 1}, {4, 3}, {3, 1}},
{{2, 1}, {2, 4}, {3, 1}}, {{4, 3}, {2, 4}, {1, 2}}};


Can use

 Pick[lst, (DeleteDuplicates[#] == #) & /@ Map[First, lst, {2}]]
Pick[lst, (DeleteDuplicates[#] == #) & /@ lst[[All, All, 1]]]


or

 Select[lst, (DeleteDuplicates[First /@ #] == First /@ #) &]
Select[lst, (DeleteDuplicates[#[[All,1]]] == #[[All,1]]) &]


or

 Cases[lst, {{a_, _}, {b_, _}, {c_, _}} /; a != b != c]


or

 DeleteCases[lst, {___, {a_, _}, ___, {a_, _}, ___}]


or

 lst /. {___, {a_, _}, ___, {a_, _}, ___} :> Sequence[]


all give

 (* {{{2, 1}, {4, 3}, {3, 1}}, {{4, 3}, {2, 4}, {1, 2}}} *)

-
Are you planning to add comparative timings? – Mr.Wizard Dec 5 '12 at 19:14
@Mr.W, I wasn't. It would be a good idea; but don't have time this afternoon. – kglr Dec 5 '12 at 19:39
I added timings to my answer. – Mr.Wizard Dec 5 '12 at 20:00

Same idea as kguler, different formulation:

lst = {{{2, 1}, {4, 3}, {2, 4}}, {{2, 1}, {4, 3}, {3, 1}},
{{2, 1}, {2, 4}, {3, 1}}, {{4, 3}, {2, 4}, {1, 2}}};

Pick[#, Signature /@ #[[All, All, 1]], 1 | -1] & @ lst

{{{2, 1}, {4, 3}, {3, 1}}, {{4, 3}, {2, 4}, {1, 2}}}


On relatively short sublists UnsameQ should be faster than Signature:

Pick[#, UnsameQ @@@ #[[All, All, 1]]] & @ lst


Here are comparative timings for all methods posted so far, with the exception of Cases[lst, {{a_, _}, {b_, _}, {c_, _}} /; a != b != c] because that does not scale. I also changed lst /. {___, {a_, _}, ___, {a_, _}, ___} :> Sequence[] to apply only to level 1 because otherwise it is orders of magnitude slower.

Functions are given in increasing order of speed as tested:

SetAttributes[timeAvg, HoldFirst]

timeAvg[func_] :=
Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0, 15}]

lst = RandomInteger[19, {2500, 7, 2}]; (*sample data*)

Select[lst, (DeleteDuplicates[First /@ #] == First /@ #) &] // timeAvg

Replace[lst, {___, {a_, _}, ___, {a_, _}, ___} :> Sequence[], {1}] // timeAvg

DeleteCases[lst, {___, {a_, _}, ___, {a_, _}, ___}] // timeAvg

Select[lst, Length[Union[#[[All, 1]]]] == Length[#[[All, 1]]] &] // timeAvg

Pick[lst, (DeleteDuplicates[#] == #) & /@ Map[First, lst, {2}]] // timeAvg

Pick[lst, (DeleteDuplicates[#] == #) & /@ lst[[All, All, 1]]] // timeAvg

Pick[#, Signature /@ #[[All, All, 1]], 1 | -1] &@lst // timeAvg

Pick[#, UnsameQ @@@ #[[All, All, 1]]] &@lst // timeAvg


0.01684

0.01248

0.01248

0.007864

0.005736

0.003992

0.003248

0.0020464

Update: my second data set was poor as nothing would be selected. Timings updated using a data set which results in about 50% selection.

With data of a very different shape: lst = RandomInteger[2*^6, {25, 1700, 2}]; the order changes quite a bit: (functions tested in the same order as above)

0.00824

127.624

144.831

0.003624

0.02496

0.005864

0.008864

0.1654

With long sublists the pattern-based tests are revealed to be very slow, and as I expected (from prior testing) UnsameQ falls way behind Signature. Kale's function is the fastest; it can be made a bit faster (and shorter) by rewriting as:

Select[lst, Length @ Union @ #[[All, 1]] == Length @ # &]

-