BenchGroupBy.hs

-- ghc -O --make BenchGroupBy.hs && ./BenchGroupBy --output bench_group.html&& open bench_group.html
import Criterion.Main
import Control.Arrow ((&&&))
import qualified Data.List as L
import Data.Function

main = defaultMain [
  bgroup "group" [ bench "old"  $ nf oldGroupBy numbers
                 , bench "new"  $ nf newGroupBy numbers
                 ]
  ]

counts = [1..1000]

numbers = foldl1 (++) [counts, counts, counts]

newGroupBy :: [Int] -> [(String, [Int])]
newGroupBy = groupBy show

oldGroupBy :: [Int] -> [(String, [Int])]
oldGroupBy = groupBy' show

groupBy :: (Ord b) => (a -> b) -> [a] -> [(b, [a])]
groupBy f = map (f . head &&& id)
                   . L.groupBy ((==) `on` f)
                   . L.sortBy (compare `on` f)

groupBy' :: Eq b => (a -> b) -> [a] -> [(b, [a])]
groupBy' f l =
   fmap (\t -> (t, byTerm t)) uniqueTerms
  where
    byTerm t = filter ((== t) . f) l
    uniqueTerms = L.nub $ fmap f l

Results

Linking BenchGroupBy ...
benchmarking group/old
time                 109.3 ms   (107.8 ms .. 111.3 ms)
                     1.000 R²   (0.999 R² .. 1.000 R²)
mean                 110.7 ms   (109.9 ms .. 111.6 ms)
std dev              1.275 ms   (824.5 μs .. 1.815 ms)

benchmarking group/new
time                 1.434 ms   (1.414 ms .. 1.457 ms)
                     0.998 R²   (0.998 R² .. 0.999 R²)
mean                 1.426 ms   (1.415 ms .. 1.439 ms)
std dev              41.66 μs   (34.59 μs .. 58.50 μs)
variance introduced by outliers: 18% (moderately inflated)