# Introduction/Direct Translation

### From HaskellWiki

(+faster qsort) |
|||

(6 intermediate revisions by 2 users not shown) | |||

Line 1: | Line 1: | ||

− | The quicksort quoted in [[Introduction]] isn't the "real" quicksort and doesn't scale for longer lists like the c code does. | + | 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): | Lennart Augustsson has a quicksort entry on his blog which is pure (no unsafe): | ||

Line 5: | Line 9: | ||

http://augustss.blogspot.com/2007/08/quicksort-in-haskell-quicksort-is.html | 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 | |

− | Can someone fix | + | 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) | ||

<haskell> | <haskell> | ||

Line 17: | Line 31: | ||

import Data.Array.IArray | import Data.Array.IArray | ||

import Data.Array.MArray | import Data.Array.MArray | ||

− | |||

− | 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 | |

− | + | processArray f (arr :: a i e) = runST $ do | |

− | processArray f (arr :: a i e) = runST | + | 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 :: (MArray a e m, Ix i, Enum i, Ord e) => a i e -> m () | ||

− | quickSort arr = | + | 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 | ||

</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. | ||

+ | |||

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