# Removing elements from a list which appear in another list

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}

-
@VLC It is not a dupe, since here duplicate excessive elements are allowed to stay. –  Leonid Shifrin Jan 20 '13 at 9:05
Related but not duplicate: (1290) –  Mr.Wizard Jan 20 '13 at 10:28

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

-

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

-

Please see my second answer; the method therein is far more efficient than the ones below.

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

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

{b, d, a, e}


Here somewhat longer but also a bit more efficient:

removeFrom2[b_List, a_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[long, short]        // 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.

-
Good work. I tried something along these lines but failed to make it simple. This is about 5 times slower than mine for the large lists I tried, but pretty fast for its code size. +1. –  Leonid Shifrin Jan 20 '13 at 10:48
Read the explanation on the page I linked to, it is pretty detailed. –  Leonid Shifrin Jan 20 '13 at 10:50
Your solution has a potentially better complexity than mine (linear in both lists), but is slowed down by the hash lookup constant,and, more importantly, multiple assignments / hash modifications you perform at run-time. So, the larger the lists, the more your solution is favored. Theoretically, for some large lists, it should become faster than mine. In practice, the lists should probably be very large to observe that. –  Leonid Shifrin Jan 20 '13 at 10:52
Yes, I do confirm. But the main reason for why your code is speed-equivalent to mine in your new benchmark is that you used data with very little repetition (almost all elements are unique). When you use my benchmarks, you still see 5-7 times difference. So, your method is optimal for almost unique data. This is not to detract from your solution, of course. I find it quite interesting that you found such a fast one based on rules / hashes, somehow I did not expect this would be possible. –  Leonid Shifrin Jan 20 '13 at 13:48
isn't this a duplicate? –  Kuba Feb 21 at 7:33

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.

-
Surely clever, but also very slow. Can you think of a way to make this faster? Something to keep the list from being rescanned so many times? –  Mr.Wizard Jan 20 '13 at 16:55
Nevertheless this appears to be faster than the more obvious Position method so +1. –  Mr.Wizard Jan 20 '13 at 17:01
Heh, replacements with ___ is never going to beat/come close to a solution like yours/Leonid's :) But yes, it's quite a bit faster than the Position approach... I can't think of ways to speed it up right now. At least, not without significantly altering the simplicity of the above solution (maybe there is a way and I'm just being thick...) –  The Toad Jan 20 '13 at 20:06
I'm surprised that Position is slower (it is, I ran it on my computer -- quite a bit slower). Any thoughts on why it is slow? –  Mike Honeychurch Jan 20 '13 at 21:16
@MikeHoneychurch I'm not entirely sure (Leonid would be the one to ask), but if I had to guess, I'd wager that it's because pattern matching is performed at a much lower level (i.e., not in the main evaluation loop) than Position, thus reducing some of the overhead. –  The Toad Jan 21 '13 at 17:25

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

