# 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. Dec 5, 2012 at 19:04
• A bit shorter and faster: Select[z, Length @ Union @ #[[All, 1]] == Length @ # &] Dec 6, 2012 at 7:39
• Using DeleteDuplicates instead of Union will probably be faster, as it doesn't need to sort. Dec 6, 2012 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? Dec 5, 2012 at 19:14
• @Mr.W, I wasn't. It would be a good idea; but don't have time this afternoon.
– kglr
Dec 5, 2012 at 19:39
• I added timings to my answer. Dec 5, 2012 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 @ # &]


There is a comprehensive array of list manipulation techniques presented on this page. The DuplicateFreeQ function was introduced two years later for this task and enables concise code.

alist = {{{2, 1}, {4, 3}, {2, 4}}, {{2, 1}, {4, 3}, {3, 1}}, {{2,
1}, {2, 4}, {3, 1}}, {{4, 3}, {2, 4}, {1, 2}}}

MatrixForm /@ alist


To remove a matrix with duplicated entries in the first column, each of the following works.

Pick[alist, DuplicateFreeQ@#[[All, 1]] & /@ alist]

Select[alist, DuplicateFreeQ@#[[All, 1]] &]


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

Another way to do this using GroupBy, DuplicateFreeQ (as pointed out, @Syed) and Lookup:

alist = {{{2, 1}, {4, 3}, {2, 4}}, {{2, 1}, {4, 3}, {3, 1}}, {{2,
1}, {2, 4}, {3, 1}}, {{4, 3}, {2, 4}, {1, 2}}}

MatrixForm /@ alist

Lookup[GroupBy[alist, DuplicateFreeQ@#[[All, 1]] &], True]


Or using GatherBy:

GatherBy[alist, DuplicateFreeQ@#[[All, 1]] &][[2]]

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


Using Pick and Association

Pick[list, Length[#] == 3 & /@ Map[<|Rule @@@ #|> &, list]]


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

Timing[Dimensions[Select[list, DuplicateFreeQ[#1[[All,1]]] & ]]]

{10.0469, {7197882, 3, 2}}

Timing[Dimensions[Select[list,
Max[Tally[#1[[All,1]]][[All,2]]] <= 1 & ]]]

{25.2344, {7197882, 3, 2}}


The Tally version was written ro provide a version that ought to have worked even in Mathematica version 8.