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

-
Somewhat related: How to select minimal subsets? – Mr.Wizard Feb 20 '14 at 5:22

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

-