Personal tools

Introduction/Direct Translation

From HaskellWiki

< Introduction(Difference between revisions)
Jump to: navigation, search
 
m
Line 2: Line 2:
 
import Control.Monad (when)
 
import Control.Monad (when)
 
import Control.Monad.ST
 
import Control.Monad.ST
import Data.Array.IO
 
 
import Data.Array.ST
 
import Data.Array.ST
 
import Data.Array.IArray
 
import Data.Array.IArray
 
import Data.Array.MArray
 
import Data.Array.MArray
 
import System.IO.Unsafe
 
import System.IO.Unsafe
 
import Data.IORef
 
   
 
qsort :: (IArray a e,Ix i,Enum i,Ord e) => a i e -> a i e
 
qsort :: (IArray a e,Ix i,Enum i,Ord e) => a i e -> a i e

Revision as of 20:53, 6 May 2007

import Control.Monad (when)
import Control.Monad.ST
import Data.Array.ST
import Data.Array.IArray
import Data.Array.MArray
import System.IO.Unsafe
 
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.