1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
module Sort.Sort (qsort,msort,msortBy) where
import Control.Parallel
import Criterion.Main
import System.Random
import Control.DeepSeq
main = defaultMain
[bench "qsort" (nf qsort randomInts),
bench "pqsort" (nf pqsort randomInts)]
qsort (x:xs) = [a | a<-xs, a<=x] ++(x:[a | a<-xs, a>x])
pqsort (x:xs) = par (rnf larg) ([a|a<-xs, a<=x]++(x:larg))
where larg = [a|a<-xs,a>x]
randomInts = take 200000 (randoms (mkStdGen 211570155)) :: [Integer]
msort xs = msortBy compare xs
msortBy cmp xs = mergeAll $ warp xs
where
warp (a:b:xs)
| a `cmp` b /= GT = let (dec,rst) = decwarp xs [b,a] in dec:warp rst
| otherwise = let (inc,rst) = incwarp xs [b,a] in (reverse inc):warp rst
warp t = [t]
decwarp xx@(x:xs) aa@(a:as)
| a `cmp` x /= LT = decwarp xs (x:aa)
| otherwise = (aa,xx)
decwarp [] aa = (aa,[])
incwarp xx@(x:xs) aa@(a:as)
| a `cmp` x /= GT = incwarp xs (x:aa)
| otherwise = (aa,xx)
incwarp [] aa = (aa,[])
merge (a:b:xs) = (mergePair a b []):(merge xs)
merge xs = xs
mergeAll [x] = x
mergeAll xs = mergeAll $ merge xs
mergePair [] bs os = (reverse os) ++ bs
mergePair as [] os = (reverse os) ++ as
mergePair aa@(a:as) bb@(b:bs) os
| b `cmp` a == GT = mergePair as bb (a:os)
| otherwise = mergePair aa bs (b:os)
|
