Ok, I did some search and found Data.Map, which can be used to implement pretty fast sorting:<br><br>import qualified Data.Map as Map<br><br>treeSort :: Ord a => [a] -> [a]<br>treeSort = map (\(x,_) -> x ) . Map.toAscList . Map.fromList . map (\x->(x,()))<br>
<br>In fact It is likely to behave like sort, with the exception that it is 23% faster. I did not hovever check the memory consumption. It works well on random, sorted and reverse-sorted inputs, and the speed difference is always about the same. I belive I could take Data.Map and get datatype isomorphic to specialized <i>Data.Map a ()</i> of it, so that treeSort will became Map.toAscList . Map.fromList. This may also bring some speedup.<br>
<br>What do you think about this particular function?<br><br><div class="gmail_quote">On Tue, Mar 4, 2008 at 1:45 AM, Krzysztof Skrzętnicki <<a href="mailto:gtener@gmail.com">gtener@gmail.com</a>> wrote:<br><blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">
Hi<br><br>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. <br>
<br>The overall winner seems to be qsort_iv - which is nothing less but old sort replaced by mergesort now.<br><br>Any clues?<br><br>Regards<br>Christopher Skrzętnicki<br><br>--- cut here ---<br>[Tener@laptener haskell]$ ghc -O2 --make qsort.hs && ./qsort +RTS -sstderr -RTS > /dev/null<br>
[1 of 1] Compiling Main ( qsort.hs, qsort.o )<br>Linking qsort ...<br>./qsort +RTS -sstderr <br>(1.0,"iv")<br>(1.1896770400256864,"v")<br>(1.3091609772011856,"treeSort")<br>(1.592515715933153,"vii")<br>
(1.5953543402198838,"vi")<br>(1.5961286512637272,"iii")<br>(1.8175480563244177,"i")<br>(1.8771604568641642,"ii")<br>(2.453160634439497,"mergeSort")<br>(2.6627090768870216,"sort")<br>
26,094,674,624 bytes allocated in the heap<br>12,716,656,224 bytes copied during GC (scavenged)<br>2,021,104,592 bytes copied during GC (not scavenged)<br>107,225,088 bytes maximum residency (140 sample(s))<br><br> 49773 collections in generation 0 ( 21.76s)<br>
140 collections in generation 1 ( 23.61s)<br><br> 305 Mb total memory in use<br><br> INIT time 0.00s ( 0.00s elapsed)<br> MUT time 20.39s ( 20.74s elapsed)<br> GC time 45.37s ( 46.22s elapsed)<br>
EXIT time 0.00s ( 0.00s elapsed)<br> Total time 65.76s ( 66.96s elapsed)<br><br> %GC time 69.0% (69.0% elapsed)<br><br> Alloc rate 1,279,723,644 bytes per MUT second<br><br> Productivity 31.0% of total user, 30.5% of total elapsed<br>
<br><br>--- cut here ---<br><br>{-# OPTIONS_GHC -O2 #-}<br>module Main where<br><br>import System.CPUTime<br>import System.IO<br>import System.Environment<br>import System.Random<br>import Data.List( partition, sort )<br>
<br>data Tree a =<br> Node (Tree a) a (Tree a)<br> | Leaf<br><br><br>qsort_i [] = []<br>qsort_i (x:xs) = qsort_i (filter (< x) xs) ++ [x] ++ qsort_i (filter (>= x) xs)<br><br>qsort_ii [] = []<br>qsort_ii (x:xs) = let (ls,gt) = partition (< x) xs in qsort_ii ls ++ [x] ++ qsort_ii gt<br>
<br>qsort_iii xs = qsort_iii' [] xs<br>qsort_iii' acc [] = acc<br>qsort_iii' acc (x:xs) = <br> let (ls,gt) = partition (< x) xs in<br> let acc' = (x:(qsort_iii' acc gt)) in qsort_iii' acc' ls<br>
<br>qsort_v [] = []<br>qsort_v (x:xs) = let (xlt, xgt ) = foldl (\ (lt,gt) el -> case compare x el of <br> GT -> (el:lt, gt)<br> _ -> (lt, el:gt) ) ([],[]) xs<br>
in qsort_v xlt ++ [x] ++ qsort_v xgt<br><br>-- zmodyfikowany i<br>qsort_vi [] = []<br>qsort_vi (x:xs) = qsort_vi (filter (\y-> compare x y == GT) xs) ++ [x] ++ qsort_vi (filter (\y-> compare x y /= GT) xs)<br>
<br><br>-- zmodyfikowany iii<br>qsort_vii xs = qsort_vii' [] xs<br>qsort_vii' acc [] = acc<br>qsort_vii' acc (x:xs) = <br> let (ls,gt) = partition (\y-> compare x y == GT) xs in <br> let acc' = (x:(qsort_vii' acc gt)) in qsort_vii' acc' ls<br>
<br><br><br>-- qsort is stable and does not concatenate.<br>qsort_iv xs = qsort_iv' (compare) xs []<br><br>qsort_iv' _ [] r = r<br>qsort_iv' _ [x] r = x:r<br>qsort_iv' cmp (x:xs) r = qpart cmp x xs [] [] r<br>
<br>-- qpart partitions and sorts the sublists<br>qpart cmp x [] rlt rge r =<br> -- rlt and rge are in reverse order and must be sorted with an<br> -- anti-stable sorting<br> rqsort_iv' cmp rlt (x:rqsort_iv' cmp rge r)<br>
qpart cmp x (y:ys) rlt rge r =<br> case cmp x y of<br> GT -> qpart cmp x ys (y:rlt) rge r<br> _ -> qpart cmp x ys rlt (y:rge) r<br><br>-- rqsort is as qsort but anti-stable, i.e. reverses equal elements<br>
rqsort_iv' _ [] r = r<br>rqsort_iv' _ [x] r = x:r<br>rqsort_iv' cmp (x:xs) r = rqpart cmp x xs [] [] r<br><br>rqpart cmp x [] rle rgt r =<br> qsort_iv' cmp rle (x:qsort_iv' cmp rgt r)<br>
rqpart cmp x (y:ys) rle rgt r =<br> case cmp y x of<br> GT -> rqpart cmp x ys rle (y:rgt) r<br> _ -> rqpart cmp x ys (y:rle) rgt r<br><br><br>-- code by Orcus<br><br>-- Zadanie 9 - merge sort<br>mergeSort :: Ord a => [a] -> [a]<br>
mergeSort [] = []<br>mergeSort [x] = [x]<br>mergeSort xs = let(l, r) = splitAt (length xs `quot` 2) xs<br> in mergeSortP (mergeSort l) (mergeSort r)<br><br>-- funkcja pomocnicza scalajÄ…ca dwie listy uporzÄ…dkowane w jednÄ…<br>
mergeSortP :: Ord a => [a] -> [a] -> [a]<br>mergeSortP xs [] = xs<br>mergeSortP [] ys = ys<br>mergeSortP (x:xs) (y:ys)<br> | x <= y = x:(mergeSortP xs (y:ys))<br> | otherwise = y:(mergeSortP (x:xs) ys)<br>
<br>-- Zadanie 10 - tree sort<br>treeSort :: Ord a => [a] -> [a]<br>-- pointless po raz drugi<br>treeSort = (treeSortInorder . treeSortToTree)<br> <br>treeSortToTree :: Ord a => [a] -> Tree a<br>treeSortToTree [] = Leaf<br>
treeSortToTree (x:xs) = let (xlt, xgt) = foldl (\ (lt,gt) el -> case compare x el of <br> GT -> (el:lt, gt)<br> _ -> (lt, el:gt) ) ([],[]) xs<br>
in Node (treeSortToTree xlt) x (treeSortToTree xgt)<br><br>treeSortInorder :: Ord a => Tree a -> [a]<br>treeSortInorder Leaf = []<br>treeSortInorder (Node l x r) = (treeSortInorder l) ++ [x] ++ (treeSortInorder r)<br>
<br>-- end code by Orcus<br><br><br><br>--<br>big_number = 1000000 :: Int<br><br><br>main = do<br> gen <- getStdGen<br> let xs' = randomRs (1::Int, big_number) gen <br> xs <- return (take big_number xs')<br>
t1 <- getCPUTime<br> print (qsort_i xs) -- i<br> t2 <- getCPUTime<br> print (qsort_ii xs) -- ii<br> t3 <- getCPUTime<br> print (qsort_iii xs) -- iii<br> t4 <- getCPUTime<br> print (qsort_iv xs) -- iv<br>
t5 <- getCPUTime<br> print (qsort_v xs) -- v<br> t6 <- getCPUTime<br> print (qsort_vi xs) -- vi<br> t7 <- getCPUTime<br> print (qsort_vii xs) -- vii<br> t8 <- getCPUTime<br> print (sort xs) -- sort<br>
t9 <- getCPUTime<br> print (mergeSort xs) -- mergeSort<br> t10 <- getCPUTime<br> print (treeSort xs) -- treeSort<br> t11 <- getCPUTime<br> let getTimes xs = zipWith (-) (tail xs) xs<br> let timers = [t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11]<br>
let times = getTimes timers<br> let table = zip times ["i","ii","iii","iv", "v", "vi", "vii", "sort","mergeSort","treeSort"]<br>
let sorted = sort table<br> let scaled = map (\(x,n) -> (((fromIntegral x / (fromIntegral $ fst (head sorted)))::Double),n)) sorted<br> let toShow = concatMap (\x-> show x ++ "\n") scaled<br> hPutStr stderr toShow<br>
<br>main_small = do<br> gen <- getStdGen<br> let xs' = randomRs (1::Int, 100000) gen <br> xs <- return (take big_number xs')<br> t1 <- getCPUTime<br> print (qsort_iv xs) -- iv<br> t2 <- getCPUTime<br>
print (sort xs) -- sort<br> t3 <- getCPUTime<br> print (mergeSort xs) -- mergeSort<br> t4 <- getCPUTime<br> print (treeSort xs) -- treeSort<br> t5 <- getCPUTime<br> let getTimes xs = zipWith (-) (tail xs) xs<br>
let timers = [t1,t2,t3,t4,t5]<br> let times = getTimes timers<br> let table = zip times ["iv", "sort","mergeSort","treeSort"]<br> let sorted = sort table<br> let scaled = map (\(x,n) -> (((fromIntegral x / (fromIntegral $ fst (head sorted)))::Double),n)) sorted<br>
let toShow = concatMap (\x-> show x ++ "\n") scaled<br> hPutStr stderr toShow<br> hPrint stderr times<br><br>--- cut here ---<br>
</blockquote></div><br>