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

rpartition :: (a -> Bool) -> [a] -> ([a], [a])
rpartition p []     = ([], [])
rpartition p (x:xs) | p x       = (x:ts, fs)
                    | otherwise = (ts, x:fs)
                    where (ts, fs) = rpartition p 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:  40.14s
-- compose CPU time:  39.54s
-- accum   CPU time:  33.16s
-- accum   CPU time:  34.40s
-- compose CPU time:  39.88s
-- append  CPU time:  40.19s
-- append  CPU time:  39.46s
-- compose CPU time:  39.18s
-- accum   CPU time:  33.33s