Personal tools

Introduction/Direct Translation

From HaskellWiki

< Introduction(Difference between revisions)
Jump to: navigation, search
Current revision (08:07, 16 August 2009) (edit) (undo)
(+faster qsort)
 
(One intermediate revision not shown.)
Line 23: Line 23:
Has anyone got a functioning "real" quicksort that works on copy/paste?
Has anyone got a functioning "real" quicksort that works on copy/paste?
-
The program below is working very very slow. It's probably slowsort... :o)
+
The program below is working very very slowly. It's probably slowsort... :o)
<haskell>
<haskell>
Line 43: Line 43:
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 = do
+
quickSort arr = qsort' =<< getBounds arr
-
(lo, hi) <- getBounds arr
+
-
qsort' lo hi
+
where
where
-
qsort' lo hi | lo >= hi = return ()
+
qsort' (lo, hi) | lo >= hi = return ()
-
| otherwise = do
+
| otherwise = do
p <- readArray arr hi
p <- readArray arr hi
l <- mainLoop p lo hi
l <- mainLoop p lo hi
swap l hi
swap l hi
-
qsort' lo (pred l)
+
qsort' (lo, pred l)
-
qsort' (succ l) hi
+
qsort' (succ l, hi)
-
mainLoop p l h | l >= h = return l
+
mainLoop p l h | l >= h = return l
-
| otherwise = do
+
| otherwise = do
l' <- doTil (\l' b -> l' < h && b <= p) succ l
l' <- doTil (\l' b -> l' < h && b <= p) succ l
h' <- doTil (\h' b -> h' > l' && b >= p) pred h
h' <- doTil (\h' b -> h' > l' && b >= p) pred h
-
when (l' < h') $
+
when (l' < h') $ do
swap l' h'
swap l' h'
mainLoop p l' h'
mainLoop p l' h'
Line 74: Line 72:
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.
 +
 +
A more specific/direct translation (neither this nor the C version is [[polymorphic]]) is offered by [http://www.haskell.org/pipermail/haskell-cafe/2009-August/065269.html Daniel Fischer], who reports that this version runs within 2x of the C version:
 +
 +
<haskell>
 +
import Data.Array.Base (unsafeRead, unsafeWrite)
 +
import Data.Array.ST
 +
import Control.Monad.ST
 +
 +
myqsort :: STUArray s Int Int -> Int -> Int -> ST s ()
 +
myqsort a lo hi
 +
| lo < hi = do
 +
let lscan p h i
 +
| i < h = do
 +
v <- unsafeRead a i
 +
if p < v then return i else lscan p h (i+1)
 +
| otherwise = return i
 +
rscan p l i
 +
| l < i = do
 +
v <- unsafeRead a i
 +
if v < p then return i else rscan p l (i-1)
 +
| otherwise = return i
 +
swap i j = do
 +
v <- unsafeRead a i
 +
unsafeRead a j >>= unsafeWrite a i
 +
unsafeWrite a j v
 +
sloop p l h
 +
| l < h = do
 +
l1 <- lscan p h l
 +
h1 <- rscan p l1 h
 +
if (l1 < h1) then (swap l1 h1 >> sloop p l1 h1) else return l1
 +
| otherwise = return l
 +
piv <- unsafeRead a hi
 +
i <- sloop piv lo hi
 +
swap i hi
 +
myqsort a lo (i-1)
 +
myqsort a (i+1) hi
 +
| otherwise = return ()
 +
</haskell>

Current revision

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?

The program below is working very very slowly. It's probably slowsort... :o) 

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 = qsort' =<< getBounds arr
  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') $ do
            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.

A more specific/direct translation (neither this nor the C version is polymorphic) is offered by Daniel Fischer, who reports that this version runs within 2x of the C version: 

import Data.Array.Base (unsafeRead, unsafeWrite)
import Data.Array.ST
import Control.Monad.ST
 
myqsort :: STUArray s Int Int -> Int -> Int -> ST s ()
myqsort a lo hi
   | lo < hi   = do
       let lscan p h i
               | i < h = do
                   v <- unsafeRead a i
                   if p < v then return i else lscan p h (i+1)
               | otherwise = return i
           rscan p l i
               | l < i = do
                   v <- unsafeRead a i
                   if v < p then return i else rscan p l (i-1)
               | otherwise = return i
           swap i j = do
               v <- unsafeRead a i
               unsafeRead a j >>= unsafeWrite a i
               unsafeWrite a j v
           sloop p l h
               | l < h = do
                   l1 <- lscan p h l
                   h1 <- rscan p l1 h
                   if (l1 < h1) then (swap l1 h1 >> sloop p l1 h1) else return l1
               | otherwise = return l
       piv <- unsafeRead a hi
       i <- sloop piv lo hi
       swap i hi
       myqsort a lo (i-1)
       myqsort a (i+1) hi
   | otherwise = return ()
Retrieved from "http://www.haskell.org/haskellwiki/Introduction/Direct_Translation"