# Efficient way to compute a complement while respecting multiplicities [duplicate]

This question already has an answer here:

Suppose I have list2 which is a subset of list1. I want to get a res by deleting an element from list1 whenever there is such an element in list2. I think of this as being the reversal of the operations of Join and Complement which respects multiplicities.

Examples

{1, 2, 3, 4} and {1, 3} results in {2, 4}
{1, 2, 3, 3, 4, 4} and {1, 3, 4} results in {2, 3, 4}

My implementation

myComplement[full_, todel_] :=
Fold[Delete[#1, Position[#1, #2, 1, 1]] &, full, todel]


Is there more efficient and elegant way to achieve this?

## marked as duplicate by m_goldberg, MarcoB, user9660, WReach, Yves KlettJun 27 '16 at 6:07

This question has been asked before and already has an answer. If those answers do not fully address your question, please ask a new question.

• I appreciate the check, but I don't really collect them. In any case, not trying to tell you how to accept, but unless your lists are large and the deletion list is large, one of the other answers (e.g. @JasonB and @m_goldberg) should be as quick, and are pretty and concise (and readable). I just tossed in something I'd used where speed was critical. – ciao Jun 25 '16 at 5:01

## 4 Answers

cd= Module[{t1 = 2 Tally[#1], t2 = Tally[Join[#1, #2]], t3},
Sort[Join @@ ConstantArray @@@
Pick[t3 = Transpose[{t2[[;; Length@t1, 1]],
Subtract[t1[[All, 2]], t2[[;; Length@t1, 2]]]}],
Sign@t3[[All, 2]], 1]]] &;


Using

test = RandomInteger[1*^6, 1*^5];
del = RandomSample[test, 1*^3];
result= cd[test,del];


seems fairly quick.

N.b. this generates the result sorted (as Complement does).

Also - I'm sure I've seen a possible duplicate to this question...

• +1 - When I saw that my function below was taking 6 seconds to do it, I hoped you would come in to show the right way to do it. I don't fully understand your method but it is 3 orders of magnitude faster.... – Jason B. Jun 25 '16 at 3:49
• @JasonB - depends on sizes of lists - if OP lists are small, simpler and speed comparable to just do it your way, which is concise and pretty (+1). I just assume when someone posts "efficient", it means speed and big datasets involved. – ciao Jun 25 '16 at 3:56
• @ciao always learn from your answers...BTW your urn distribution Q: your own solution seemed terse and efficient...is it part of a larger simulation? Any way hi:) – ubpdqn Jun 25 '16 at 4:54
• @ubpdqn - it's one in my "bag of delete techniques" notebook - depending on list structures, others are faster, and certainly less opaque. Yes, the urn thingy is part of a simulation. Ended up using Lisp (same technique, just faster end result), but still pondering, I've got that gut feeling I've missed something and there's a sneaky and fast way to do that for batched samples. Hi back! – ciao Jun 25 '16 at 5:04
• Are you sure your answer at mathematica.stackexchange.com/questions/18100/… wasn't better? – Eric Towers Jun 25 '16 at 9:50

I can't say if it's more elegant, but this will also do what you seek

myComplement[full_, todel_] :=
Fold[DeleteCases[#1, #2, 1, 1] &, full, todel]

myComplement[{1, 2, 3, 3, 4, 4}, {1, 3, 4}]
(* {2, 3, 4} *)


This seems to be about twice as fast as OP's function (which I call myComplementOP below)

list0 = Range[10000];
list1 = Flatten[{#, #, #} & /@ list0];
myComplement[list1, list0]; // AbsoluteTiming
(* {6.35861, Null} *)

myComplementOP[list1, list0]; // AbsoluteTiming
(* {13.7853, Null} *)


But I'm not impressed by the speed

• Yeah, this is much faster than mine – happy fish Jun 25 '16 at 2:57
• Glad to help, I was just about to try and construct a larger list to do a speed test on, but I hadn't so I couldn't comment on efficiency. I'm a chemist not a computer scientist so I can't just look at a function and tell you if it scales logarithmically or via power law – Jason B. Jun 25 '16 at 2:59
• @JasonB nice +1...hope WA is great...:) – ubpdqn Jun 25 '16 at 4:15
• @ubpdqn - thanks! It's fun so far, just training. I don't get to "goof off" on here as much as I'd like to – Jason B. Jun 25 '16 at 4:24

### Update

Modified to address ciao's comment.

I think this is good implementation because it's simple, robust, and avoids all those calls to Position.

complement[set1_List, set2_List] /; ContainsAll[set1, set2] :=
Module[{k, s1, s2},
k = Union[set1];
s1 = Split[Sort[set1~Join~k]];
s2 = Split[Sort[set2~Join~k]];
MapThread[Drop[#1, UpTo[Length[#2]]] &, {s1, s2}] // Flatten]

data = {1, 2, 3, 3, 4, 4, 5, 5};
remove = {1, 4, 3, 4, 5};
complement[data, remove]


{2, 3, 5}

Showing that it also works with symbols.

complement[{a, c, b, e, b, a}, {a, b, a}]


{b, c, e}

Removes all the the instances of b that it can.

complement[{b, a, b, c}, {a, b, b, b}]


{c}

Doesn't evaluate because 1st argument doesn't contain e.

complement[{b, a, b, c}, {a, b, b, e}]


complement[{b, a, b, c}, {a, b, b, e}]

• Might want to add a check for second argument contained in first... – ciao Jun 25 '16 at 4:09
• @ciao. That's a good point since I checked for lists, I should do that, too. – m_goldberg Jun 25 '16 at 4:26
• @ciao. It turns out what you ask is rather difficult if multiplicities are maintained. I have modified my code to be more robust in vetting 2nd arguments, but it doesn't fully meet your requirement as I understand it. – m_goldberg Jun 25 '16 at 5:03
• I hope you did not take comment in the wrong way (I have no "requirement") - it was just a note that if the second argument has elements not in the target list, it blows up, which some kind of "list 2 is contained in list 1, if not drop wayward elements..." kind of check. – ciao Jun 25 '16 at 5:08
• @ciao I don't think I took it wrong. You made a valid point and I hope I have now addressed it. My function no longer blows up on the kind 2nd argument it couldn't handle before. It also, I think, intelligently handles the case where 2nd argument has an element that in the 1st argument, but with a higher multiplicity. – m_goldberg Jun 25 '16 at 5:17

Just something silly(and ugly):

cf[a_, b_] :=
Module[{as = Association[Rule @@@ Tally[a]],
bs = Association[Rule @@@ Tally[b]]},
Catenate@
KeyValueMap[
With[{s = #2[[1]] - #2[[2]]}, If[s < 0, {}, Table[#1, {s}]]] &,
Merge[KeyUnion[{as, bs}], (# /. _Missing :> 0 &)]]]


It is less inefficient than I thought it would be: