Difference between revisions of "Introduction/Direct Translation"

From HaskellWiki
Jump to navigation Jump to search
(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)
 
=> (forall s. (STArray s) i e -> ST s ()) -> a i e -> b i e
:: (IArray a e,IArray b e,Ix i)
 
  +
processArray f (arr :: a i e) = runST $ do
=> (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'
arr' <- thaw arr :: ST s (STArray s i e)
 
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
  +
qsort' lo hi
| otherwise = do
 
  +
where
p <- readArray arr hi
 
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>
   

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.