VecSort.hs

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.DeepSeq
import Data.Time
import Control.Exception(evaluate)
import System.IO
import Control.Applicative
import Text.Printf
import Prelude hiding(log)
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV

log :: String -> IO UTCTime
log xs = do
    t <- getCurrentTime
    hPrintf stderr "[%s] %s\n" (show t) xs
    return t

mergeSort :: Ord a => [a] -> [a]
mergeSort l = V.toList $ mergeSortAux (V.fromList l)

mergeSortAux :: Ord a => V.Vector a -> V.Vector a
mergeSortAux l | V.length l <= 1 = l
mergeSortAux l = merge (mergeSortAux l1) (mergeSortAux l2)
    where
    m = div (V.length l) 2
    (l1,l2) = V.splitAt m l

merge :: Ord a => V.Vector a -> V.Vector a -> V.Vector a
merge as bs = V.create $ do
    let n1 = V.length as
        n2 = V.length bs
    res <- MV.new (n1+n2)
    let go i1 i2 | i1 >= n1 && i2 >= n2 = return res
                 | i1 >= n1 = tick2 i1 i2
                 | i2 >= n2 = tick1 i1 i2
                 | V.unsafeIndex as i1 <= V.unsafeIndex bs i2 = tick1 i1 i2
                 | otherwise = tick2 i1 i2
        tick1 i1 i2 = do
            v <- V.unsafeIndexM as i1
            MV.unsafeWrite res (i1 + i2) v
            go (i1+1) i2
        tick2 i1 i2 = do
            v <- V.unsafeIndexM bs i2
            MV.unsafeWrite res (i1 + i2) v
            go i1 (i2+1)
    go 0 0

main :: IO ()
main = do 
    t0 <- log "begin"
    xs <- map (fst . fromJust . B.readInt) . B.words <$> B.getContents
    evaluate (rnf xs)
    t1 <- log "parse done"
    let ls = mergeSort xs
    evaluate (rnf ls)
    t2 <- log "sort done"
    let dt = diffUTCTime t2 t1
    _ <- log $ printf "Sorting: %s" (show dt)
    putStr $ unlines $ map show ls
    t3 <- log "output done"
    _ <- log $ printf "Elapsed Time: %s" (show (diffUTCTime t3 t0))
    return ()