Faster list duplicate 'limiter'

Given some list, e.g., {5, 3, 2, 3, 1, 0, 1, 3, 5, 5, 4, 5, 1, 2, 5, 2, 2, 0, 1, 4}, I need to limit the duplicates, if any, to an arbitrarily chosen number. The excess duplicates are to be chopped from the end of the list, order of list must be otherwise untouched. For example, with a limit of 2, the above example would become {5, 3, 2, 3, 1, 0, 1, 5, 4, 2, 0, 4}.

List can contain pretty much anything that would make sense. I'm using

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


which is fairly quick, wondering if there's a better can-opener for this.

• Your code would be hard to beat. – Leonid Shifrin Jan 20 '14 at 12:08
• I would urge you to post your code as an answer. Normally I wouldn't, because OP's attempts are often subpar and there's lot of room to work on improving them. In this case, your code is pretty fast and uses all the "right" functions (at least, for a pure Mathematica implementation). I would much rather vote for your code and answer, rather than a clone of it that just compiled it or changed a few characters. – rm -rf Jan 20 '14 at 15:28
• Using Ordering here takes at least half of the time. If we really want something that is substantially faster, we will have to make do without Ordering. Note that Ordering is O(n log n), whereas there should be an O(n) algorithm. "Just compiling" something here then also has limited effect, though I guess it would be a nice exercise, especially to avoid the Join@@. – Jacob Akkerboom Jan 20 '14 at 21:45
• @LeonidShifrin: Well, that's nice to hear from you, but I'm always expecting some out-of-the-box-thinking answer that changes the game... – ciao Jan 21 '14 at 0:09
• @rm-rf: Thanks for the comment, I may end up doing so (though it always feels 'wrong' to me to approve my own answer). I'm checking replies below and testing another method of mine, so I'll wait a bit more. – ciao Jan 21 '14 at 0:11

Thanks for the responses. It appears my original effort is appropriate for a pure MM implementation: some of the suggestions mirrored another method I tried that sometimes was slightly faster but at the expense of much heavier memory use, and often much slower.

For reference, code reposted:

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


If the range of the integers in the list is limited, the following is quite a bit faster. It uses much more memory if kk is considerably larger than Length@list.

cfu =
Compile[{{list, _Integer, 1}, {lim, _Integer}, {kk, _Integer}},

Block[
{ar, res, val}
,
ar = ConstantArray[0, kk];
res = InternalBag[Most[{0}]];
Do[
val = list[[i]];
If[
ar[[val]] < lim
,
InternalStuffBag[res, val];
Increment[ar[[val]]]
]
,
{i, Length@list}
];
InternalBagPart[res, All]
]
,
CompilationTarget -> "C"
]


Generating input

Warning, do not choose kk too high. If you choose kk = 1*^9 for example, you will probably crash your kernel. Even though such a value of kk would lead to sensible input, the compiled function has no safeguard against this.

kk = 2*^6;
nn = 1*^6;
rands = RandomInteger[{1, kk}, nn]; ;


Timing comparison

(myRes = cfu[rands, 2, kk]) // Timing // First


0.067658

(resOP = Module[{o = Ordering@#},
o[[o]] = Join @@ Range /@ Tally[#[[o]]][[All, 2]];
Pick[#, UnitStep[#2 - o], 1]] &[rands, 2]) // Timing // First


1.091691

myRes === resOP


True

Notes

Maybe we can use a hashtable if the only restriction on the input is that they are machine integers/elements of an integer packed array/64 bit integers in my case.

• Just so you know I'm not "against" Compile, this is almost exactly what I came up with yesterday (array indexed increments + bags), but didn't post it because I was still trying to find a way to avoid picking a kk and do it all in 1 scan of the list (and then fell asleep while thinking about it). Perhaps I should've posted it :) – rm -rf Jan 21 '14 at 16:18
• @rm-rf thank you for clarifying :). I envy you for being able to fall asleep thinking about MMA :P. Feel free to edit my answer with any ideas you have cooked up while awake or otherwise :) – Jacob Akkerboom Jan 21 '14 at 17:33
• Neat, but already have a solution based on code L.S. posted that is similar speed, but as said in OP, list can contain pretty much anything. As an aside, for some reason using the @ in comment has stopped working for me - any ideas? – ciao Jan 22 '14 at 0:04
• @rasher ah yeah maybe they changed the rules about using @. It seems you can now only @ people who were already active in the comments (not sure). Anyway perhaps I should work out the idea with hashtables. But if the list can really be a mixture of strings integers symbols and what have you it becomes really uninteresting to compile. – Jacob Akkerboom Jan 22 '14 at 8:56

A second go, this time a derivative of the rasher's original.

    f[list : {__Integer}, limit_Integer] :=
Transpose[
SortBy[
Apply[Join, Map[If[Length[#] > limit, #[[1 ;; limit]], #] &,
GatherBy[Transpose[{Range[Length[list]], list}],
Last]]],
First]][[2]];


On this instance with a limit of 2...

list = RandomInteger[{0, 100}, {10000000}];


My timings give 1.61 seconds for the original and 0.936 seconds for this.

• I had tried a similar method (I'll update OP later with it), and found it sometimes was slightly better, but often fell apart, e.g., with 100K length of 100K possible distinct elements, my similar method is 4-5X slower. In addition, the gather/sort become memory hogs with large lists, as in 10X memory needs of my current method. I might just write a C stub to do this for really huge lists, but I'd prefer to stay in pure MM. Thanks for the comments & updates. – ciao Jan 21 '14 at 0:15

Similar to Ymareth, but coming out slightly faster for me:

f[x_, lim_] := x[[Sort @ Flatten[
#[[;; Min[lim, Length[#]]]] & /@
GatherBy[Range @ Length @ x, x[[#]] &]]]]


Using a small internal dictionary to keep track of the duplicate count.

f[list : {__Integer}, limit_Integer] :=
Module[{d},
Reap[Scan[(If[!NumberQ[d[#]], d[#] = 1];
If[d[#] <= limit, (d[#] = d[#] + 1; Sow[#])]) &, list]][[2, 1]]]

• But unfortunately it is not faster. – Kuba Jan 20 '14 at 11:26
• @Kuba: Seems to give incorrect results. Is there a typo? e.g., with {1, 1, 4, 5, 1, 2, 2, 1, 2, 3, 4, 4, 3, 6, 5} limited to 2, it should be {1, 1, 4, 5, 2, 2, 3, 4, 3, 6, 5} but I'm getting {1, 1, 2, 2, 4, 4, 3, 5} from your code. – ciao Jan 20 '14 at 11:46
• @rasher Indeed, except that is not my code :P – Kuba Jan 20 '14 at 11:48
• Not so much a typo as not checking my code! Apologies. Re: speed, I think that would depend on distribution of input, number of unique values vs number of duplicates. – Ymareth Jan 20 '14 at 12:07
• But no, it looks like the OP wins :( – Ymareth Jan 20 '14 at 12:10

Darn close to the original time-wise. I kind of prefer this for readability..

 Function[{list},
list[[Sort@
Flatten[Position[list, #, 1, dupeLengthLimitHere] & /@
DeleteDuplicates@list ]]]]@yourListHere

• Try it with sparse duplicates, e.g., with RandomInteger[50000,100000]` it is orders of magnitude slower. – ciao Jan 22 '14 at 0:01