10
$\begingroup$

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.

$\endgroup$

7 Answers 7

10
$\begingroup$

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@# &]
$\endgroup$
3
  • 1
    $\begingroup$ Seems the most obvious to me. $\endgroup$ Dec 5, 2012 at 19:04
  • $\begingroup$ A bit shorter and faster: Select[z, Length @ Union @ #[[All, 1]] == Length @ # &] $\endgroup$
    – Mr.Wizard
    Dec 6, 2012 at 7:39
  • $\begingroup$ Using DeleteDuplicates instead of Union will probably be faster, as it doesn't need to sort. $\endgroup$ Dec 6, 2012 at 10:40
9
$\begingroup$
 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}}} *)
$\endgroup$
3
  • $\begingroup$ Are you planning to add comparative timings? $\endgroup$
    – Mr.Wizard
    Dec 5, 2012 at 19:14
  • $\begingroup$ @Mr.W, I wasn't. It would be a good idea; but don't have time this afternoon. $\endgroup$
    – kglr
    Dec 5, 2012 at 19:39
  • $\begingroup$ I added timings to my answer. $\endgroup$
    – Mr.Wizard
    Dec 5, 2012 at 20:00
7
$\begingroup$

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 @ # &]
$\endgroup$
4
$\begingroup$

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.

enter image description here

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

enter image description here

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

$\endgroup$
3
$\begingroup$

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]

enter image description here

Or using GatherBy:

GatherBy[alist, DuplicateFreeQ@#[[All, 1]] &][[2]]
$\endgroup$
2
$\begingroup$
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}}}

$\endgroup$
0
$\begingroup$
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.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.