Deleting quasi-duplicates from large list efficiently

Question

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.

Answer 1

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

Answer 2

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.

Answer 3

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]]] &]]