1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | {-# OPTIONS -Wall -XScopedTypeVariables #-}
module ArrayMergesort
( mergeSort )
where
import Data.Array.ST
import Control.Monad.ST
import Data.Array.IArray(elems)
import qualified Data.Ord as Ord
mergeSort :: (Ord a) => [a] -> [a]
mergeSort = mergeSortBy Ord.compare
mergeSortBy :: (a -> a -> Ordering) -> [a] -> [a]
mergeSortBy cmp xs =
elems $
runSTArray $
do arr <- newArray_ (1, length xs) :: ST s (STArray s Int a)
mergeAndInsertArray cmp arr xs
mergeSortArray cmp arr
mergeAndInsertArray :: (a -> a -> Ordering) -> STArray s Int a -> [a] -> ST s ()
mergeAndInsertArray cmp arr xs = go xs 1 where
go (y:z:ys) toIx
= case y `cmp` z of
GT -> do writeArray arr toIx z
writeArray arr (toIx+1) y
go ys (toIx+2)
_ -> do writeArray arr toIx y
writeArray arr (toIx+1) z
go ys (toIx+2)
go (y:[]) toIx = writeArray arr toIx y
go [] _ = return ()
mergeSortArray :: (a -> a -> Ordering) -> STArray s Int a -> ST s (STArray s Int a)
mergeSortArray cmp arr =
do (low, high) <- getBounds arr
arr' <- newArray_ (low, high)
helper 2 high arr arr'
where
--
-- Note that, a pair consist of two pieces
helper pieceSize maxIx fromArr toArr
| pieceSize >= maxIx = return fromArr
| otherwise =
do mergePairs
helper (2*pieceSize) maxIx toArr fromArr
where
pairSize = 2*pieceSize
-- One merge iteration. It reads all elements exactly once.
mergePairs = go 1 where
go ix | ix > maxIx - pairSize
-- We need to check that maxLeft & maxRight <= maxIx
= mergePair ix (ix+pieceSize) (min (ix+pieceSize-1) maxIx)
(min (ix+pairSize-1) maxIx) ix
| otherwise =
do mergePair ix (ix+pieceSize) (ix+pieceSize-1) (ix+pairSize-1) ix
go (ix + pairSize)
--
-- In mergePair, we are checking both leftIx > maxLeft and
-- rightIx > maxRight each time. Similarly are we getting both leftValue
-- and rightValue each time. Not really neccessary.
-- We could, in stead, make takeLeft and takeRight functions.
-- But benchmarks show it is not faster. I wonder why...
mergePair leftIx rightIx maxLeft maxRight toIx
| leftIx > maxLeft
= copyRest rightIx toIx maxRight
| rightIx > maxRight
= copyRest leftIx toIx maxRight
| otherwise
= do lVal <- readArray fromArr leftIx
rVal <- readArray fromArr rightIx
case lVal `cmp` rVal of
GT -> do writeArray toArr toIx rVal
mergePair leftIx (rightIx + 1) maxLeft maxRight (toIx + 1)
_ -> do writeArray toArr toIx lVal
mergePair (leftIx + 1) rightIx maxLeft maxRight (toIx + 1)
--
copyRest fromIx toIx maxTo
| toIx > maxTo = return ()
| otherwise = do readArray fromArr fromIx >>= writeArray toArr toIx
copyRest (fromIx + 1) (toIx + 1) maxTo
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | {-# OPTIONS -Wall -XScopedTypeVariables #-}
module ArrayMergesort( mergeSort )
where
import Data.Array.ST
import Control.Monad.ST
import Data.Array.IArray(elems)
import qualified Data.Ord as Ord
mergeSort :: (Ord a) => [a] -> [a]
mergeSort = mergeSortBy Ord.compare
mergeSortBy :: (a -> a -> Ordering) -> [a] -> [a]
mergeSortBy cmp xs =
elems $
runSTArray $
do arr <- newArray_(1, length xs) :: ST s(STArray s Int a)
mergeAndInsertArray cmp arr xs
mergeSortArray cmp arr
mergeAndInsertArray :: (a -> a -> Ordering) -> STArray s Int a -> [a] -> ST s()
mergeAndInsertArray cmp arr xs = go xs 1 where
go(y:z:ys) toIx
= case y `cmp` z of
GT -> do writeArray arr toIx z
writeArray arr(toIx+1) y
go ys(toIx+2)
_ -> do writeArray arr toIx y
writeArray arr(toIx+1) z
go ys(toIx+2)
go(y:[]) toIx = writeArray arr toIx y
go [] _ = return()
mergeSortArray :: (a -> a -> Ordering) -> STArray s Int a -> ST s(STArray s Int a)
mergeSortArray cmp arr =
do (low, high) <- getBounds arr
arr' <- newArray_(low, high)
helper 2 high arr arr'
where
--
-- Note that, a pair consist of two pieces
helper pieceSize maxIx fromArr toArr
| pieceSize >= maxIx = return fromArr
| otherwise =
do mergePairs
helper(2*pieceSize) maxIx toArr fromArr
where
pairSize = 2*pieceSize
-- One merge iteration. It reads all elements exactly once.
mergePairs = go 1 where
go ix | ix > maxIx - pairSize
-- We need to check that maxLeft & maxRight <= maxIx
= mergePair ix(ix+pieceSize) (min(ix+pieceSize-1) maxIx)
(min(ix+pairSize-1) maxIx) ix
| otherwise =
do mergePair ix(ix+pieceSize) (ix+pieceSize-1) (ix+pairSize-1) ix
go(ix + pairSize)
--
-- In mergePair, we are checking both leftIx > maxLeft and
-- rightIx > maxRight each time. Similarly are we getting both leftValue
-- and rightValue each time. Not really neccessary.
-- We could, in stead, make takeLeft and takeRight functions.
-- But benchmarks show it is not faster. I wonder why...
mergePair leftIx rightIx maxLeft maxRight toIx
| leftIx > maxLeft
= copyRest rightIx toIx maxRight
| rightIx > maxRight
= copyRest leftIx toIx maxRight
| otherwise
= do lVal <- readArray fromArr leftIx
rVal <- readArray fromArr rightIx
case lVal `cmp` rVal of
GT -> do writeArray toArr toIx rVal
mergePair leftIx(rightIx + 1) maxLeft maxRight(toIx + 1)
_ -> do writeArray toArr toIx lVal
mergePair(leftIx + 1) rightIx maxLeft maxRight(toIx + 1)
--
copyRest fromIx toIx maxTo
| toIx > maxTo = return()
| otherwise = do readArray fromArr fromIx >>= writeArray toArr toIx
copyRest(fromIx + 1) (toIx + 1) maxTo
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | {-# OPTIONS -Wall -XScopedTypeVariables #-}
module ArrayMergesort( mergeSort )
where
import Data.Array.ST
import Control.Monad.ST
import Data.Array.IArray(elems)
import qualified Data.Ord as Ord
mergeSort :: (Ord a) => [a] -> [a]
mergeSort = mergeSortBy Ord.compare
mergeSortBy :: (a -> a -> Ordering) -> [a] -> [a]
mergeSortBy cmp xs =
elems $
runSTArray $
do arr <- newArray_(1, length xs) :: ST s(STArray s Int a)
mergeAndInsertArray cmp arr xs
mergeSortArray cmp arr
mergeAndInsertArray :: (a -> a -> Ordering) -> STArray s Int a -> [a] -> ST s()
mergeAndInsertArray cmp arr xs = go xs 1 where
go(y:z:ys) toIx
= case y `cmp` z of
GT -> do writeArray arr toIx z
writeArray arr(toIx+1) y
go ys(toIx+2)
_ -> do writeArray arr toIx y
writeArray arr(toIx+1) z
go ys(toIx+2)
go(y:[]) toIx = writeArray arr toIx y
go [] _ = return()
mergeSortArray :: (a -> a -> Ordering) -> STArray s Int a -> ST s(STArray s Int a)
mergeSortArray cmp arr =
do (low, high) <- getBounds arr
arr' <- newArray_(low, high)
helper 2 high arr arr'
where
--
-- Note that, a pair consist of two pieces
helper pieceSize maxIx fromArr toArr
| pieceSize >= maxIx = return fromArr
| otherwise =
do mergePairs
helper(2*pieceSize) maxIx toArr fromArr
where
pairSize = 2*pieceSize
-- One merge iteration. It reads all elements exactly once.
mergePairs = go 1 where
go ix | ix > maxIx - pairSize
-- We need to check that maxLeft & maxRight <= maxIx
= mergePair ix(ix+pieceSize) (min(ix+pieceSize-1) maxIx)
(min(ix+pairSize-1) maxIx) ix
| otherwise =
do mergePair ix(ix+pieceSize) (ix+pieceSize-1) (ix+pairSize-1) ix
go(ix + pairSize)
--
-- In mergePair, we are checking both leftIx > maxLeft and
-- rightIx > maxRight each time. Similarly are we getting both leftValue
-- and rightValue each time. Not really neccessary.
-- We could, in stead, make takeLeft and takeRight functions.
-- But benchmarks show it is not faster. I wonder why...
mergePair leftIx rightIx maxLeft maxRight toIx
| leftIx > maxLeft
= copyRest rightIx toIx maxRight
| rightIx > maxRight
= copyRest leftIx toIx maxRight
| otherwise
= do lVal <- readArray fromArr leftIx
rVal <- readArray fromArr rightIx
case lVal `cmp` rVal of
GT -> do writeArray toArr toIx rVal
mergePair leftIx(rightIx + 1) maxLeft maxRight(toIx + 1)
_ -> do writeArray toArr toIx lVal
mergePair(leftIx + 1) rightIx maxLeft maxRight(toIx + 1)
--
copyRest fromIx toIx maxTo
| toIx > maxTo = return()
| otherwise = do readArray fromArr fromIx >>= writeArray toArr toIx
copyRest(fromIx + 1) (toIx + 1) maxTo
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | {-# OPTIONS -Wall -XScopedTypeVariables #-}
module ArrayMergesort( mergeSort )
where
import Data.Array.ST
import Control.Monad.ST
import Data.Array.IArray(elems)
import qualified Data.Ord as Ord
mergeSort :: (Ord a) => [a] -> [a]
mergeSort = mergeSortBy Ord.compare
mergeSortBy :: (a -> a -> Ordering) -> [a] -> [a]
mergeSortBy cmp xs =
elems $
runSTArray $
do arr <- newArray_(1, length xs) :: ST s(STArray s Int a)
mergeAndInsertArray cmp arr xs
mergeSortArray cmp arr
mergeAndInsertArray :: (a -> a -> Ordering) -> STArray s Int a -> [a] -> ST s()
mergeAndInsertArray cmp arr xs = go xs 1 where
go(y:z:ys) toIx
= case y `cmp` z of
GT -> do writeArray arr toIx z
writeArray arr(toIx+1) y
go ys(toIx+2)
_ -> do writeArray arr toIx y
writeArray arr(toIx+1) z
go ys(toIx+2)
go(y:[]) toIx = writeArray arr toIx y
go [] _ = return()
mergeSortArray :: (a -> a -> Ordering) -> STArray s Int a -> ST s(STArray s Int a)
mergeSortArray cmp arr =
do (low, high) <- getBounds arr
arr' <- newArray_(low, high)
helper 2 high arr arr'
where
--
-- Note that, a pair consist of two pieces
helper pieceSize maxIx fromArr toArr
| pieceSize >= maxIx = return fromArr
| otherwise =
do mergePairs
helper(2*pieceSize) maxIx toArr fromArr
where
pairSize = 2*pieceSize
-- One merge iteration. It reads all elements exactly once.
mergePairs = go 1 where
go ix | ix > maxIx - pairSize
-- We need to check that maxLeft & maxRight <= maxIx
= mergePair ix(ix+pieceSize) (min(ix+pieceSize-1) maxIx)
(min(ix+pairSize-1) maxIx) ix
| otherwise =
do mergePair ix(ix+pieceSize) (ix+pieceSize-1) (ix+pairSize-1) ix
go(ix + pairSize)
--
-- In mergePair, we are checking both leftIx > maxLeft and
-- rightIx > maxRight each time. Similarly are we getting both leftValue
-- and rightValue each time. Not really neccessary.
-- We could, in stead, make takeLeft and takeRight functions.
-- But benchmarks show it is not faster. I wonder why...
mergePair leftIx rightIx maxLeft maxRight toIx
| leftIx > maxLeft
= copyRest rightIx toIx maxRight
| rightIx > maxRight
= copyRest leftIx toIx maxRight
| otherwise
= do lVal <- readArray fromArr leftIx
rVal <- readArray fromArr rightIx
case lVal `cmp` rVal of
GT -> do writeArray toArr toIx rVal
mergePair leftIx(rightIx + 1) maxLeft maxRight(toIx + 1)
_ -> do writeArray toArr toIx lVal
mergePair(leftIx + 1) rightIx maxLeft maxRight(toIx + 1)
--
copyRest fromIx toIx maxTo
| toIx > maxTo = return()
| otherwise = do readArray fromArr fromIx >>= writeArray toArr toIx
copyRest(fromIx + 1) (toIx + 1) maxTo
|
1 | UuwXnu <a href="http://gduowbdpsuao.com/">gduowbdpsuao</a>, [url=http://hkwsgvadgkga.com/]hkwsgvadgkga[/url], [link=http://ervsgijxfocl.com/]ervsgijxfocl[/link], http://kxomqsxsmfuq.com/
|
1 | UuwXnu <a href="http://gduowbdpsuao.com/">gduowbdpsuao</a>, [url=http://hkwsgvadgkga.com/]hkwsgvadgkga[/url], [link=http://ervsgijxfocl.com/]ervsgijxfocl[/link], http://kxomqsxsmfuq.com/
|
1 | UuwXnu <a href="http://gduowbdpsuao.com/">gduowbdpsuao</a>, [url=http://hkwsgvadgkga.com/]hkwsgvadgkga[/url], [link=http://ervsgijxfocl.com/]ervsgijxfocl[/link], http://kxomqsxsmfuq.com/
|
1 | UuwXnu <a href="http://gduowbdpsuao.com/">gduowbdpsuao</a>, [url=http://hkwsgvadgkga.com/]hkwsgvadgkga[/url], [link=http://ervsgijxfocl.com/]ervsgijxfocl[/link], http://kxomqsxsmfuq.com/
|
1 | UuwXnu <a href="http://gduowbdpsuao.com/">gduowbdpsuao</a>, [url=http://hkwsgvadgkga.com/]hkwsgvadgkga[/url], [link=http://ervsgijxfocl.com/]ervsgijxfocl[/link], http://kxomqsxsmfuq.com/
|
1 | UuwXnu <a href="http://gduowbdpsuao.com/">gduowbdpsuao</a>, [url=http://hkwsgvadgkga.com/]hkwsgvadgkga[/url], [link=http://ervsgijxfocl.com/]ervsgijxfocl[/link], http://kxomqsxsmfuq.com/
|
1 | UuwXnu <a href="http://gduowbdpsuao.com/">gduowbdpsuao</a>, [url=http://hkwsgvadgkga.com/]hkwsgvadgkga[/url], [link=http://ervsgijxfocl.com/]ervsgijxfocl[/link], http://kxomqsxsmfuq.com/
|
1 | UuwXnu <a href="http://gduowbdpsuao.com/">gduowbdpsuao</a>, [url=http://hkwsgvadgkga.com/]hkwsgvadgkga[/url], [link=http://ervsgijxfocl.com/]ervsgijxfocl[/link], http://kxomqsxsmfuq.com/
|