• LanguageHashMap[key1->val1, key2->val2, ...] creates new hash map from rules
• LanguageHashMapAssociate[hmap, key, value] adds new key/value pair
• LanguageHashMapLookup[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 = LanguageHashMap@@Apply[Rule, Tally[short], {1}];
Select[long, (lookupresult = LanguageHashMapLookup[hmap, #];
Or[lookupresult === \$Failed, lookupresult === 0,
(hmap = LanguageHashMapAssociate[hmap, #, lookupresult - 1]; False)]) &]
]


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

-

An approach using Reap and Sow avoiding rescanning list.

Simple Approach where order does not matter

simple[h_, p_] :=
Join @@ (Table[#[[1]], {#[[2]]}] & /@
Cases[Last@
Reap[Sow[1, #] & /@ h; Sow[-1, #] & /@ p, _, {#1, Total@#2} &],
Except[{_, 0}]])


For the test case this yields:

{a, b, d, e}


Perhaps, not the desired outcome.

Order matters

This is somewhat messy but I post anyway. Most of the code relates to order:

comp[x_, y_] := Module[{},
fun[q_] :=
If[Length[q] == 1, q,
Drop[#[[1]], Length[#[[2]]]] &@GatherBy[q, Sign]];
ls[u_, v_] :=
Cases[Last@
Reap[Join[Table[Sow[j, u[[j]]], {j, Length[u]}],
Table[Sow[-j, v[[j]]], {j, Length[v]}]], _, {#1, fun[#2]} &],
Except[{_, {}}]];
ord[u_] := Module[{pos, tab, or},
pos = Flatten@u[[All, 2]];
or = Thread[Sort[pos] -> Range[Length[pos]]];
tab = Table[1, {Length[pos]}];
ReplacePart[tab,
Flatten@(Thread[#[[2]] -> #[[1]]] & /@ (u /. or))]];
ord[ls[x, y]]]


For the test case this yields the desired:

{b, d, a, e}

-

A much faster method. Based on my method for multiple-position finding:

uc[list_, eles_] := Module[{dt = Tally[eles], fm},
fm = findMultiPosXX[list, dt[[All, 1]]];
list[[Delete[Range@Length@list,
Transpose[{Flatten[MapThread[Take, {fm, dt[[All, 2]]}]]}]]]]]


Caveats: I assume the list of elements to be deleted is a subset of the target list. Easily modified if that's not the case.

A quick performance comparison with the two fasted methods posted previously. Relative performance (time, normalized to 1 for the fastest), on a list generated with RandomInteger[size,1000000]. Labels correspond to size of "unique" pool of the 1000000 elements and number of elements deleted ( 1/10%, 1%, and 10% for each size). Over this test set, the average advantage is about 9X faster than the fastest alternative of each set, ranging from about a 65% advantage to over 12000% :

-
I haven't yet made the time to read and understand your recent series of related answers but the timings look very impressive. I do feel embarrassed for my answer now however. :-p –  Mr.Wizard Apr 23 '14 at 8:08
Is findMultiPos here the same function as findMultiPosXX in the linked post? –  Mr.Wizard Apr 23 '14 at 8:11
@yep - (well, a shortened version). I'll edit to show "XX". Sounds meaner... Re: prior comment: LOL, your method(s) are slick, as usual, and I've been surprised at the effectiveness of the multi-position trick on several problems I'd been working on. –  ciao Apr 23 '14 at 8:17

## New proposal

I was thinking about this problem today and came up with a new approach. In testing it appears to be competitively fast, often notably faster than any other method yet posted. It is also quite clean.

A limitation shared with rasher's uc: all elements in the drop list must be present in the main list.

fastRF[a_List, b_List] :=
Module[{c, o, x},
c = Join[b, a];
o = Ordering[c];
x = 1 - 2 UnitStep[-1 - Length[b] + o];
x = FoldList[Max[#, 0] + #2 &, x];
x[[o]] = x;
Pick[c, x, -1]
]


The question example:

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

{b, d, a, e}


## Timings

The prior frontrunners for performance are Leonid's unsortedComplement and rasher's uc. I shall compare these to fastRF as well as my earlier removeFrom2. Here is a chart showing the performance of each function at removing a variable number of elements (second parameter) from a starting list of one million elements (first parameter). Timings performed in version 10.0.2.

Needs["GeneralUtilities"]

one = RandomInteger[1*^5, 1*^6];

BenchmarkPlot[
{
removeFrom2[one, #] &,
unsortedComplement[one, #] &,
uc[one, #] &,
fastRF[one, #] &
},
RandomSample[one, #] &,
5^Range[8],
TimeConstraint -> 30
]


For all values (in this test) fastRF is indeed the fastest.

## Explanation

The code above is quite opaque compared to my more direct and literal first answer. I think an explanation is in order.

The list of elements-to-remove, named b, is inserted at the beginning of main list, named a. Then the Ordering of this combined list is found. For the question example that looks like this, juxtaposed with the sorted list for illustration:

com = {a, c, a, a, b, c, a, d, a, e}
ord = Ordering[com]
com[[ord]]

{a, c, a, a, b, c, a, d, a, e}

{1, 3, 4, 7, 9, 5, 2, 6, 8, 10}

{a, a, a, a, a, b, c, c, d, e}


1, 2, 3 in ord are the elements to drop, each along with a copy from the main list. For example 4 and 7 should be dropped because of 1 and 3, and 6 should be dropped because of 2. To achieve this I first apply numeric transformations including UnitStep to turn the drop values to 1 and all others to -1. I then use FoldList for a modified accumulate process:

1 - 2 UnitStep[-1 - 3 + ord]
x = FoldList[Max[#, 0] + #2 &, %]

{1, 1, -1, -1, -1, -1, 1, -1, -1, -1}

{1, 2, 1, 0, -1, -1, 1, 0, -1, -1}


Each -1 in the output is an element to keep; all others are elements to drop. I then need to put this list back into the original order of the combined list (com). I use the method Simon Woods posted in Sort two lists at the same time, based on another due to its superior performance. All that remains is to Pick the elements of com that correspond to the -1's in x:

x[[ord]] = x; x

Pick[com, x, -1]

{1, 1, 2, 1, -1, 0, 0, -1, -1, -1}

{b, d, a, e}

-
Very clever. As usual ;-) and +1 o/c –  ciao Feb 21 at 5:15
@rasher Thank you. :-) By the way I tried dropping the length of b from (final) x and picking from a but it didn't seem faster, which surprised me. If you find another way to refine this please let me know. –  Mr.Wizard Feb 21 at 5:20
Doesn't work when the first list has duplicate elements:lrg = {1, 2, 3, 2, 5, 6, 7}; sm = {3, 5, 2}; fastRF[lrg, sm] --> {1, 2, 6, 7}. Besides, I am surprised that this question was even having so many rather complex answers, given this answer of mine, which seems to be faster than any of these, up to hundreds of thousands of elements. Admittedly, this one came out later. Anyway, if you can make it work without making the code a lot more complex, or losing efficiency, you get my upvote. –  Leonid Shifrin Feb 21 at 12:56
@Mr.Wizard Oops. You are right. And I've been quite busy recently indeed, so it's not the first time I've been missing the point recently. Perhaps, time to take a break from SE. As to your code, it is quite clever. To make up for my blunder, I forced myself to understand it just by staring at it, without reading your explanation or trying anything out in Mathematica. Very nice! Of course, you got my vote. –  Leonid Shifrin Feb 21 at 17:38
@Taiki I believe you are experiencing the limitation that I mentioned in this answer. Every element in the drop list must be present in the main list, including sufficient copies of it. So for example fastRF[{3, 1, 2}, {0, 1, 2}] will not work as intended. Neither will fastRF[{3, 1, 2}, {1, 1}]. If this circumstance cannot be prevented it is best to use unsortedComplement` among the methods posted at this time. –  Mr.Wizard Mar 9 at 0:38