gistfile1.hs

import System.TimeIt
import System.Random
import Control.Parallel.Strategies (NFData(..))
import Control.Exception (evaluate)

rpartition :: (a -> Bool) -> [a] -> ([a], [a])
rpartition p = go [] []
 where
    go ts fs [] = (ts, fs)
    go ts fs (x:xs) | p x       = go (x:ts) fs xs
                    | otherwise = go ts (x:fs) xs

qsortapp xs = go xs
 where
    go [] = []
    go (x:xs) = case rpartition (< x) xs of
                    (ls, rs) -> go ls ++ x : go rs

qsortfn xs = go xs []
 where
    go []     = id
    go (x:xs) = case rpartition (< x) xs of
                    (ls, rs) -> go ls . (x:) . go rs

qsortacc xs = go xs []
 where
    go [] ys     = ys
    go (x:xs) ys = case rpartition (< x) xs of
                    (ls, rs) -> go ls (x : go rs ys)

rands :: [Int]
rands = take n . randomRs bs $ g
 where
    g = mkStdGen 42
    n = 7000000
    bs = (0, 7000000)
{-# NOINLINE rands #-}

sorts :: [(String, [Int] -> [Int])]
sorts = [ ("append ", qsortapp)
        , ("compose", qsortfn)
        , ("accum  ", qsortacc)
        ]

test (s, qsort) = do
    putStr (s ++ " ")
    timeIt . evaluate . last . qsort $ rands

main = do
    evaluate (rnf rands)
    mapM_ test sorts
    mapM_ test (reverse sorts)
    mapM_ test sorts


-- append  CPU time:  31.09s
-- compose CPU time:  27.45s
-- accum   CPU time:  23.51s
-- accum   CPU time:  23.90s
-- compose CPU time:  27.96s
-- append  CPU time:  29.97s
-- append  CPU time:  29.71s
-- compose CPU time:  28.10s
-- accum   CPU time:  23.55s