# Complement of multisets

Given lists $a$ and $b$, which represent multisets, how can I compute the complement $a\setminus b$?

I'd like to construct a function xunion that returns the symmetric difference of multisets. For example, if $a=\{1, 1, 2, 1, 1, 3\}$ and $b=\{1, 5, 5, 1\}$, then their symmetric difference is $\big((a\cup b)\setminus(a\cap b)\big)\setminus(a\cap b)=(a\setminus b)\cup(b\setminus a)=\{1,1,2,3,5,5\}$.

-

I don't pretend this is the most efficient or pretty, but here's a go at what I think you're after (see latter part of post for faster and simpler realizations):

a = {1, 1, 2, 1, 1, 3};
b = {1, 5, 5, 1};

result = Join[
Flatten[ConstantArray @@@
Flatten[Replace[Cases[GatherBy[Join[Tally[#1], Tally[#2]], First],
{{Alternatives @@ a, _} ..}], {{a_, b_}, {c_, d_}} :>
{{a, Max[0, b - d]}}, 1], 1]],
Flatten[
ConstantArray @@@
Flatten[Replace[Cases[GatherBy[Join[Tally[#2], Tally[#1]], First],
{{Alternatives @@ b, _} ..}], {{a_, b_}, {c_, d_}} :>
{{a, Max[0, b - d]}}, 1], 1]]] &[a, b]

(* {1, 1, 2, 3, 5, 5} *)


Here's a much faster alternative for big lists:

Module[{ta = Tally[#1], tb = Tally[#2], tab, tba, j},

tab = Tally[Join[#1, #2]][[;; Length@ta]];
ta[[All, 2]] = ta[[All, 2]] - (tab - ta)[[All, 2]];

tba = Tally[Join[#2, #1]][[;; Length@tb]];
tb[[All, 2]] = tb[[All, 2]] - (tba - tb)[[All, 2]];

j = Join[ta, tb];

Flatten[ConstantArray @@@ Pick[j, Sign[j[[All, 2]]], 1]]] &[a, b]


And after partitioning a steak and doing a gatherby on dessert, this simpler and even faster idea popped into the cranium:

With[{du = DeleteDuplicates@Join[#1, #2]},
Join @@ ConstantArray @@@
Transpose[{du, Abs[Subtract[Tally[Join[du, #1]], Tally[Join[du, #2]]][[All, 2]]]}]] &[a, b]

-
Join @@ ConstantArray @@@ Flatten[{Tally /@ {a, b} //. {{a___, {n_, x_}, b___}, {c___, {n_, y_}, d___}} :> {{a, b}, {c, d, {n,Abs[ x - y]}}}, 1] –  belisarius Jun 4 '14 at 1:07
@belisarius: Yeah, I pondered such a mostly rule/replace solution, but agonizingly slow on larger problems. BlankNullSequence... the performance killer. –  ciao Jun 4 '14 at 1:13
Yup, that is why I haven't posted it as an answer. ReplaceRepeated and ___ always tend to indulge a nap –  belisarius Jun 4 '14 at 1:15
Your answer is the multiSymmetricDifference. Could you please also add the multiComplement, so I can accept? –  Leon Jun 9 '14 at 14:12

Here's my version.

Clear[multiComplement];
multiComplement[a_, b_] :=
Join @@ (ConstantArray[First@#, Max[Last@#, 0]] & /@ (Tally[a] /.
(Tally[b] /. {e_, c_Integer} :> {e, k_Integer} -> {e, k - c})));


In action:

With[{a = {1, 1, 2, 1, 1, 3}, b = {1, 5, 5, 1}},
multiComplement[a, b]~Join~multiComplement[b, a]
]


{1, 1, 2, 3, 5, 5}

It appears essentially the same as rasher's (who is indeed 10 minutes rasher). The main points are using Tally to get a count of how often each element appears. Then using rules to pick out the same elements in the tally on the other set. Working out the tally difference, and ignore the negative count Max[0, ...]. Finally the new tally is expanded with ConstantArray.

-
+1 on the tally idea (had some though, see update) - but strangely (have not analyzed it yet deeply) yours gets very slow with larger lists and many distinct elements (I'm guessing the replace is the killer...) –  ciao Jun 4 '14 at 1:10
I tend to use rules quite a lot because I think it is very clear what they do (although I admit the answer here is quite obfuscated). And yes, the performance does degrade with larger lists. But we don't want to prematurely optimise. –  wxffles Jun 4 '14 at 1:35

Another way (slower than rasher's):

Clear[simComplement];
simComplement[a_, b_] := Join @@ (Fold[DeleteCases[#1, #2, {1}, 1] &, #[[1]],
Join@#[[2]]] & /@ {{a, b}, {b, a}})

With[{a = {1, 1, 2, 1, 1, 3}, b = {1, 5, 5, 1}}, simComplement[a, b]]
(*
{2, 1, 1, 3, 5, 5}
*)

-

I believe this question is nearly a duplicate of Removing elements from a list which appear in another list but since this one allows other, potentially better, solutions it should not be closed.
To illustrate, using Leonid's unsortedComplement or my removeFrom2:

a = {1, 1, 2, 1, 1, 3};
b = {1, 5, 5, 1};

unsortedComplement[a, b] ~Join~ unsortedComplement[b, a] // Sort

removeFrom2[a, b] ~Join~ removeFrom2[b, a] // Sort

{1, 1, 2, 3, 5, 5}

{1, 1, 2, 3, 5, 5}


Unfortunately rasher's solution from that question doesn't appear to be directly applicable here.

-
+1, forgot about that neat question. Yeah, using that method from the linked question is a lot of baggage for the simpler problem here... –  ciao Jun 4 '14 at 8:48
Thanks for reminding me of that question and LS' unsortedComplement: I adapted the method I used above to a plain unsorted complement that is from 3X to over an order of magnitude faster than LS' version. –  ciao Jun 4 '14 at 10:20