Removing elements from a list which appear in another list

Question

There are two lists {a, b, c, a, d, a, e} and {a, c, a}. I need to remove those elements from the first list which appears in a second list, to get {b, d, a, e}

Answer 1

removeFrom[a_List, b_List] := Module[{f},
  f[_] = 0;
  (f[#] = -#2) & @@@ Tally[a];
  Pick[b, UnitStep[f[#]++ & /@ b], 1]
]

removeFrom[{a, c, a}, {a, b, c, a, d, a, e}]

{b, d, a, e}

---

Here somewhat longer but also a bit more efficient:

removeFrom2[a_List, b_List] := Module[{f, g},
  (f[#] = -#2) & @@@ Tally[a];
  g[x_] /; f[x] < 0 := f[x]++;
  g[_] = True;
  Select[b, g]
]

This avoids incrementing counters for elements that will never be dropped.

With some data this is not too far behind Leonid's method:

short = RandomInteger[1*^5, 2*^4];
long  = RandomInteger[1*^5, 2*^5];

unsortedComplement[long, short] // Short // Timing
removeFrom2[short, long]        // Short // Timing

{0.202, {68819,45303,67901,31724,23958,11781,29518,20287,46528,<<183297>>,75098,80755,34879,14667,67114,86027,24796,95072,59695}}

{0.25, {68819,45303,67901,31724,23958,11781,29518,20287,46528,<<183297>>,75098,80755,34879,14667,67114,86027,24796,95072,59695}}

Where there is heavy duplication Leonid's method is still much faster than mine.

Answer 2

 list1 = {a, b, c, a, d, a, e}; list2 = {a, c, a};
 Fold[Delete[#1, Position[#1, #2, 1, 1]] &, list1, list2]
 (* {b, d, a, e} *)

or

 With[{patt = Table[Unique[], {Length[list2] + 1}]},
 ReplaceAll[list1,  Riffle[Pattern[#, BlankNullSequence[]] & /@ patt, list2] :> patt]]
 (*  {b, d, a, e} *)

Answer 3

Implementation

I am sure I missed a more elegant / short version, but here is an implementation which will be efficient even for large lists:

Clear[unsortedComplement];
unsortedComplement[x_, y_] :=
  Module[{order, xsorted, distinct, freqs, posintervals, freqrules},
    xsorted = x[[order = Ordering[x]]];
    {distinct, freqs} = Transpose[Tally[xsorted]];
    freqrules = Dispatch[Append[Rule @@@ Tally[y], _ -> 0]];
    posintervals =
      Transpose[{
         Most[#] + Replace[distinct, freqrules, {1}],
         Rest[#] - 1
      }] &[Prepend[Accumulate[freqs], 0] + 1];
    x[[Sort@order[[Flatten[Range @@@ posintervals]]]]]]

It borrows main ideas from here, but modifies it to the needs of the problem at hand. Once position intervals for elements in the sorted main list are found, they are shrinked by the number of same elements present in the second list, from the start (from the left end). From this, I generate partial list of positions in the ordered list, and reverse that via the ordering of that list, to get a list of positions in the original list. The algorithm has a log-linear complexity in the length of the first list and linear complexity in the length of the second list.

Examples and benchmarks

We have

unsortedComplement[{a,b,c,a,d,a,e},sub = {a,c,a}]

(* {b,d,a,e}  *)

for larger lists:

large1 = RandomInteger[1000,10^5];
large2 = RandomInteger[1000,10^4];

(res1=unsortedComplement[large1,large2])//Short//Timing 

(* {0.078,{951,956,345,459,345,951,956,<<89986>>,443,977,568,340,496,887,946}} *)

(res2=Fold[Delete[#1,Position[#1,#2,1,1]]&,large1,large2])//Short//Timing

(* {35.,{951,956,345,459,345,951,956,<<89986>>,443,977,568,340,496,887,946}} *)

res1==res2

(* True *)

Answer 4

Here's a slightly unconventional solution using patterns, and is very compact too:

{list1, list2} = {{a, c, a}, {a, b, c, a, d, a, e}};
Fold[# /. #2 &, list2, {h___, #, t___} :> {h, t} & /@ list1]
(* {b, d, a, e} *)

This exploits the fact that by default, BlankNullSequence[] seeks the Shortest sequence, thus you end up eating the occurrences from the left, as desired.

Answer 5

In Mathematica 9.0.0 there are several undocumented functions for dealing with hash maps explicitly.

• Language`HashMap[key1->val1, key2->val2, ...] creates new hash map from rules
• Language`HashMapAssociate[hmap, key, value] adds new key/value pair
• Language`HashMapLookup[hmap, key] returns value associated with a key

Here is the solution based on these functions:

remover[long_List, short_List] := Module[{hmap, lookupresult},
  hmap = Language`HashMap@@Apply[Rule, Tally[short], {1}];
  Select[long, (lookupresult = Language`HashMapLookup[hmap, #];
     Or[lookupresult === $Failed, lookupresult === 0, 
      (hmap = Language`HashMapAssociate[hmap, #, lookupresult - 1]; False)]) &]
  ]

But for this particular question solutions by Leonid and Mr.Wizard are faster.