Introduction/Direct Translation: Difference between revisions

From HaskellWiki
No edit summary
(Error in quickSort)
Line 29: Line 29:
import Data.Array.IArray
import Data.Array.IArray
import Data.Array.MArray
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 :: (IArray a e, Ix i, Enum i, Ord e) => a i e -> a i e
qsort arr = processArray quickSort arr
qsort arr = processArray quickSort arr


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


quickSort :: (MArray a e m, Ix i, Enum i, Ord e) => a i e -> m ()
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
quickSort arr = do
     where qsort lo hi | lo >= hi  = return ()
    (lo, hi) <- getBounds arr
                      | otherwise = do
    qsort' lo hi
              p <- readArray arr hi
  where
              l <- mainLoop p lo hi
     qsort' lo hi | lo >= hi  = return ()
              swap l hi
                | otherwise = do
              qsort lo (pred l)
        p <- readArray arr hi
              qsort (succ l) hi
        l <- mainLoop p lo hi
           
        swap l hi
          mainLoop p l h | l >= h    = return l
        qsort' lo (pred l)
                        | otherwise = do
        qsort' (succ l) hi
              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
    mainLoop p l h | l >= h    = return l
              x <- readArray arr xi
                  | otherwise = do
              readArray arr yi >>= writeArray arr xi
        l' <- doTil (\l' b -> l' < h  && b <= p) succ l
              writeArray arr yi x
        h' <- doTil (\h' b -> h' > l' && b >= p) pred h
        when (l' < h') $
            swap l' h'
        mainLoop p l' h'
 
    doTil p op ix = do
        b <- readArray arr ix
        if p ix b then doTil p op (op ix) else return ix
 
    swap xi yi = do
        x <- readArray arr xi
        readArray arr yi >>= writeArray arr xi
        writeArray arr yi x
</haskell>
</haskell>


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

Revision as of 13:48, 19 May 2008

The quicksort quoted in Introduction isn't the "real" quicksort and doesn't scale for longer lists like the c code does.

http://programming.reddit.com/info/5yutf/comments/

Here are some points to how the "real" quicksort would look in haskell.

Lennart Augustsson has a quicksort entry on his blog which is pure (no unsafe):

http://augustss.blogspot.com/2007/08/quicksort-in-haskell-quicksort-is.html

Another version (uses System.IO.Unsafe), is below.

There is also a "parallel" quicksort at

http://www.macs.hw.ac.uk/~dsg/gph/nofib/

roconnor claims that in haskell the "real" quicksort is really a treesort:

http://programming.reddit.com/info/2h0j2/comments

Unfortunately none of the above "real" quicksorts seems to compile as given, when copy/pasted into ghci. Can someone fix? The "parallel" quicksort gave error "unknown package concurrent" when I ran make in quicksort/gransim.

Has anyone got a functioning "real" quicksort that works on copy/paste?

import Control.Monad (when)
import Control.Monad.ST
import Data.Array.ST
import Data.Array.IArray
import Data.Array.MArray

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 = do
    (lo, hi) <- getBounds arr
    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 p op ix = do
        b <- readArray arr ix
        if p ix b then doTil p 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.