Introduction/Direct Translation

From HaskellWiki
< Introduction
Revision as of 04:44, 13 March 2007 by Derek Elkins (talk | contribs)
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigation Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
import Control.Monad (when)
import Control.Monad.ST
import Data.Array.IO
import Data.Array.ST
import Data.Array.IArray
import Data.Array.MArray
import System.IO.Unsafe

import Data.IORef          

qsort :: (IArray a e,Ix i,Enum i,Ord e) => a i e -> a i e
qsort arr = processArray quickSort arr

processArray 
    :: (IArray a e,IArray b e,Ix i) 
    => (forall s. (STArray s) i e -> ST s ()) -> a i e -> b i e
processArray f (arr :: a i e) = runST (do
                arr' <- thaw arr :: ST s (STArray s i e)
                f arr'
                unsafeFreeze arr')

quickSort :: (MArray a e m, Ix i, Enum i, Ord e) => a i e -> m ()
quickSort arr = case bounds arr of (lo,hi) -> qsort lo hi
    where qsort lo hi | lo >= hi  = return ()
                      | otherwise = do
              p <- readArray arr hi
              l <- mainLoop p lo hi
              swap l hi
              qsort lo (pred l)
              qsort (succ l) hi
            
          mainLoop p l h | l >= h    = return l
                         | otherwise = do
              l' <- doTil (\l' b -> l' < h && b <= p) succ l                  
              h' <- doTil (\h' b -> h' > l' && b >= p) pred h
              when (l' < h') $
                  swap l' h'
              mainLoop p l' h'
          
          doTil pred op ix = do
              b <- readArray arr ix
              if pred ix b then doTil pred op (op ix) else return ix

          swap xi yi = do
              x <- readArray arr xi
              readArray arr yi >>= writeArray arr xi
              writeArray arr yi x

This uses various extensions to make the types ridiculously general, but the actual algorithm (quickSort) is plain Haskell.