# Deleting quasi-duplicates from large list efficiently

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[] == #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.

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

• 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 – Dr. belisarius Feb 20 '14 at 6:44
• That gave me an idea ... try the performance of Reap@Module[{f}, f[{x_, y_}] := (f[x] = False); Scan[If[f@#[], , , f@Sow@#] &, testcase]] – Dr. belisarius Feb 20 '14 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. – ciao Feb 20 '14 at 7:21
• @rasher Yup, the idea was eliminating the pattern matching – Dr. belisarius Feb 20 '14 at 7:24
• @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! – ciao Feb 20 '14 at 9:45

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.

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++], #[]] &]]