9
$\begingroup$

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.

$\endgroup$
1

3 Answers 3

10
$\begingroup$

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}}
$\endgroup$
8
  • $\begingroup$ 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 $\endgroup$ Feb 20, 2014 at 6:44
  • 2
    $\begingroup$ 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]] $\endgroup$ Feb 20, 2014 at 7:16
  • $\begingroup$ @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. $\endgroup$
    – ciao
    Feb 20, 2014 at 7:21
  • $\begingroup$ @rasher Yup, the idea was eliminating the pattern matching $\endgroup$ Feb 20, 2014 at 7:24
  • 2
    $\begingroup$ @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! $\endgroup$
    – ciao
    Feb 20, 2014 at 9:45
1
$\begingroup$

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.

$\endgroup$
1
$\begingroup$

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]]] &]]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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