MergeSort.hs

module MergeSort (mergeSort) where
-- | Bottom-up merge sort.
mergeSort :: Ord a => [a] -> [a]
mergeSort = mergeAll . map (:[])
  where
    mergeAll []   = []
    mergeAll [xs] = xs
    mergeAll xss  = mergeAll (mergePairs xss)

    mergePairs (a:b:xs) =
      merge a b : mergePairs xs
    mergePairs xs = xs

    merge as@(a:as') bs@(b:bs')
      | a > b     = b : merge as bs'
      | otherwise = a : merge as' bs
    merge [] bs = bs
    merge as [] = as

QuickSort.hs

{-# LANGUAGE BangPatterns #-}
import Data.Vector (Vector)
import Data.Vector.Mutable (MVector)
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import Control.Monad (foldM, forM)
import Data.List (sort)
import System.IO (Handle, hGetContents, stdin)
import Control.Monad.ST (runST)
import Control.Monad.Primitive (PrimMonad, PrimState)

qs :: (Show a, Ord a, PrimMonad m)
      => (MVector (PrimState m) a -> m Int)
      -> MVector (PrimState m) a
      -> m Int
qs choosePivot = go
  where
    go v = case VM.length v - 1 of
      n1 | n1 <= 0 -> return 0
      !n1          -> do
        !p <- choosePivot v
        !pv <- VM.read v p
        VM.swap v 0 p
        let f i j = do
              !jv <- VM.read v j
              if jv < pv
                then VM.swap v i j >> return (i + 1)
                else return i
        !i <- foldM f 1 [1..n1]
        let pivotIndex = i - 1
            leftSlice  = VM.slice 0 pivotIndex v
            rightSlice = VM.slice i (n1 - pivotIndex) v
        VM.swap v 0 pivotIndex
        !left  <- go leftSlice
        !right <- go rightSlice
        return $ n1 + left + right

firstPivot :: (PrimMonad m) => MVector (PrimState m) a -> m Int
firstPivot _ = return 0

lastPivot :: (PrimMonad m) => MVector (PrimState m) a -> m Int
lastPivot v = return $ VM.length v - 1

midPivot :: (PrimMonad m) => MVector (PrimState m) a -> m Int
midPivot v = return $ VM.length v `div` 2

medianOfThreePivot :: (PrimMonad m, Ord a) => MVector (PrimState m) a -> m Int
medianOfThreePivot v = do
  let len = VM.length v
      vread = VM.read v
      pos = [0, len `div` 2 - if even len then 1 else 0, len - 1]
  (_:(_, pivot):_) <- mapM vread pos >>= return . sort . flip zip pos
  return pivot

readInts :: Handle -> IO (Vector Int)
readInts h = hGetContents h >>= return . V.fromList . map read . lines

main :: IO ()
main = readInts stdin >>= mapM_ print . run

run :: Vector Int -> [Int]
run ints = runST $ do
  forM [firstPivot, lastPivot, medianOfThreePivot] $ (V.thaw ints >>=) . qs