Difference between revisions of "Introduction/Direct Translation"
Derek Elkins (talk | contribs) |
(+faster qsort) |
||
(10 intermediate revisions by 3 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. |
||
+ | |||
+ | 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) |
||
+ | |||
<haskell> |
<haskell> |
||
import Control.Monad (when) |
import Control.Monad (when) |
||
import Control.Monad.ST |
import Control.Monad.ST |
||
− | import Data.Array.IO |
||
import Data.Array.ST |
import Data.Array.ST |
||
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 |
||
− | import Data.IORef |
||
− | |||
− | 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 |
||
− | + | arr' <- thaw arr :: ST s (STArray s i e) |
|
+ | f arr' |
||
− | arr' <- thaw arr :: ST s (STArray s i e) |
||
− | + | 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 = |
+ | quickSort arr = qsort' =<< getBounds arr |
+ | where |
||
− | where qsort lo hi | lo >= hi = return () |
||
− | + | 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 pred op ix = do |
||
− | b <- readArray arr ix |
||
− | if pred ix b then doTil pred op (op ix) else return ix |
||
− | + | 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 ()