How to do subtraction with sets in which the elements have multiplicity indicators?

Question

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?

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
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
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 {} ? — andre314, Dec 19 '13 at 17:18
Take a look at this: http://library.wolfram.com/infocenter/MathSource/8115/ — DavidC, Dec 19 '13 at 18:06
Based on the way this question has been interpreted I am closing it as a duplicate. If anyone feels this is inaccurate flag the post for my attention. — Mr.Wizard, Dec 20 '13 at 17:41

andre314 · Accepted Answer · 2013-12-19T16:22:08.400

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.

score 3 · Answer 2 · answered Dec 20 '13 at 01:22

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

score 1 · Answer 3 · answered Dec 20 '13 at 03:32

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&)].

How to do subtraction with sets in which the elements have multiplicity indicators?

3 Answers3