Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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

share|improve this question

4 Answers 4

up vote 8 down vote accepted

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]
share|improve this answer
    
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 at 1:07
    
@belisarius: Yeah, I pondered such a mostly rule/replace solution, but agonizingly slow on larger problems. BlankNullSequence... the performance killer. –  rasher Jun 4 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 at 1:15
    
Your answer is the multiSymmetricDifference. Could you please also add the multiComplement, so I can accept? –  Leon Jun 9 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.

share|improve this answer
    
+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...) –  rasher Jun 4 at 1:10
1  
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 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}
*)
share|improve this answer

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.

share|improve this answer
    
+1, forgot about that neat question. Yeah, using that method from the linked question is a lot of baggage for the simpler problem here... –  rasher Jun 4 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. –  rasher Jun 4 at 10:20

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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