Created
July 14, 2013 04:36
-
-
Save dmatveev/5993223 to your computer and use it in GitHub Desktop.
Yet another Haskell ST-powered QuickSort implementation
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE ScopedTypeVariables #-} | |
module MergeSort where | |
import Control.Monad.ST | |
import Control.Monad (forM_, when) | |
import Data.Array.ST | |
import Data.STRef | |
-- Required for tests only | |
import System.Random (getStdGen, randomRs) | |
import Data.List (foldl') | |
quickSort :: forall a . Ord a => [a] -> [a] | |
quickSort items = runST $ do | |
let total = length items | |
arr <- newListArray (1, total) items :: ST s (STArray s Int a) | |
quickSort' arr 1 total | |
getElems arr | |
where | |
quickSort' arr p r = do | |
when (p < r) $ do | |
q <- qsPartition arr p r | |
quickSort' arr p (q - 1) | |
quickSort' arr (q + 1) r | |
qsPartition arr p r = do | |
i <- newSTRef (p - 1) | |
s <- readArray arr r | |
forM_ [p .. pred r] $ \j -> do | |
jj <- readArray arr j | |
when (jj <= s) $ do | |
modifySTRef i (+1) | |
readSTRef i >>= \ii -> qsSwap arr ii j | |
ii <- readSTRef i | |
qsSwap arr (ii + 1) r | |
return (ii + 1) | |
qsSwap arr i j = do | |
v <- readArray arr i | |
readArray arr j >>= writeArray arr i | |
writeArray arr j v | |
qsVerify :: Ord a => [a] -> Bool | |
qsVerify [] = True | |
qsVerify [_] = True | |
qsVerify (x:y:xs) = x <= y && qsVerify xs | |
qsTest :: IO () | |
qsTest = do | |
g <- getStdGen | |
let items = take 1000 $ randomRs (0, 10000 :: Int) g | |
sorted = quickSort items | |
when (qsVerify sorted) $ putStrLn "Works fine" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment