Haskell : Criterion benchmarking QuickSort

This is follow up post of setting up Criterion with stack.

Lets do some benchmarking as well.
We will benchmark the (in)famous quicksort.

import Criterion.Main as C
import Data.List as DL
import System.Random as R

qsortSimple :: (Ord a) => [a] -> [a]
qsortSimple [] = []
qsortSimple (x:xs) =
  qsortSimple [y | y <- xs, y < x] ++ [x] ++
  qsortSimple [y | y <- xs, y >= x]

I am using entr program to have file watch and run benchmarks again.
echo "bench/QuickSort.hs" | entr stack bench

Benchmarking code:

qsortBench :: ([Int] -> [Int]) -> [Int] -> [C.Benchmark]
qsortBench qsort nums = [ C.bench (show (length nums)) $ C.nf qsort nums ]

main :: IO ()
main = do
  r <- R.getStdGen
  let nums = (take 5000 $ R.randoms r) :: [Int]
  C.defaultMain [  C.bgroup "qsortSimple" $ qsortBench qsortSimple nums
                ]

we get :

benchmarking qsortSimple/5000
time                  3.620 ms   (3.605 ms .. 3.637 ms)
                          1.000 R²   (1.000 R² .. 1.000 R²)
mean                 3.630 ms   (3.618 ms .. 3.664 ms)
std dev              61.51 μs   (33.69 μs .. 120.7 μs)

I tried to optimize the way we generate lists containing smaller and greater numbers.

qsortFoldr :: (Ord a) => [a] -> [a]
qsortFoldr [] = []
qsortFoldr (x:xs) = (qsortFoldr smaller) ++ same ++ (qsortFoldr greater)
  where
    (smaller, same, greater) = foldr (\v (sm,sa,gr) ->
                                        if v < x
                                        then (v:sm, sa, gr)
                                        else if v == x
                                        then (sm, v:sa, gr)
                                        else (sm, sa, v:gr))
                               ([],[x],[])
                               xs

and change benchmarking code :

main :: IO ()
main = do
  r <- R.getStdGen
  let nums = (take 5000 $ R.randoms r) :: [Int]
  C.defaultMain [ C.bgroup "qsortFoldr" $ qsortBench qsortFoldr nums
                , C.bgroup "qsortSimple" $ qsortBench qsortSimple nums
                ]

benchmark gives :

benchmarking qsortFoldr/5000
time                 1.861 ms   (1.789 ms .. 1.935 ms)
                     0.990 R²   (0.986 R² .. 0.995 R²)
mean                 1.835 ms   (1.817 ms .. 1.870 ms)
std dev              79.30 μs   (50.06 μs .. 113.4 μs)
variance introduced by outliers: 30% (moderately inflated)

benchmarking qsortSimple/5000
time                 3.764 ms   (3.674 ms .. 3.948 ms)
                     0.980 R²   (0.956 R² .. 0.997 R²)
mean                 3.860 ms   (3.781 ms .. 3.992 ms)
std dev              310.8 μs   (172.4 μs .. 462.7 μs)
variance introduced by outliers: 52% (severely inflated)

And finally i tried strict version of foldl :

qsortFoldl :: (Ord a) => [a] -> [a]
qsortFoldl [] = []
qsortFoldl (x:xs) = qsortFoldl smaller ++ same ++ qsortFoldl greater
  where
    (smaller, same, greater) = foldl (\(sm,sa,gr) v ->
                                        if v < x
                                        then (v:sm, sa, gr)
                                        else if v == x
                                        then (sm, v:sa, gr)
                                        else (sm, sa, v:gr))
                               ([],[x],[])
                               xs

qsortFoldlS :: (Ord a) => [a] -> [a]
qsortFoldlS [] = []
qsortFoldlS (x:xs) = qsortFoldlS smaller ++ same ++ qsortFoldlS greater
  where
    (smaller, same, greater) = DL.foldl' (\(sm,sa,gr) v ->
                                        if v < x
                                        then (v:sm, sa, gr)
                                        else if v == x
                                        then (sm, v:sa, gr)
                                        else (sm, sa, v:gr))
                               ([],[x],[])
                               xs

and change benchmarking code to :

main :: IO ()
main = do
  r <- R.getStdGen
  let nums = (take 5000 $ R.randoms r) :: [Int]
  C.defaultMain [ C.bgroup "qsortFoldlS" $ qsortBench qsortFoldlS nums
                , C.bgroup "qsortFoldr" $ qsortBench qsortFoldr nums
                , C.bgroup "qsortFoldl" $ qsortBench qsortFoldl nums
                , C.bgroup "qsortSimple" $ qsortBench qsortSimple nums
                ]

  print $ show ((qsortSimple nums == qsortFoldr nums) &&
                (qsortFoldr nums == qsortFoldl nums) &&
                (qsortFoldl nums == qsortFoldlS nums))

Tip : Always make sure that different implementations of same function that you have written give you same output. QuickChecking is a good way to achieve that.

Final results :

Benchmark qsort: RUNNING...
benchmarking qsortFoldlS/5000
time                 1.465 ms   (1.453 ms .. 1.476 ms)
                     0.998 R²   (0.993 R² .. 1.000 R²)
mean                 1.503 ms   (1.483 ms .. 1.554 ms)
std dev              102.2 μs   (51.79 μs .. 186.3 μs)
variance introduced by outliers: 52% (severely inflated)

benchmarking qsortFoldr/5000
time                 1.861 ms   (1.789 ms .. 1.935 ms)
                     0.990 R²   (0.986 R² .. 0.995 R²)
mean                 1.835 ms   (1.817 ms .. 1.870 ms)
std dev              79.30 μs   (50.06 μs .. 113.4 μs)
variance introduced by outliers: 30% (moderately inflated)

benchmarking qsortFoldl/5000
time                 1.581 ms   (1.491 ms .. 1.729 ms)
                     0.957 R²   (0.921 R² .. 0.999 R²)
mean                 1.547 ms   (1.506 ms .. 1.645 ms)
std dev              193.0 μs   (40.10 μs .. 350.5 μs)
variance introduced by outliers: 80% (severely inflated)

benchmarking qsortSimple/5000
time                 3.764 ms   (3.674 ms .. 3.948 ms)
                     0.980 R²   (0.956 R² .. 0.997 R²)
mean                 3.860 ms   (3.781 ms .. 3.992 ms)
std dev              310.8 μs   (172.4 μs .. 462.7 μs)
variance introduced by outliers: 52% (severely inflated)

"True"
Benchmark qsort: FINISH


Notice : "True"