# Introduction/Direct Translation

### From HaskellWiki

(Error in quickSort) |
(+faster qsort) |
||

(2 intermediate revisions by one user not shown) | |||

Line 22: | Line 22: | ||

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 slowly. It's probably slowsort... :o) |
||

<haskell> |
<haskell> |
||

Line 41: | 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 70: | 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> |

## Latest revision as of 08:07, 16 August 2009

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 ()