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.

This question already has an answer here:

I want to do subtraction with sets l1 and l2, which contain multiplicity indicators. For example,

 l1 = {{1, 1}, {1, 1}, {2, 2}, {3, 4}};
 l2 = {{1, 1}, {2, 2}};
 subset[l1, l2]
{{1, 1}, {3, 4}}

What's the best way to do this?

share|improve this question

marked as duplicate by Mr.Wizard Dec 20 '13 at 17:41

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.

2  
Pardon me, why is {3,4} in the subset list? –  Mr.Wizard Dec 19 '13 at 14:55
    
Do you know about Intersection and Complement? Intersection[l1, l2] == {{1, 1}, {2, 2}} and Complement[l1, l2] == {{3, 4}} –  ssch Dec 19 '13 at 14:58
2  
Per definition a set is a collection of distinct objects. Therefore, the double {1,1} in l1 is not OK. Otherwise, the solution to your question would be Complement[l1, l2]. –  halirutan Dec 19 '13 at 16:28
1  
I believe the OP is talking about multisets. Well, that seems to be andre's interpretation, too. If so, the question needs to be clarified. –  Michael E2 Dec 19 '13 at 16:47
    
concerning the ordering, what sould be the result if l1={{1,2}}and l2={{2,1}}, {{1,2}} or {} ? –  andre Dec 19 '13 at 17:18

3 Answers 3

up vote 3 down vote accepted
l1={{1,1},{1,1},{2,2},{3,4}};
l2={{1,1},{2,2}};

You want to obtain :

Subset[l1,l2]={{1,1},{3,4}}

that is to say :

  • remove elements of l1 which are in l2.
  • If l1 has identical elements "elt1" you want the multiplicity of the removals to correspond to the multiplicity of "elt1" in l2.

This can be done with :

Fold[#1 /. {start___, #2, end___} :> {start, end} &, l1, l2]  

{{1, 1}, {3, 4}}

The original order of l1 is preserved.

share|improve this answer

This is a fairly fast subtract-by-multiplicity.

deleteByMultiplicity[s1_, s2_] := Module[
  {val, news2, h1},
  news2 = Tally[s2];
  Do[val[news2[[j, 1]]] = news2[[j, 2]], {j, Length[news2]}];
  Reap[Do[
     h1 = val[s1[[j]]];
     If[IntegerQ[h1] && h1 > 0, val[s1[[j]]] -= 1, Sow[s1[[j]]]]
     , {j, Length[s1]}]][[2, 1]]
  ]

Examples:

n = 4;
s1 = RandomInteger[100, {10^n, 2}];
s2 = RandomInteger[100, {Ceiling[10^n/2], 2}];

Timing[d1 = deleteByMultiplicity[s1, s2];]

(* Out[417]= {0.080000, Null} *)
Length[d1]

(* Out[413]= 7289 *)

n = 5;
s1 = RandomInteger[100, {10^n, 2}];
s2 = RandomInteger[100, {Ceiling[10^n/2], 2}];

Timing[d1 = deleteByMultiplicity[s1, s2];]

(* Out[422]= {0.660000, Null} *)

Length[d1]

(* Out[423]= 51692 *)
share|improve this answer
    
Thanks so much! –  Eden Harder Dec 21 '13 at 4:09

An approach using Reap and Sow (where f is used just a wrapper):

fun[a_,b_]:=Join @@ (Table[#[[1]], {#[[2]]}] & /@ (Cases[
   Last@Reap[
     Join[Sow[1, f[#]] & /@a, 
      Sow[-1, f[#]] & /@ b], _, {#1 /. f[x_] :> x, Total@#2} &], 
   Except[{_, 0}]]))

fun[l1,l2] yields the desired:

{{1, 1}, {3, 4}}

Some other tests (just to be clear about what subtraction is desired):

fun[{{1, 1}, {1, 1}, {1, 1}, {1, 1}, {2, 2}, {3, 4}}, {{1, 1}, {2, 
   2}}]

yields:

{{1, 1}, {1, 1}, {1, 1}, {3, 4}}

If the second list contains elements that are not in the first list then the condition for the cases needs to be modified to Except[{_,_(?#<=0&)].

share|improve this answer

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