-- |
-- 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