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.

I have the need to remove "duplicates" from large (>10K members) lists, where a "duplicate" is either a verbatim duplication, or the element's second entry exists as a first entry for some "earlier" member in the list.

E.G., given

testcase = {{1, 2}, {2, 1}, {1, 3}, {3, 4}, {4, 9}, {1, 3}, {6, 4}, {9, 4}, {7, 5}, {6, 7}, {5, 7}}

the desired result would be {{1, 2}, {1, 3}, {3, 4}, {4, 9}, {7, 5}}.

Of course the trivial method is DeleteDuplicates[testcase, #2[[2]] == #1[[1]] &], but this goes exponential, as hinted to in the MMA documentation.

I've been pondering for a bit, shooting blanks so far, looking for any ideas toward an efficient solution.

share|improve this question
1  
Somewhat related: How to select minimal subsets? –  Mr.Wizard Feb 20 at 5:22
add comment

3 Answers

up vote 10 down vote accepted

Off the top of my head I'd do this. It should have good computational complexity (hash table) though as a general pattern-based method it is unlikely to be as fast a a numeric or compiled approach:

Module[{f},
 f[{x_, _}] := (f[{_, x}] = False; True);
 Select[testcase, f]
]
{{1, 2}, {1, 3}, {3, 4}, {4, 9}, {7, 5}}

It does have the advantage of being easy to apply to a series of lists: just omit the Module.

I am assuming you have already filtered verbatim duplicates with DeleteDuplicates[testcase] beforehand.


The code above was written in haste, without considering optimizations. After seeing belisarius's suggestion I propose this:

Module[{f, g},
  g[_] = True;
  f[{x_, _}] := (g[x] = False; True);
  Cases[testcase, {_, _?g}?f]
]
{{1, 2}, {1, 3}, {3, 4}, {4, 9}, {7, 5}}

Timings:

big = DeleteDuplicates @ RandomInteger[999, {50000, 2}];

Module[{f},
  f[{x_, _}] := (f[{_, x}] = False; True);
  Select[big, f]
] // Length // Timing
{3.681, 4001}
Module[{f, g},
  g[_] = True;
  f[{x_, _}] := (g[x] = False; True);
  Cases[big, {_, _?g}?f]
] // Length // Timing
{0.031, 4001}

I expect that this can be improved further, but I'm out of time. I'd start by trying "DefinitionsReordering" -> "None" as done here.


Two more variations that are not as fast, but I like the style (the first one is pretty close):

Module[{g}, Cases[testcase, {x_, Except[_?g]} /; (g[x] = True)]]

Module[{g}, DeleteCases[testcase, {_, _?g} | {x_ /; (g[x] = True;), _}]]
{{1, 2}, {1, 3}, {3, 4}, {4, 9}, {7, 5}}

{{1, 2}, {1, 3}, {3, 4}, {4, 9}, {7, 5}}
share|improve this answer
    
Reap@Module[{f}, f[{x_, _}] := (f[{_, x}] = False; True); Scan[If[f@#, Sow@#] &, testcase]] is like 10% faster here, nevertheless I agree that the meat is in the pattern matching thing –  belisarius Feb 20 at 6:44
2  
That gave me an idea ... try the performance of Reap@Module[{f}, f[{x_, y_}] := (f[x] = False); Scan[If[f@#[[2]], , , f@Sow@#] &, testcase]] –  belisarius Feb 20 at 7:16
    
@belisarius: Clever, and surprisingly quick! I came up with a couple of ideas at dinner, will test and post back - I'd tried something similar to first comment & Mr. W's, your new one is much more efficient in the few tests I've just run. –  rasher Feb 20 at 7:21
    
@rasher Yup, the idea was eliminating the pattern matching –  belisarius Feb 20 at 7:24
2  
@belisarius: Please, make your comment an answer. My idea using a dummy array with prepend/delete/scan was only a bit faster, and is fugly-kludge-a-licious... your's (and Mr. W's) are pretty and fast. Using it now in an updated idea from another post. Thanks. both of you! –  rasher Feb 20 at 9:45
show 3 more comments

Perhaps not too different:

f[x_, y_] := (f[_, x] = Sequence[]; {x, y});
g[x_, y_] := (g[x, y] = Sequence[]; {x, y});

Test data:

testcase = {{1, 2}, {2, 1}, {1, 3}, {3, 4}, {4, 9}, {1, 3}, {6, 
    4}, {9, 4}, {7, 5}, {6, 7}, {5, 7}};

Applying:

g@@@(f@@@ testcase)

yields:

{{1, 2}, {1, 3}, {3, 4}, {4, 9}, {7, 5}}

Note in this particular case replacing head with f would remove the repeated {1,3} because of the {3,4} earlier in the list. However, would not work in general, e.g. repeated elements (with distinct sub elements) next to each other.

share|improve this answer
add comment

Here's an alternate solution, that quite literally selects every element whose second entry does not exists as a first entry for some "earlier" member:

Module[{firstElems = testcase[[All, 1]], i = 0}, 
 Select[testcase, FreeQ[Take[firstElems, i++], #[[2]]] &]]
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.