sorting

miguel 2018-04-23 17:57:09.922279 UTC

1-- comiple via: cabal exec -- ghc -threaded -O2 -rtsopts --make Sort
2-- run example: ./Sort +RTS -N8 -RTS 1000000 1
3-- run example: ./Sort +RTS -N8 -RTS 1000000 2
4-- run example: ./Sort +RTS -N8 -RTS 1000000 3
5
6module Main where
7
8import Control.Parallel (par, pseq)
9import System.Random (StdGen, getStdGen, randoms)
10import Data.Time.Clock (diffUTCTime, getCurrentTime)
11import System.Environment (getArgs)
12import Control.Monad
13
14randomInts :: Int -> StdGen -> [Int]
15randomInts k g = let result = take k (randoms g)
16 in force result `seq` result
17
18sort :: (Ord a) => [a] -> [a]
19sort (x:xs) = lesser ++ x:greater
20 where lesser = sort [y | y <- xs, y < x]
21 greater = sort [y | y <- xs, y >= x]
22sort _ = []
23
24parSort :: (Ord a) => [a] -> [a]
25parSort (x:xs) = force greater `par` (force lesser `pseq` (lesser ++ x:greater))
26 where lesser = parSort [y | y <- xs, y < x]
27 greater = parSort [y | y <- xs, y >= x]
28parSort _ = []
29
30parSort2 :: (Ord a) => Int -> [a] -> [a]
31parSort2 d list@(x:xs)
32 | d <= 0 = sort list
33 | otherwise = force greater `par` (force lesser `pseq`(lesser ++ x:greater))
34 where lesser = parSort2 d' [y | y <- xs, y < x]
35 greater = parSort2 d' [y | y <- xs, y >= x]
36 d' = d - 1
37parSort2 _ _ = []
38
39
40force :: [a] -> ()
41force xs = go xs `pseq` ()
42 where go (_:xs) = go xs
43 go [] = 1
44
45timeTest testFunction = do
46 args <- getArgs
47 let count | null args = 500000
48 | otherwise = read (head args)
49 input <- randomInts count `fmap` getStdGen
50 putStrLn $ "We have " ++ show (length input) ++ " elements to sort."
51 start <- getCurrentTime
52 let sorted = testFunction input
53 putStrLn $ "Sorted all " ++ show (length sorted) ++ " elements."
54 end <- getCurrentTime
55 putStrLn $ show (end `diffUTCTime` start) ++ " elapsed."
56
57main = do
58 sel <- (!!1) <$> getArgs
59 when (sel=="1") $ timeTest sort
60 when (sel=="2") $ timeTest parSort
61 when (sel=="3") $ timeTest $ parSort2 8