Complement of multisets

Question

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\}$.

Answer 1

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]

Answer 2

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.

Answer 3

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

Answer 4

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.

Answer 5

DeleteElements, new in V 13.1, simplifies this task considerably:

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

Since DeleteElements works from left to right, we have to use Reverse twice.

com[{x_, y_}] :=
 Reverse @ DeleteElements[Reverse @ x, Rule @@ Reverse @ Transpose @ Tally[y]]
com[{a, b}]~Join~com[{b, a}]

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