# Deleting duplicates after n-occurrences

As a generalization of DeleteDuplicates, I want to delete duplicates from a list, but only after n number of duplicates.

Say, n = 3 means that three duplicates are allowed.

DeleteDuplicatesN[x_, n_] :=
x[[
Sort[
Flatten[#[[1 ;; Min[Length[#], n]]]& /@
(Flatten[Position[x, #]]& /@ DeleteDuplicates[x])]]]]

DeleteDuplicatesN[{1, 2, 3, 2, 1, 1, 1, 2, 3, 5, 5, 5, 5, 1, 7, 4, 7, 1}, 3]

{1, 2, 3, 2, 1, 1, 2, 3, 5, 5, 5, 7, 4, 7}


Is there a better method — faster or more elegant?

For example, using only DeleteDuplicates or DeleteDuplicatesBy?

I think you'll find this faster:

dd[list_, n_] :=
Module[{pi = Flatten[Values[PositionIndex[list][[All, ;; UpTo@n]]]]},
list[[Sort@pi]]];


Using RandomInteger[20000, 20000] as a test list and allowing 3 duplicates, your code took ~37 seconds, this needed ~0.03 seconds.

Comparable in speed, simpler:

dd2[list_, n_] :=
list[[Union @@
GatherBy[Range@Length@list, list[[#]] &][[All, ;; UpTo@n]]]];


For large lists that aren't grossly duplicated elements, this offers a performance edge (e.g., with RandomInteger[10000000,20000000] test list, over 6X speed of above methods):

dd=Module[{o = Ordering@#},
o[[o]] = Join @@ Range[Tally[#[[o]]][[All, 2]]];
Pick[#, UnitStep[#2 - o], 1]]&;

• Nice. If nobody comes with a better code in a day or so I will accept your answer. Aug 19, 2020 at 22:47
• We can use Sort[pi] instead of pi[[Ordering[pi]]]. If I am not mistaken it is the same speed but more transparent code. Aug 19, 2020 at 23:08
• @azerbajdzan - yes, that function was snipped from some code that used the ordering later. I've made the readability change.
– ciao
Aug 19, 2020 at 23:16
• Maybe this is a good one for the Function Repository? Aug 20, 2020 at 8:13
• @azerbajdzan - ? It is written as a pure function - the slot are the arguments. It is called the same way as the other examples.
– ciao
Aug 20, 2020 at 19:15