A bug in Commonest in version 10

Question

Bug introduced in 10.0.0 and fixed in 10.0.2

---

m_goldberg demonstrated that in Mathematica 10 Commonest does not behave as the documentation indicates that it will. Concisely:

Commonest[{1, 2, 3, 1, 2, 3}, 1]  (* should return {1} *)

{3}

The function did behave as it was supposed to in earlier versions.

Answer 1

Diagnosis

Spelunking the definition of Commonest, which is written in top-level Mathematica code, I see that the two parameter form is handled by this internal function:

Commonest; (* preload *)
? Statistics`DescriptiveDump`oCommonestSetLength

oCommonestSetLength[list_, n_] :=
 Catch[Block[{res, reslen, ord}, res = Tally[list];
   reslen = Length[res];
   If[reslen < n, Message[Commonest::dstlms, n, reslen];
    Throw[res[[All, 1]]]];
   If[reslen == n, Throw[res[[All, 1]]]];
   ord = Ordering[res[[All, 2]], -n, Less];
   res[[Sort[ord], 1]]]]

(Contexts stripped from definition Symbols for clarity.)

Bug fix

The problem lies with the use of Ordering. Consider:

 Ordering[{1, 5, 3, 4, 5}, -1, Less]

{5}

This returns the position of the second appearance of the largest value, 5, rather than the position of its first appearance as Commonest requires.

A one-line fix to handle the case of $n = 1$, suitable for inclusion in kernel/init.m:

Statistics`DescriptiveDump`oCommonestSetLength[list_, 1] := Commonest[list][[{1}]]

Optimization

I suppose the use of Ordering was a flawed attempt to optimize the earlier version's code which is correct but cumbersome:

res = Transpose[{res, Range[reslen]}];
res = Sort[res, #2[[1, 2]] <= #1[[1, 2]] &];
Sort[Take[res, n], #1[[2]] <= #2[[2]] &][[All, 1, 1]]]

This is quite slow due to the algorithm used by Sort when it is given a custom ordering function. Ordering improves upon this but it broke the function for $n = 1$ in doing so. Further the use of the custom ordering function (i.e. Less) also slows Ordering, though to a lesser degree.

Fortunately there is now a better tool for us to use: MaximalBy.

commonest[list_, n_] :=
  Tally[list]\[Transpose] /. {a_, t_} :> 
    a[[ Sort @ MaximalBy[Range @ Length @ t, t[[#]] &, n] ]]

This is much faster than the System function:

Needs["GeneralUtilities`"]
x = RandomInteger[1*^6, 1*^7];

Commonest[x, 99] // AccurateTiming
commonest[x, 99] // AccurateTiming

Commonest[x, 99] === commonest[x, 99]

3.688711
0.203512

True

Sometimes the difference is less but I have not found a case where my function is not faster.
Therefore I recommend, in addition to the bug fix above, placing this code in your kernel/init.m file:

Commonest (* preload -- do not remove! *);

Statistics`DescriptiveDump`oCommonestSetLength[list_, n_] :=
  With[{res = Tally @ list},
    With[{len = Length @ res},
      If[len <  n, Message[Commonest::dstlms, n, len]];
      If[len <= n, res[[All, 1]],
        res\[Transpose] /. {a_, t_} :>
          a[[ Sort @ MaximalBy[Range @ Length @ t, t[[#]] &, Min[len, n]] ]]
      ]
    ]
  ]

Answer 2

bug fixed in 10.0.2. WIndows 7, 64 bit

 Commonest[{1, 2, 3, 1, 2, 3}, 1]  (*should return {1}*)