17
$\begingroup$

I want to delete an array of elements from another one, DeleteCases seems to be an option, but the problem is that it deletes an element more than once if available, I do not want this. I want to delete any element as many times as available in second list.

For example DeleteCases[{1, 1, 2, 3}, Alternatives@@{1, 2}] gives {3}, which means it deleted 1 twice from the first array. I want the output to be {1, 3}. Is there any function other than DeleteCases which can do this?

Improve this question
$\endgroup$
3
  • 3
    $\begingroup$ If you want to delete the first case, then the output for your pattern would be {1,2,3} and not {1,3} $\endgroup$
    – Jason B.
    Dec 20, 2019 at 18:27
  • 2
    $\begingroup$ Does this answer your question? Removing elements from a list which appear in another list $\endgroup$
    – Carl Woll
    Dec 20, 2019 at 19:31
  • $\begingroup$ Can you please address Jason's question? $\endgroup$
    – Szabolcs
    Dec 23, 2019 at 9:45

9 Answers 9

Reset to default
14
$\begingroup$

You can Fold the four-argument form of DeleteCases:

Fold[DeleteCases[##, 1, 1] &, {1, 1, 2, 3}, {1, 2}]

{1, 3}

Fold[DeleteCases[##, 1, 1] &, {3, 1, 1, 2, 1}, {1, 2}]

{3, 1, 1}

To handle arbitrary number of lists as input we can Fold twice:

ClearAll[unsortedMultiSetComplement]
unsortedMultiSetComplement = Fold[Fold[DeleteCases[##, 1, 1] &, ##] &, {##}] &;

Examples:

unsortedMultiSetComplement[{1, 1, 2, 3}, {1, 2}]

{1, 3}

unsortedMultiSetComplement[{3, 1, 1, 2, 1}, {1, 2}]

{3, 1, 1}

unsortedMultiSetComplement[{2, 3, 1, 1, 2, 5, 2, 2, 1}, {1, 2}, {2}]

{3, 1, 5, 2, 2, 1}

unsortedMultiSetComplement[foo[c, a, c, a, a, b], foo[c, b], foo[b, b, a]]

foo[c, a, a]

unsortedMultiSetComplement[foo[c, a, c, a, a, b], bar[c, b], buz[b, b, a]]

foo[c, a, a]

Improve this answer
$\endgroup$
9
$\begingroup$

Another option which is based on an update:

Since 13.1 we have a new built-in arrow in our quivers called DeleteElements

With the list of the OP

l={1, 1, 2, 3};

we simply write

DeleteElements[l, {1, 1} -> {1, 2}]

res

The above is simply telling Mathematica to remove up to one instance of 1 and up to one instance of 2 from the list l.

Edit: many thanks to @lericr

In this example, the command can be written using the shorter

DeleteElements[{1, 1, 2, 3}, 1 -> {1, 2}]
Improve this answer
$\endgroup$
6
  • 3
    $\begingroup$ Nice. Or DeleteElements[{1, 1, 2, 3}, 1 -> {1, 2}]. $\endgroup$
    – lericr
    Jan 17 at 15:58
  • $\begingroup$ @lericr Exatly! I just meant to do it as an update and brief explanation of the command. Will update to include yours as it's shorter :-) $\endgroup$
    – bmf
    Jan 17 at 15:59
  • 1
    $\begingroup$ Nice post, Indeed! :-) $\endgroup$
    – E. Chan-López
    Jan 18 at 7:29
  • $\begingroup$ @E.Chan-López thanks :-) $\endgroup$
    – bmf
    Jan 18 at 8:03
  • 1
    $\begingroup$ Hi mate @bmf, the ten ways to do this are ready :-) $\endgroup$
    – E. Chan-López
    Jan 20 at 6:41
8
$\begingroup$

You can use the ResourceFunction MultisetComplement to do this:

ResourceFunction["MultisetComplement"][{1, 1, 2, 3}, {1, 2}]

{1, 3}

Improve this answer
$\endgroup$
1
  • 9
    $\begingroup$ This will sort the target, however... $\endgroup$
    – ciao
    Dec 20, 2019 at 18:49
5
$\begingroup$

Maybe it's worth mentionning that Replace and ReplaceAll does the replacement only once on the whole expression matching the pattern.

So one can do this kind of thing :

Replace[{1, 1, 2, 3}, {a___, 1, b___} -> {a, b}]

{1,2,3}

Notes :

  • the default level specification for Replace is {0}

  • "once on the whole expression matching the pattern" is intended to explain why Replace[{1, 1, 2, 3}, 1 -> Nothing, {1}]doesn't work.

Improve this answer
$\endgroup$
4
  • $\begingroup$ Replace[{1, 1, 2, 3}, 1 -> Nothing, {1}] does work and returns {2, 3}, as expected. Probably you mean Replace[{1, 1, 2, 3}, 1 -> Nothing], where the pattern doesn't match (as expected). $\endgroup$
    – Alexey Popkov
    Dec 23, 2019 at 6:11
  • $\begingroup$ @AlexeyPopkov In my answer, I mean : "doesn't work" to solve OP's problem. I totally agree that Replace[{1,1,2,3},1-> Nothing] works as expected. I will rephrase my answer this evening. By the way I'm not satisfied with the expression "Once ... pattern". If someone has a better and non ambiguous phrasing, I'm interested (I remember that I found even the documentation from Wolfram not clear about the scope of the word "Once". It was many, many years ago...) $\endgroup$
    – andre314
    Dec 23, 2019 at 6:52
  • $\begingroup$ It would be more correct to write "ReplaceAll apples a replacement rule only once on a (sub)expression matching the pattern, and never checks this (sub)expression for matching again." and remove mentioning of Replace from this statement, because Replace works differently: for example, check Replace[{{},{}},{___}->1,{0,-1}]. But I would remove this statement at all, because it isn't related to your answer. Regarding your answer, it is worth to say that Replace (unlike ReplaceList) returns only the result of the first possible match. $\endgroup$
    – Alexey Popkov
    Dec 23, 2019 at 7:14
  • $\begingroup$ It is also worth to mention that for expression patterns the default is Shortest instead of Longest. This is crucially important for your solution. $\endgroup$
    – Alexey Popkov
    Dec 23, 2019 at 7:19
5
$\begingroup$

You may use Tally with DeleteCases in Fold to only fold once per value.

Fold[DeleteCases[#1, First@#2, 1, Last@#2] &, {1, 1, 2, 3}, Tally@{1, 2}]

{1, 3}

Hope this helps.

Improve this answer
$\endgroup$
4
$\begingroup$

Using SubsetReplace:

SubsetReplace[{1, 1, 2, 3}, {1, 2} -> Nothing, 1]
(*{1, 3}*)
SubsetReplace[{3, 1, 1, 2, 1}, {1, 2} -> Nothing, 1]
(*{3, 1, 1}*)
SubsetReplace[{2, 3, 1, 1, 2, 5, 2, 2, 1}, {1, 2} -> Nothing, 1]
(*{3, 1, 2, 5, 2, 2, 1}*)

Or using SubsetPosition and Delete:

delElems[list_List, sublist_List] := 
Delete[list, Transpose@SubsetPosition[list, sublist, 1]]
(*Inspired by Syed's work*)

Examples:

delElems[{1, 1, 2, 3}, {1, 2}]
(*{1, 3}*)
delElems[{3, 1, 1, 2, 1}, {1, 2}]
(*{3, 1, 1}*)
delElems[{2, 3, 1, 1, 2, 5, 2, 2, 1}, {1, 2}]
(*{3, 1, 2, 5, 2, 2, 1}*)
delElems[{{-1, 0, 1, 0}, {0, 1, 0, 1}, {1, 0, 1, 0}, {0, 0, 0, 0}}, {{0, 0, 0, 0}}]
(*{{-1, 0, 1, 0}, {0, 1, 0, 1}, {1, 0, 1, 0}}*)
delElems[{b, c, a, a, b, e, b, b, a}, {a, b}]
(*{c, a, b, e, b, b, a}*)

Now there are ten ways to do it.

Improve this answer
$\endgroup$
3
  • 1
    $\begingroup$ Almost the 10 ways :-) $\endgroup$
    – bmf
    Jan 18 at 8:51
  • 1
    $\begingroup$ Nasser, Syed and Lericr soon join the party :-) $\endgroup$
    – E. Chan-López
    Jan 18 at 9:00
  • 1
    $\begingroup$ Hopefully they will :-) $\endgroup$
    – bmf
    Jan 18 at 9:01
3
$\begingroup$

Another approach is to use explicit iterators in Condition:

Module[{n=1,k=1}, Replace[{1, 1, 2, 3, 2}, {1 :> Nothing/; n++ == 1, 2 :> Nothing/; k++ == 1},{1}]]

{1, 3, 2}
Improve this answer
$\endgroup$
3
$\begingroup$

Using Delete:

delElems[k_List, del_List] := 
 Delete[k, 
  Flatten[#, 1] &@(Position[k, First@#, 1, Last@#] & /@ Tally[del])
  ]

Usage:

delElems[{1, 1, 2, 3}, {1, 2}]

{1, 3}

delElems[{3, 1, 1, 2, 1}, {1, 2}]

{3, 1, 1}

delElems[{2, 3, 1, 1, 2, 5, 2, 2, 1}, {1, 2}]

{3, 1, 2, 5, 2, 2, 1}

Improve this answer
$\endgroup$
1
  • $\begingroup$ We were waiting for you. Kudos! $\endgroup$
    – bmf
    Jan 19 at 0:10
2
$\begingroup$

use a counter solve this

cnt = {1,2} // Tally // Map[Apply[Rule]] // Association;
data = {1, 1, 2, 3};
Table[
  Which[
    KeyExistsQ[i][cnt] && cnt[i] > 0, cnt[i]--;, (*remove it*)
    KeyExistsQ[i][cnt] && cnt[i] === 0, Sow[i];, (*if needless to remove*)
    !KeyExistsQ[i][cnt], Sow[i];(*others*)
   ] 
 ,{i, data}
]//Reap//Last//First
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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