How to subtract one list from another, treating each elements as distinct, assuming the smaller list is a subset of the larger list?

Question

Suppose that I have two lists of different sizes, the smaller of which is a subset of the larger, e.g.

a = {"A", "A", "A", "B", "B", "C"}
b = {"A", "B"}

How can I subtract b from a, treating each element as distinct, such that the result is {"A", "A", "B", "C"}?

One solution I can think of is to use

Merge[{Counts[a], -Counts[b]}, Total]

then reconstruct the result somehow, but is there a simpler way?

Answer 1

Fold[DeleteCases[##, 1, 1] &, a, b]

{"A", "A", "B", "C"}

Answer 2

For efficiency, treat them as variables and let Plus do the work:

List @@ (Plus @@ a - Plus @@ b)

and convert to a list if you want:

{"A", 2 "B", -3 "C"} /. (n_*v_ :> 
   Sequence @@ ConstantArray[v,n])
(* => {"A", "B"} *)

Update Kuba's solution is elegant but not efficient nor does it maintain a sorted order, look at the performance:

In[1]:= {a, b} = Map[
   FromCharacterCode /@ RandomInteger[{67, 77}, #] &, {100000, 
    10000}];

In[2]:= AbsoluteTiming[Fold[DeleteCases[##, 1, 1] &, a, b]]
Out[2]= $Aborted (* still running after 20 seconds... *)

In[3]:= AbsoluteTiming[List @@ (Plus @@ a - Plus @@ b)]
Out[3]= {0.041489, {8114 "C", 8177 "D", 8182 "E", 8328 "F", 
  8123 "G", 7934 "H", 8191 "I", 8267 "J", 8348 "K", 8223 "L", 
  8113 "M"}}

Answer 3

To reconstruct the result somehow:

reconstructF=Join@@ConstantArray@@@Normal@#&;

reconstructF@Merge[Total][{Counts[a],- Counts[b]}]
(* {"A", "A", "B", "C"} *)

Answer 4

If (a) preserving the order of the minuend list and (b) respecting the order of the subtrahend list are important to you (or to someone else reading this post), here's a neat solution that seems to perform well:

listComplement1[a_List, b_List] :=
 Module[{j = 1},
  With[{bn = Length@b},
   Select[a, j > bn || # =!= b[[j]] || ++j &]
   ]
  ]

listComplement1[a, b]

(* Out: {"C", "A", "A", "A", "B", "C"} *)

And just because I can, here's a semi-compiled version that uses integer codes for distinct elements! Wheee!

listComplement2Helper =
  Compile[{{a, _Integer, 1}, {b, _Integer, 1}},
   Module[{j = 1},
    With[{bn = Length@b},
     Select[a,
      If[j > bn || # =!= b[[j]],
        True,
        ++j; False
        ] &
      ]
     ]
    ]
   ];

listComplement2[a_List, b_List] := 
 With[{rels = MapIndexed[# -> #2[[1]] &, DeleteDuplicates@a]},
  With[
   {fwdMap = Dispatch@Append[rels, _ -> 0],
    revMap = Dispatch[Reverse /@ rels]},
   Replace[
    listComplement2Helper[
     Replace[a, fwdMap, {1}],
     Replace[b, fwdMap, {1}]],
    revMap,
    {1}
    ]
   ]
  ]

listComplement2[a, b]

(* Out: {"C", "A", "A", "A", "B", "C"} *)

At first I thought that integer codes could speed things up when the list elements are (a) very many, (b) very complicated, and (c) very similar, but now I'm thinking it won't help much (if at all) due to the comparisons that have to happen anyway for DeleteDuplicates... Oh well, still fun.

---

Caveat: All elements in b after the first element in b that is not also in a will not be removed from a.

---

Note: This answer previously also suggested a solution using SequenceAlignment. Unfortunately, this approach doesn't seem to work. I couldn't figure out a nice way to adapt SequenceAlignment to the requirements here.

Answer 5

a = {2 "A", "A", "A", "B", "B", "C"};
b = {"A", "B"}; 

Delete[a, First[Position[a, #, 1]] & /@ b]
(*{2 "A", "A", "B", "C"}*)