http://jputnam.livejournal.com/42065.html
http://augustss.blogspot.com/2007/08/quicksort-in-haskell-quicksort-is.html
> import Data.Array.MArray
> import Data.Array
> import Data.Array.ST
> import Control.Monad.ST
> swap :: (MArray a e m, Ix i) => a i e -> i -> i -> m ()
> swap a x y = do
> vX <- readArray a x
> vY <- readArray a y
> writeArray a x vY
> writeArray a y vX
Swap is only used in one place, but it should be in the standard library, so I'm
factoring it out anyway.
Now, the most important property of quicksort is the inner loop, in which
elements less than the pivot are left at the front of the subarray and values
greater than the pivot are moved to the end. I ignore the optimization of
tracking the values equal to the pivot, which avoids pathological behavior on
simple inputs.
partition front back = do
v <- readArray a front
if (v < pivot)
then partition (front+1) back
else do swap a front back
partition front (back-1)
and, of course, when it ends, we want to properly return a middle index to swap
the pivot back into.
partition front back | front == back = do
v <- readArray a front
if (v < pivot)
then return (front+1)
else return front
Putting these together, however, results in a disappointingly long function
which manages to be almost entirely duplication. Fortunately, we can factor the
common parts together.
partition front back = do
v <- readArray a front
case (front /= back, pivot < v) of
(False, False) -> return (front+1)
(False, True) -> return front
(True, False) -> partition (front+1) back
(True, True) -> do swap a front back
partition front (back-1)
> qsortM a = do (front, back) <- getBounds a
> qsort' front back
> return a
> where qsort' front back | front >= back = return ()
> | otherwise = do
> pivot <- readArray a back
> let partition front back = do
> v <- readArray a front
> case (front /= back, pivot < v) of
> (False, False) -> return (front+1)
> (False, True) -> return front
> (True, False) -> partition (front+1) back
> (True, True) -> do swap a front back
> partition front (back-1)
> middle <- partition front (back-1)
> swap a middle back
> qsort' front (middle-1)
> qsort' (middle+1) back
> sort xs = elems $ runSTArray $ newListArray (1, length xs) xs >>= qsortM