-- |
-- Module : MergeSort
-- Copyright : (c) Philipps Universitaet Marburg 2009-2010
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : eden@mathematik.uni-marburg.de
-- Stability : beta
-- Portability : not portable
--
-- The following Haskell module implements parallel mergesort with Eden.
--
-- Depends on the Eden Compiler.
--
-- Eden Project
{- Case study: merge sort
-- Arguments: 1. skeleton to be used
-- (options: seq, mapRed, odisDC, trivPar)
-- 2. length of input list (random numbers)
-- 3. chunk size for result lists
Output is suppressed
-}
module Main where
import System.Environment
import Control.Seq
import Control.Parallel (pseq)
import Control.Parallel.Eden
import Control.Parallel.Eden.Auxiliary
import Control.Parallel.Eden.DivConq
import Control.Parallel.Eden.Map
{-
-- for generating list of random numbers
import System.Random
import Data.List
randomlist :: Int -> StdGen -> [Int]
randomlist n = take n . unfoldr (Just . random)
-}
list :: Int -> [Int]
list n = [n, n-1..1]
main :: IO ()
main = do ins <- getArgs
if length ins < 3 then print usage else
do let (v:a:d:_) = ins
-- seed <- newStdGen
-- let rs = randomlist ((read a)::Int) seed
let rs = list ((read a)::Int)
putStrLn (rnf (ms v rs ((read d)::Int)) `pseq` "Done")
-- putStrLn (show (ms v rs ((read d)::Int)))
usage :: String
usage = "Use 3 parameters: version (seq/odisDC/mapRed), list length, chunk size"
ms :: String -> [Int] -> Int -> [Int]
-- sequential mergeSort
ms "seq" xs _ = mergeSort xs
-- offline parallel map with chunked result lists, sequential merging
ms "mapRed" xs d
= head $ sms $ (map concat) $ parMap (\ i -> chunk d (mergeSort ((unshuffle (noPe-1) xs) !! i)))
[0..noPe-2]
-- using offline divide-and-conquer skeleton with chunking
ms "odisDC" xs d
= concat $ offline_disDC 2 [2..noPe] triv solve split combine xs
where
split = splitIntoN 2
triv xs = null xs || null (tail xs)
solve xs = chunk d $ xs
combine _ (b1:b2:_) = chunk d $ sortMerge (concat b1) (concat b2)
ms "trivPar" xs _ = mergeSort_par xs
-- default: use divide and conquer version
ms _ xs d = ms "odisDC" xs d
-- parallel mergeSort function using offline divide-and-conquer skeleton and
-- chunking of result lists
-- could be used instead of the direct call above
par_mergeSortDC :: (Ord a, Trans a) => Int -> [a] -> [a]
par_mergeSortDC size
= concat .
(offline_disDC 2 [2..noPe] trivial
((chunk size) . solve) split
(\ xs -> (chunk size) . (combine xs) . (map concat)))
where
trivial :: [a] -> Bool
trivial xs = null xs || null (tail xs)
solve :: [a] -> [a]
solve = id
split :: [a] -> [[a]]
split = splitIntoN 2
combine :: Ord b => [a] -> [[b]] -> [b]
combine _ (xs1:xs2:_) = sortMerge xs1 xs2
-- sequential mergeSort function
mergeSort :: (Ord a, Trans a) => [a] -> [a]
mergeSort [] = []
mergeSort [x] = [x]
mergeSort xs = sortMerge (mergeSort xs1)
(mergeSort xs2)
where [xs1,xs2] = unshuffle 2 xs
-- merging two sorted lists
sortMerge :: Ord a => [a] -> [a] -> [a]
sortMerge [] ylist = ylist
sortMerge xlist [] = xlist
sortMerge xlist@(x:xs) ylist@(y:ys)
| x <= y = x : sortMerge xs ylist
| x > y = y : sortMerge xlist ys
-- trivial parallel version, does not work well due to
-- too many processes, too many messages, no placement control
mergeSort_par :: (Ord a, Trans a) => [a] -> [a]
mergeSort_par [] = []
mergeSort_par [x] = [x]
mergeSort_par xs = sortMerge (process mergeSort_par # xs1)
(process mergeSort_par # xs2)
where [xs1,xs2] = splitIntoN 2 xs
-- merging a list of sorted lists into a singleton list with sorted result list
sms :: (NFData a, Ord a) => [[a]] -> [[a]]
sms [] = []
sms xss@[xs] = xss
sms (xs1:xs2:xss)
= rnf ys `pseq` rnf zss `pseq`
sms (ys : zss)
where ys = sortMerge xs1 xs2
zss = sms xss