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.

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}

share|improve this question
3  
@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
add comment

7 Answers

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.

share|improve this answer
    
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
    
@Leonid Thanks. As usual we bring different things to the table. I'm still trying to understand yours... –  Mr.Wizard Jan 20 '13 at 10:49
1  
Read the explanation on the page I linked to, it is pretty detailed. –  Leonid Shifrin Jan 20 '13 at 10:50
1  
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
1  
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
show 8 more comments
 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} *)
share|improve this answer
add comment

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 *)
share|improve this answer
add comment

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.

share|improve this answer
    
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
1  
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...) –  rm -rf 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. –  rm -rf Jan 21 '13 at 17:25
show 3 more comments

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.

share|improve this answer
add comment

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% :

enter image description here

share|improve this answer
    
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 22 hours ago
    
Is findMultiPos here the same function as findMultiPosXX in the linked post? –  Mr.Wizard 22 hours ago
    
@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. –  rasher 21 hours ago
add comment

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}
share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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