5
$\begingroup$

Suppose I have list2 which is a subset of list1. I want to get a res by deleting an element from list1 whenever there is such an element in list2. I think of this as being the reversal of the operations of Join and Complement which respects multiplicities.

Examples

{1, 2, 3, 4} and {1, 3} results in {2, 4}
{1, 2, 3, 3, 4, 4} and {1, 3, 4} results in {2, 3, 4}

My implementation

myComplement[full_, todel_] := 
  Fold[Delete[#1, Position[#1, #2, 1, 1]] &, full, todel]

Is there more efficient and elegant way to achieve this?

$\endgroup$
1
  • 1
    $\begingroup$ I appreciate the check, but I don't really collect them. In any case, not trying to tell you how to accept, but unless your lists are large and the deletion list is large, one of the other answers (e.g. @JasonB and @m_goldberg) should be as quick, and are pretty and concise (and readable). I just tossed in something I'd used where speed was critical. $\endgroup$
    – ciao
    Jun 25, 2016 at 5:01

4 Answers 4

10
$\begingroup$
cd= Module[{t1 = 2 Tally[#1], t2 = Tally[Join[#1, #2]], t3},
    Sort[Join @@ ConstantArray @@@ 
           Pick[t3 = Transpose[{t2[[;; Length@t1, 1]], 
                Subtract[t1[[All, 2]], t2[[;; Length@t1, 2]]]}], 
                 Sign@t3[[All, 2]], 1]]] &;

Using

test = RandomInteger[1*^6, 1*^5];
del = RandomSample[test, 1*^3];
result= cd[test,del];

seems fairly quick.

N.b. this generates the result sorted (as Complement does).

Also - I'm sure I've seen a possible duplicate to this question...

$\endgroup$
6
  • $\begingroup$ +1 - When I saw that my function below was taking 6 seconds to do it, I hoped you would come in to show the right way to do it. I don't fully understand your method but it is 3 orders of magnitude faster.... $\endgroup$
    – Jason B.
    Jun 25, 2016 at 3:49
  • $\begingroup$ @JasonB - depends on sizes of lists - if OP lists are small, simpler and speed comparable to just do it your way, which is concise and pretty (+1). I just assume when someone posts "efficient", it means speed and big datasets involved. $\endgroup$
    – ciao
    Jun 25, 2016 at 3:56
  • $\begingroup$ @ciao always learn from your answers...BTW your urn distribution Q: your own solution seemed terse and efficient...is it part of a larger simulation? Any way hi:) $\endgroup$
    – ubpdqn
    Jun 25, 2016 at 4:54
  • $\begingroup$ @ubpdqn - it's one in my "bag of delete techniques" notebook - depending on list structures, others are faster, and certainly less opaque. Yes, the urn thingy is part of a simulation. Ended up using Lisp (same technique, just faster end result), but still pondering, I've got that gut feeling I've missed something and there's a sneaky and fast way to do that for batched samples. Hi back! $\endgroup$
    – ciao
    Jun 25, 2016 at 5:04
  • $\begingroup$ Are you sure your answer at mathematica.stackexchange.com/questions/18100/… wasn't better? $\endgroup$ Jun 25, 2016 at 9:50
8
$\begingroup$

I can't say if it's more elegant, but this will also do what you seek

myComplement[full_, todel_] := 
 Fold[DeleteCases[#1, #2, 1, 1] &, full, todel]

myComplement[{1, 2, 3, 3, 4, 4}, {1, 3, 4}]
(* {2, 3, 4} *)

This seems to be about twice as fast as OP's function (which I call myComplementOP below)

list0 = Range[10000];
list1 = Flatten[{#, #, #} & /@ list0];
myComplement[list1, list0]; // AbsoluteTiming
(* {6.35861, Null} *)

myComplementOP[list1, list0]; // AbsoluteTiming
(* {13.7853, Null} *)

But I'm not impressed by the speed

$\endgroup$
4
  • $\begingroup$ Yeah, this is much faster than mine $\endgroup$
    – vapor
    Jun 25, 2016 at 2:57
  • $\begingroup$ Glad to help, I was just about to try and construct a larger list to do a speed test on, but I hadn't so I couldn't comment on efficiency. I'm a chemist not a computer scientist so I can't just look at a function and tell you if it scales logarithmically or via power law $\endgroup$
    – Jason B.
    Jun 25, 2016 at 2:59
  • $\begingroup$ @JasonB nice +1...hope WA is great...:) $\endgroup$
    – ubpdqn
    Jun 25, 2016 at 4:15
  • $\begingroup$ @ubpdqn - thanks! It's fun so far, just training. I don't get to "goof off" on here as much as I'd like to $\endgroup$
    – Jason B.
    Jun 25, 2016 at 4:24
7
$\begingroup$

Update

Modified to address ciao's comment.

I think this is good implementation because it's simple, robust, and avoids all those calls to Position.

complement[set1_List, set2_List] /; ContainsAll[set1, set2] :=
  Module[{k, s1, s2}, 
    k = Union[set1];
    s1 = Split[Sort[set1~Join~k]];
    s2 = Split[Sort[set2~Join~k]];
    MapThread[Drop[#1, UpTo[Length[#2]]] &, {s1, s2}] // Flatten]

data = {1, 2, 3, 3, 4, 4, 5, 5};
remove = {1, 4, 3, 4, 5};
complement[data, remove]

{2, 3, 5}

Showing that it also works with symbols.

complement[{a, c, b, e, b, a}, {a, b, a}]

{b, c, e}

Removes all the the instances of b that it can.

complement[{b, a, b, c}, {a, b, b, b}]

{c}

Doesn't evaluate because 1st argument doesn't contain e.

complement[{b, a, b, c}, {a, b, b, e}]

complement[{b, a, b, c}, {a, b, b, e}]

$\endgroup$
6
  • $\begingroup$ Might want to add a check for second argument contained in first... $\endgroup$
    – ciao
    Jun 25, 2016 at 4:09
  • $\begingroup$ @ciao. That's a good point since I checked for lists, I should do that, too. $\endgroup$
    – m_goldberg
    Jun 25, 2016 at 4:26
  • $\begingroup$ @ciao. It turns out what you ask is rather difficult if multiplicities are maintained. I have modified my code to be more robust in vetting 2nd arguments, but it doesn't fully meet your requirement as I understand it. $\endgroup$
    – m_goldberg
    Jun 25, 2016 at 5:03
  • $\begingroup$ I hope you did not take comment in the wrong way (I have no "requirement") - it was just a note that if the second argument has elements not in the target list, it blows up, which some kind of "list 2 is contained in list 1, if not drop wayward elements..." kind of check. $\endgroup$
    – ciao
    Jun 25, 2016 at 5:08
  • $\begingroup$ @ciao I don't think I took it wrong. You made a valid point and I hope I have now addressed it. My function no longer blows up on the kind 2nd argument it couldn't handle before. It also, I think, intelligently handles the case where 2nd argument has an element that in the 1st argument, but with a higher multiplicity. $\endgroup$
    – m_goldberg
    Jun 25, 2016 at 5:17
2
$\begingroup$

Just something silly(and ugly):

cf[a_, b_] := 
 Module[{as = Association[Rule @@@ Tally[a]], 
   bs = Association[Rule @@@ Tally[b]]},
  Catenate@
   KeyValueMap[
    With[{s = #2[[1]] - #2[[2]]}, If[s < 0, {}, Table[#1, {s}]]] &, 
    Merge[KeyUnion[{as, bs}], (# /. _Missing :> 0 &)]]]

It is less inefficient than I thought it would be:

enter image description here

$\endgroup$

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