Difference between revisions of "Introduction/Direct Translation"

From HaskellWiki
Jump to navigation Jump to 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.