Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question
add comment

3 Answers

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@# &]
share|improve this answer
1  
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
add comment
 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}}} *)
share|improve this answer
    
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. –  kguler Dec 5 '12 at 19:39
    
I added timings to my answer. –  Mr.Wizard Dec 5 '12 at 20:00
add comment

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 @ # &]
share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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