# DeleteCases for once only

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?

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

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]

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}]


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}]

• Nice. Or DeleteElements[{1, 1, 2, 3}, 1 -> {1, 2}]. Jan 17, 2023 at 15:58
• @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 :-)
– bmf
Jan 17, 2023 at 15:59
• Nice post, Indeed! :-) Jan 18, 2023 at 7:29
• @E.Chan-López thanks :-)
– bmf
Jan 18, 2023 at 8:03
• Hi mate @bmf, the ten ways to do this are ready :-) Jan 20, 2023 at 6:41

You can use the ResourceFunction MultisetComplement to do this:

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


{1, 3}

• This will sort the target, however...
– ciao
Dec 20, 2019 at 18:49

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.

• 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). Dec 23, 2019 at 6:11
• @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...) Dec 23, 2019 at 6:52
• 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. Dec 23, 2019 at 7:14
• It is also worth to mention that for expression patterns the default is Shortest instead of Longest. This is crucially important for your solution. Dec 23, 2019 at 7:19

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.

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.

• Almost the 10 ways :-)
– bmf
Jan 18, 2023 at 8:51
• Nasser, Syed and Lericr soon join the party :-) Jan 18, 2023 at 9:00
• Hopefully they will :-)
– bmf
Jan 18, 2023 at 9:01

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}


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}

• We were waiting for you. Kudos!
– bmf
Jan 19, 2023 at 0:10

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