[Haskell-cafe] (flawed?) benchmark : sort
Chaddaï Fouché
chaddai.fouche at gmail.com
Tue Mar 4 12:47:27 EST 2008
2008/3/4, Krzysztof Skrzętnicki <gtener at gmail.com>:
> Hi
>
> I was playing with various versions of sorting algorithms. I know it's very
> easy to create flawed benchmark and I don't claim those are good ones.
> However, it really seems strange to me, that sort - library function - is
> actually the worse measured function. I can hardly belive it, and I'd rather
> say I have made a mistake preparing it.
>
> The overall winner seems to be qsort_iv - which is nothing less but old sort
> replaced by mergesort now.
>
> Any clues?
Part of what you may be missing :
-- cut here --
module Main where
import Control.Parallel.Strategies
import Control.Arrow
import System.CPUTime
import System.IO
import System.Environment
import System.Random
import Data.List( partition, sort )
data Tree a =
Node (Tree a) a (Tree a)
| Leaf
qsort_i [] = []
qsort_i (x:xs) = qsort_i (filter (< x) xs) ++ [x] ++ qsort_i (filter (>= x) xs)
qsort_ii [] = []
qsort_ii (x:xs) = let (ls,gt) = partition (< x) xs in qsort_ii ls ++
[x] ++ qsort_ii gt
qsort_iii xs = qsort_iii' [] xs
qsort_iii' acc [] = acc
qsort_iii' acc (x:xs) =
let (ls,gt) = partition (< x) xs in
let acc' = (x:(qsort_iii' acc gt)) in qsort_iii' acc' ls
qsort_v [] = []
qsort_v (x:xs) = let (xlt, xgt ) = foldl (\ (lt,gt) el -> case compare x el of
GT -> (el:lt, gt)
_ -> (lt,
el:gt) ) ([],[]) xs
in qsort_v xlt ++ [x] ++ qsort_v xgt
-- zmodyfikowany i
qsort_vi [] = []
qsort_vi (x:xs) = qsort_vi (filter (\y-> compare x y == GT) xs) ++ [x]
++ qsort_vi (filter (\y-> compare x y /= GT) xs)
-- zmodyfikowany iii
qsort_vii xs = qsort_vii' [] xs
qsort_vii' acc [] = acc
qsort_vii' acc (x:xs) =
let (ls,gt) = partition (\y-> compare x y == GT) xs in
let acc' = (x:(qsort_vii' acc gt)) in qsort_vii' acc' ls
-- qsort is stable and does not concatenate.
qsort_iv xs = qsort_iv' (compare) xs []
qsort_iv' _ [] r = r
qsort_iv' _ [x] r = x:r
qsort_iv' cmp (x:xs) r = qpart cmp x xs [] [] r
-- qpart partitions and sorts the sublists
qpart cmp x [] rlt rge r =
-- rlt and rge are in reverse order and must be sorted with an
-- anti-stable sorting
rqsort_iv' cmp rlt (x:rqsort_iv' cmp rge r)
qpart cmp x (y:ys) rlt rge r =
case cmp x y of
GT -> qpart cmp x ys (y:rlt) rge r
_ -> qpart cmp x ys rlt (y:rge) r
-- rqsort is as qsort but anti-stable, i.e. reverses equal elements
rqsort_iv' _ [] r = r
rqsort_iv' _ [x] r = x:r
rqsort_iv' cmp (x:xs) r = rqpart cmp x xs [] [] r
rqpart cmp x [] rle rgt r =
qsort_iv' cmp rle (x:qsort_iv' cmp rgt r)
rqpart cmp x (y:ys) rle rgt r =
case cmp y x of
GT -> rqpart cmp x ys rle (y:rgt) r
_ -> rqpart cmp x ys (y:rle) rgt r
-- code by Orcus
-- Zadanie 9 - merge sort
mergeSort :: Ord a => [a] -> [a]
mergeSort [] = []
mergeSort [x] = [x]
mergeSort xs = let(l, r) = splitAt (length xs `quot` 2) xs
in mergeSortP (mergeSort l) (mergeSort r)
-- funkcja pomocnicza scalajÄ…ca dwie listy uporzÄ…dkowane w jednÄ…
mergeSortP :: Ord a => [a] -> [a] -> [a]
mergeSortP xs [] = xs
mergeSortP [] ys = ys
mergeSortP (x:xs) (y:ys)
| x <= y = x:(mergeSortP xs (y:ys))
| otherwise = y:(mergeSortP (x:xs) ys)
-- Zadanie 10 - tree sort
treeSort :: Ord a => [a] -> [a]
-- pointless po raz drugi
treeSort = (treeSortInorder . treeSortToTree)
treeSortToTree :: Ord a => [a] -> Tree a
treeSortToTree [] = Leaf
treeSortToTree (x:xs) = let (xlt, xgt) = foldl (\ (lt,gt) el -> case
compare x el of
GT -> (el:lt, gt)
_ -> (lt,
el:gt) ) ([],[]) xs
in Node (treeSortToTree xlt) x (treeSortToTree xgt)
treeSortInorder :: Ord a => Tree a -> [a]
treeSortInorder Leaf = []
treeSortInorder (Node l x r) = (treeSortInorder l) ++ [x] ++
(treeSortInorder r)
-- end code by Orcus
-- begin benchmark making code
makeBenchs benchs xs = do
let (funcNames, funcs) = unzip benchs
tBegin <- getCPUTime
timers <- mapM (\f-> print (f xs) >> getCPUTime) funcs
let times = zipWith (-) timers (tBegin:timers)
sortedResults = sort $ zip times funcNames
minT = fromIntegral $ fst $ head sortedResults
scaled = map (((/minT) . fromIntegral) *** id) sortedResults
hPutStr stderr $ unlines $ map show scaled
onRandom eltCnt = do
gen <- getStdGen
let xs = take eltCnt (randomRs (1::Int, bigNum) gen) `using` rnf
xs `seq` return xs
onSorted eltCnt = do
gen <- getStdGen
let xs = take eltCnt (randomRs (1::Int, bigNum) gen) `using` rnf
sxs = sort xs `using` rnf
xs `seq` sxs `seq` return sxs
bigNum = 1000000 :: Int
-- end of benchmark making code
main = makeBenchs [("i",qsort_i),
("ii",qsort_ii),
("iii",qsort_iii),
("iv",qsort_iv),
("v",qsort_v),
("vi",qsort_vi),
("vii",qsort_vii),
("sort",sort),
("mergeSort",mergeSort),
("treeSort",treeSort)]
=<< onSorted . read . head =<< getArgs
-- cut here --
It could probably be improved (with classics solution (better
selection of the pivot...)), but the mergesort is only 3 times slower
in worse case, and much more regular, if someone needs a faster sort
in a specific case, it isn't hard to code.
--
Jedaï
More information about the Haskell-Cafe
mailing list