Ticket #2317: Sorting.hs

File Sorting.hs, 924 bytes (added by bos, 6 years ago)

Sorting.hs

Line 
1{-# LANGUAGE PatternSignatures #-}
2
3import Control.Monad
4import Control.Parallel
5import Data.Time.Clock (diffUTCTime, getCurrentTime)
6import System.Environment
7import System.Random
8
9sort (x:xs) = sort lesser ++ [x] ++ sort greater
10    where lesser = filter (<  x) xs
11          greater = filter (>= x) xs
12sort _ = []
13
14
15psort xs 10 = sort xs
16psort (x:xs) d = let d' = d + 1
17                     l = psort lesser d'
18                     g = psort greater d'
19              in l `par` g `par` (l ++ [x] ++ g)
20    where lesser = filter (<  x) xs
21          greater = filter (>= x) xs
22psort _ _ = []
23
24main = do
25  args <- getArgs
26  let counts | null args = [1000000]
27             | otherwise = map read args
28  rs :: [Int] <- randoms `fmap` getStdGen
29  forM_ counts $ \k -> do
30    let xs = take k rs
31    print . length $ xs
32    s <- getCurrentTime
33    print . length $ psort xs 0
34    e <- getCurrentTime
35    print (e `diffUTCTime` s)