Faster list duplicate 'limiter'

Question

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.

Answer 1

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]

Answer 2

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 = Internal`Bag[Most[{0}]];
   Do[
    val = list[[i]];
    If[
     ar[[val]] < lim
     ,
     Internal`StuffBag[res, val];
     Increment[ar[[val]]]
     ]
    ,
    {i, Length@list}
    ];
   Internal`BagPart[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.

Answer 3

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.

Answer 4

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

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

Answer 5

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

Answer 6

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