Hi<br><br>I was playing with various versions of sorting algorithms. I know it&#39;s very easy to create flawed benchmark and I don&#39;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&#39;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 &amp;&amp; ./qsort +RTS -sstderr -RTS &gt; /dev/null<br>
[1 of 1] Compiling Main&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ( qsort.hs, qsort.o )<br>Linking qsort ...<br>./qsort +RTS -sstderr <br>(1.0,&quot;iv&quot;)<br>(1.1896770400256864,&quot;v&quot;)<br>(1.3091609772011856,&quot;treeSort&quot;)<br>(1.592515715933153,&quot;vii&quot;)<br>
(1.5953543402198838,&quot;vi&quot;)<br>(1.5961286512637272,&quot;iii&quot;)<br>(1.8175480563244177,&quot;i&quot;)<br>(1.8771604568641642,&quot;ii&quot;)<br>(2.453160634439497,&quot;mergeSort&quot;)<br>(2.6627090768870216,&quot;sort&quot;)<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>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 49773 collections in generation 0 ( 21.76s)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 140 collections in generation 1 ( 23.61s)<br><br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 305 Mb total memory in use<br><br>&nbsp; INIT&nbsp; time&nbsp;&nbsp;&nbsp; 0.00s&nbsp; (&nbsp; 0.00s elapsed)<br>&nbsp; MUT&nbsp;&nbsp; time&nbsp;&nbsp; 20.39s&nbsp; ( 20.74s elapsed)<br>&nbsp; GC&nbsp;&nbsp;&nbsp; time&nbsp;&nbsp; 45.37s&nbsp; ( 46.22s elapsed)<br>
&nbsp; EXIT&nbsp; time&nbsp;&nbsp;&nbsp; 0.00s&nbsp; (&nbsp; 0.00s elapsed)<br>&nbsp; Total time&nbsp;&nbsp; 65.76s&nbsp; ( 66.96s elapsed)<br><br>&nbsp; %GC time&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 69.0%&nbsp; (69.0% elapsed)<br><br>&nbsp; Alloc rate&nbsp;&nbsp;&nbsp; 1,279,723,644 bytes per MUT second<br><br>&nbsp; Productivity&nbsp; 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>&nbsp;&nbsp;&nbsp; Node (Tree a) a (Tree a)<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; | Leaf<br><br><br>qsort_i []&nbsp; = []<br>qsort_i (x:xs) = qsort_i (filter (&lt; x) xs) ++ [x] ++ qsort_i (filter (&gt;= x) xs)<br><br>qsort_ii [] = []<br>qsort_ii (x:xs) = let (ls,gt) = partition (&lt; x) xs in qsort_ii ls ++ [x] ++ qsort_ii gt<br>
<br>qsort_iii xs = qsort_iii&#39; [] xs<br>qsort_iii&#39; acc [] = acc<br>qsort_iii&#39; acc (x:xs) = <br>&nbsp;&nbsp;&nbsp; let (ls,gt) = partition (&lt; x) xs in<br>&nbsp;&nbsp;&nbsp; let acc&#39; = (x:(qsort_iii&#39; acc gt)) in qsort_iii&#39; acc&#39; ls<br>
<br>qsort_v [] = []<br>qsort_v (x:xs) = let (xlt, xgt ) = foldl (\ (lt,gt) el -&gt; case compare x el of <br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GT -&gt; (el:lt, gt)<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; _&nbsp; -&gt; (lt, el:gt) ) ([],[]) xs<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; in qsort_v xlt ++ [x] ++ qsort_v xgt<br><br>-- zmodyfikowany i<br>qsort_vi [] = []<br>qsort_vi (x:xs) = qsort_vi (filter (\y-&gt; compare x y == GT) xs) ++ [x] ++ qsort_vi (filter (\y-&gt; compare x y /= GT) xs)<br>
<br><br>-- zmodyfikowany iii<br>qsort_vii xs = qsort_vii&#39; [] xs<br>qsort_vii&#39; acc [] = acc<br>qsort_vii&#39; acc (x:xs) = <br>&nbsp;&nbsp;&nbsp; let (ls,gt) = partition (\y-&gt; compare x y == GT) xs in <br>&nbsp;&nbsp;&nbsp; let acc&#39; = (x:(qsort_vii&#39; acc gt)) in qsort_vii&#39; acc&#39; ls<br>
<br><br><br>-- qsort is stable and does not concatenate.<br>qsort_iv xs = qsort_iv&#39; (compare) xs []<br><br>qsort_iv&#39; _&nbsp;&nbsp; []&nbsp;&nbsp;&nbsp;&nbsp; r = r<br>qsort_iv&#39; _&nbsp;&nbsp; [x]&nbsp;&nbsp;&nbsp; r = x:r<br>qsort_iv&#39; 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>&nbsp;&nbsp;&nbsp; -- rlt and rge are in reverse order and must be sorted with an<br>&nbsp;&nbsp;&nbsp; -- anti-stable sorting<br>&nbsp;&nbsp;&nbsp; rqsort_iv&#39; cmp rlt (x:rqsort_iv&#39; cmp rge r)<br>
qpart cmp x (y:ys) rlt rge r =<br>&nbsp;&nbsp;&nbsp; case cmp x y of<br>&nbsp;&nbsp;&nbsp; GT -&gt; qpart cmp x ys (y:rlt) rge r<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; _&nbsp; -&gt; 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&#39; _&nbsp;&nbsp; []&nbsp;&nbsp;&nbsp;&nbsp; r = r<br>rqsort_iv&#39; _&nbsp;&nbsp; [x]&nbsp;&nbsp;&nbsp; r = x:r<br>rqsort_iv&#39; cmp (x:xs) r = rqpart cmp x xs [] [] r<br><br>rqpart cmp x [] rle rgt r =<br>&nbsp;&nbsp;&nbsp; qsort_iv&#39; cmp rle (x:qsort_iv&#39; cmp rgt r)<br>
rqpart cmp x (y:ys) rle rgt r =<br>&nbsp;&nbsp;&nbsp; case cmp y x of<br>&nbsp;&nbsp;&nbsp; GT -&gt; rqpart cmp x ys rle (y:rgt) r<br>&nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; _&nbsp; -&gt; rqpart cmp x ys (y:rle) rgt r<br><br><br>-- code by Orcus<br><br>-- Zadanie 9 - merge sort<br>mergeSort :: Ord a =&gt; [a] -&gt; [a]<br>
mergeSort []&nbsp;&nbsp;&nbsp; = []<br>mergeSort [x]&nbsp;&nbsp; = [x]<br>mergeSort xs&nbsp;&nbsp;&nbsp; = let(l, r) = splitAt (length xs `quot` 2) xs<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; in mergeSortP (mergeSort l) (mergeSort r)<br><br>-- funkcja pomocnicza scalajÄ…ca dwie listy uporzÄ…dkowane w jednÄ…<br>
mergeSortP :: Ord a =&gt; [a] -&gt; [a] -&gt; [a]<br>mergeSortP xs []&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; = xs<br>mergeSortP [] ys&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; = ys<br>mergeSortP (x:xs) (y:ys)<br>&nbsp;&nbsp;&nbsp; | x &lt;= y = x:(mergeSortP xs (y:ys))<br>&nbsp;&nbsp;&nbsp; | otherwise = y:(mergeSortP (x:xs) ys)<br>
<br>-- Zadanie 10 - tree sort<br>treeSort :: Ord a =&gt; [a] -&gt; [a]<br>-- pointless po raz drugi<br>treeSort = (treeSortInorder . treeSortToTree)<br>&nbsp;&nbsp;&nbsp; <br>treeSortToTree :: Ord a =&gt; [a] -&gt; Tree a<br>treeSortToTree []&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; = Leaf<br>
treeSortToTree (x:xs)&nbsp;&nbsp; = let (xlt, xgt) = foldl (\ (lt,gt) el -&gt; case compare x el of <br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GT -&gt; (el:lt, gt)<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; _&nbsp; -&gt; (lt, el:gt) ) ([],[]) xs<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; in Node (treeSortToTree xlt) x (treeSortToTree xgt)<br><br>treeSortInorder :: Ord a =&gt; Tree a -&gt; [a]<br>treeSortInorder Leaf&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; = []<br>treeSortInorder (Node l x r)&nbsp;&nbsp;&nbsp; = (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>&nbsp; gen &lt;- getStdGen<br>&nbsp; let xs&#39; = randomRs (1::Int, big_number) gen <br>&nbsp; xs &lt;- return (take big_number xs&#39;)<br>
&nbsp; t1 &lt;- getCPUTime<br>&nbsp; print (qsort_i xs) -- i<br>&nbsp; t2 &lt;- getCPUTime<br>&nbsp; print (qsort_ii xs) -- ii<br>&nbsp; t3 &lt;- getCPUTime<br>&nbsp; print (qsort_iii xs) -- iii<br>&nbsp; t4 &lt;- getCPUTime<br>&nbsp; print (qsort_iv xs) -- iv<br>
&nbsp; t5 &lt;- getCPUTime<br>&nbsp; print (qsort_v xs) -- v<br>&nbsp; t6 &lt;- getCPUTime<br>&nbsp; print (qsort_vi xs) -- vi<br>&nbsp; t7 &lt;- getCPUTime<br>&nbsp; print (qsort_vii xs) -- vii<br>&nbsp; t8 &lt;- getCPUTime<br>&nbsp; print (sort xs) -- sort<br>
&nbsp; t9 &lt;- getCPUTime<br>&nbsp; print (mergeSort xs) -- mergeSort<br>&nbsp; t10 &lt;- getCPUTime<br>&nbsp; print (treeSort xs) -- treeSort<br>&nbsp; t11 &lt;- getCPUTime<br>&nbsp; let getTimes xs = zipWith (-) (tail xs) xs<br>&nbsp; let timers = [t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11]<br>
&nbsp; let times = getTimes timers<br>&nbsp; let table = zip times [&quot;i&quot;,&quot;ii&quot;,&quot;iii&quot;,&quot;iv&quot;, &quot;v&quot;, &quot;vi&quot;, &quot;vii&quot;, &quot;sort&quot;,&quot;mergeSort&quot;,&quot;treeSort&quot;]<br>
&nbsp; let sorted = sort table<br>&nbsp; let scaled = map (\(x,n) -&gt; (((fromIntegral x / (fromIntegral $ fst (head sorted)))::Double),n)) sorted<br>&nbsp; let toShow = concatMap (\x-&gt; show x ++ &quot;\n&quot;) scaled<br>&nbsp; hPutStr stderr toShow<br>
<br>main_small = do<br>&nbsp; gen &lt;- getStdGen<br>&nbsp; let xs&#39; = randomRs (1::Int, 100000) gen <br>&nbsp; xs &lt;- return (take big_number xs&#39;)<br>&nbsp; t1 &lt;- getCPUTime<br>&nbsp; print (qsort_iv xs) -- iv<br>&nbsp; t2 &lt;- getCPUTime<br>
&nbsp; print (sort xs) -- sort<br>&nbsp; t3 &lt;- getCPUTime<br>&nbsp; print (mergeSort xs) -- mergeSort<br>&nbsp; t4 &lt;- getCPUTime<br>&nbsp; print (treeSort xs) -- treeSort<br>&nbsp; t5 &lt;- getCPUTime<br>&nbsp; let getTimes xs = zipWith (-) (tail xs) xs<br>
&nbsp; let timers = [t1,t2,t3,t4,t5]<br>&nbsp; let times = getTimes timers<br>&nbsp; let table = zip times [&quot;iv&quot;, &quot;sort&quot;,&quot;mergeSort&quot;,&quot;treeSort&quot;]<br>&nbsp; let sorted = sort table<br>&nbsp; let scaled = map (\(x,n) -&gt; (((fromIntegral x / (fromIntegral $ fst (head sorted)))::Double),n)) sorted<br>
&nbsp; let toShow = concatMap (\x-&gt; show x ++ &quot;\n&quot;) scaled<br>&nbsp; hPutStr stderr toShow<br>&nbsp; hPrint stderr times<br><br>--- cut here ---<br>