uvector-algorithms 0.1.1 → 0.2
raw patch · 18 files changed
+1054/−166 lines, 18 filesdep ~basedep ~uvector
Dependency ranges changed: base, uvector
Files
- Data/Array/Vector/Algorithms/Combinators.hs +69/−0
- Data/Array/Vector/Algorithms/Immutable.hs +0/−24
- Data/Array/Vector/Algorithms/Intro.hs +11/−9
- Data/Array/Vector/Algorithms/Merge.hs +3/−3
- Data/Array/Vector/Algorithms/Optimal.hs +115/−80
- Data/Array/Vector/Algorithms/Radix.hs +107/−37
- Data/Array/Vector/Algorithms/TriHeap.hs +20/−7
- LICENSE +1/−1
- bench/Blocks.hs +62/−0
- bench/LICENSE +30/−0
- bench/Main.hs +148/−0
- bench/RadSieve.hs +97/−0
- bench/uvector-algorithms-bench.cabal +22/−0
- tests/Optimal.hs +66/−0
- tests/Properties.hs +122/−0
- tests/Tests.hs +131/−0
- tests/Util.hs +46/−0
- uvector-algorithms.cabal +4/−5
+ Data/Array/Vector/Algorithms/Combinators.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE Rank2Types, TypeOperators #-}++-- ---------------------------------------------------------------------------+-- |+-- Module : Data.Array.Vector.Algorithms.Combinators+-- Copyright : (c) 2008-2009 Dan Doel+-- Maintainer : Dan Doel <dan.doel@gmail.com>+-- Stability : Experimental+-- Portability : Non-portable (rank-2 types)+--+-- The purpose of this module is to supply various combinators for commonly+-- used idioms for the algorithms in this package. Examples at the time of+-- this writing include running an algorithm keyed on some function of the+-- elements (but only computing said function once per element), and safely+-- applying the algorithms on mutable arrays to immutable arrays.++module Data.Array.Vector.Algorithms.Combinators+ ( apply+ , usingKeys+ , usingIxKeys+ ) where++import Control.Monad.ST++import Data.Ord++import Data.Array.Vector+import Data.Array.Vector.Algorithms.Common++-- | Safely applies a mutable array algorithm to an immutable array.+apply :: (UA e) => (forall s. MUArr e s -> ST s ()) -> UArr e -> UArr e+apply algo v = newU (lengthU v) (\arr -> copyMU arr 0 v >> algo arr)++-- | Uses a function to compute a key for each element which the+-- algorithm should use in lieu of the actual element. For instance:+--+-- > usingKeys sortBy f arr+--+-- should produce the same results as:+--+-- > sortBy (comparing f) arr+--+-- the difference being that usingKeys computes each key only once+-- which can be more efficient for expensive key functions.+usingKeys :: (UA e, UA k, Ord k)+ => (forall e'. (UA e') => Comparison e' -> MUArr e' s -> ST s ())+ -> (e -> k)+ -> MUArr e s+ -> ST s ()+usingKeys algo f arr = usingIxKeys algo (const f) arr+{-# INLINE usingKeys #-}++-- | As usingKeys, only the key function has access to the array index+-- at which each element is stored.+usingIxKeys :: (UA e, UA k, Ord k)+ => (forall e'. (UA e') => Comparison e' -> MUArr e' s -> ST s ())+ -> (Int -> e -> k)+ -> MUArr e s+ -> ST s ()+usingIxKeys algo f arr = do+ keys <- newMU (lengthMU arr)+ fill len keys+ algo (comparing fstS) (unsafeZipMU keys arr)+ where+ len = lengthMU arr+ fill k keys+ | k < 0 = return ()+ | otherwise = readMU arr k >>= writeMU keys k . f k >> fill (k-1) keys+{-# INLINE usingIxKeys #-}
− Data/Array/Vector/Algorithms/Immutable.hs
@@ -1,24 +0,0 @@-{-# LANGUAGE Rank2Types #-}---- ------------------------------------------------------------------------------ |--- Module : Data.Array.Vector.Algorithms.Immutable--- Copyright : (c) 2008 Dan Doel--- Maintainer : Dan Doel <dan.doel@gmail.com>--- Stability : Experimental--- Portability : Non-portable (rank-2 types)------ The purpose of this module is to apply the algorithms on mutable arrays--- in other packages to immutable arrays. The idea is to copy the immutable--- array into a mutable intermediate, perform the algorithm on the mutable--- array, and freeze it, yielding a new immutable array.--module Data.Array.Vector.Algorithms.Immutable ( apply ) where--import Control.Monad.ST--import Data.Array.Vector---- | Safely applies a mutable array algorithm to an immutable array.-apply :: (UA e) => (forall s. MUArr e s -> ST s ()) -> UArr e -> UArr e-apply algo v = newU (lengthU v) (\arr -> copyMU arr 0 v >> algo arr)
Data/Array/Vector/Algorithms/Intro.hs view
@@ -145,15 +145,17 @@ where len = u - l go 0 l m n = H.partialSortByBounds cmp a (m - l) l u- go n l m u = do O.sort3ByIndex cmp a c l (u-1)- p <- readMU a l- mid <- partitionBy cmp a p (l+1) u- swap a l (mid - 1)- case compare m mid of- GT -> do introsort cmp a (n-1) l (mid - 1)- go (n-1) mid m u- EQ -> introsort cmp a (n-1) l m- LT -> go n l m (mid - 1)+ go n l m u+ | l == m = return ()+ | otherwise = do O.sort3ByIndex cmp a c l (u-1)+ p <- readMU a l+ mid <- partitionBy cmp a p (l+1) u+ swap a l (mid - 1)+ case compare m mid of+ GT -> do introsort cmp a (n-1) l (mid - 1)+ go (n-1) mid m u+ EQ -> introsort cmp a (n-1) l m+ LT -> go n l m (mid - 1) where c = (u + l) `div` 2 {-# INLINE partialSortByBounds #-}
Data/Array/Vector/Algorithms/Merge.hs view
@@ -1,7 +1,7 @@ -- --------------------------------------------------------------------------- -- | -- Module : Data.Array.Vector.Algorithms.Merge--- Copyright : (c) 2008 Dan Doel+-- Copyright : (c) 2008-2009 Dan Doel -- Maintainer : Dan Doel <dan.doel@gmail.com> -- Stability : Experimental -- Portability : Portable@@ -65,7 +65,7 @@ {-# INLINE mergeSortWithBuf #-} merge :: (UA e) => Comparison e -> MUArr e s -> MUArr e s -> Int -> Int -> Int -> ST s ()-merge cmp arr tmp l m u = do mcopyMU arr tmp l 0 uTmp+merge cmp arr tmp l m u = do memcpyOffMU arr tmp l 0 uTmp eTmp <- readMU tmp 0 eArr <- readMU arr m loop 0 eTmp m eArr l@@ -74,7 +74,7 @@ uArr = u loop iTmp eTmp iArr eArr iIns | iTmp >= uTmp = return ()- | iArr >= uArr = mcopyMU tmp arr iTmp iIns (uTmp - iTmp)+ | iArr >= uArr = memcpyOffMU tmp arr iTmp iIns (uTmp - iTmp) | otherwise = case cmp eArr eTmp of LT -> do writeMU arr iIns eArr eArr <- readMU arr (iArr+1)
Data/Array/Vector/Algorithms/Optimal.hs view
@@ -71,20 +71,20 @@ case cmp a0 a1 of GT -> case cmp a0 a2 of GT -> case cmp a2 a1 of- GT -> do writeMU a i a1- writeMU a j a2+ LT -> do writeMU a i a2 writeMU a k a0- _ -> do writeMU a i a2+ _ -> do writeMU a i a1+ writeMU a j a2 writeMU a k a0 _ -> do writeMU a i a1 writeMU a j a0 _ -> case cmp a1 a2 of- GT -> case cmp a2 a0 of- GT -> do writeMU a j a2+ GT -> case cmp a0 a2 of+ GT -> do writeMU a i a2+ writeMU a j a0 writeMU a k a1- _ -> do writeMU a i a2+ _ -> do writeMU a j a2 writeMU a k a1- writeMU a j a0 _ -> return () {-# INLINE sort3ByIndex #-} @@ -105,88 +105,123 @@ a2 <- readMU a k a3 <- readMU a l case cmp a0 a1 of- LT -> case cmp a1 a2 of- LT -> case cmp a1 a3 of- LT -> case cmp a2 a3 of- GT -> do writeMU a k a3- writeMU a l a2- _ -> return ()- _ -> do case cmp a0 a3 of- LT -> writeMU a j a3- _ -> do writeMU a j a0- writeMU a i a3- writeMU a l a2- writeMU a k a1- _ -> case cmp a0 a2 of- LT -> case cmp a2 a3 of- LT -> case cmp a1 a3 of- LT -> do writeMU a j a2- writeMU a k a1- _ -> do writeMU a l a1+ GT -> case cmp a0 a2 of+ GT -> case cmp a1 a2 of+ GT -> case cmp a1 a3 of+ GT -> case cmp a2 a3 of+ GT -> do writeMU a i a3 writeMU a j a2- writeMU a k a3- _ -> case cmp a0 a3 of- LT -> do writeMU a l a1+ writeMU a k a1+ writeMU a l a0+ _ -> do writeMU a i a2 writeMU a j a3- _ -> do writeMU a i a3- writeMU a l a1- writeMU a j a0- _ -> case cmp a0 a3 of- LT -> do writeMU a i a2- case cmp a1 a3 of- LT -> writeMU a k a1- _ -> do writeMU a k a3- writeMU a l a1+ writeMU a k a1+ writeMU a l a0+ _ -> case cmp a0 a3 of+ GT -> do writeMU a i a2+ writeMU a j a1+ writeMU a k a3+ writeMU a l a0+ _ -> do writeMU a i a2+ writeMU a j a1+ writeMU a k a0+ writeMU a l a3+ _ -> case cmp a2 a3 of+ GT -> case cmp a1 a3 of+ GT -> do writeMU a i a3+ writeMU a j a1+ writeMU a k a2+ writeMU a l a0+ _ -> do writeMU a i a1+ writeMU a j a3+ writeMU a k a2+ writeMU a l a0+ _ -> case cmp a0 a3 of+ GT -> do writeMU a i a1+ writeMU a j a2+ writeMU a k a3+ writeMU a l a0+ _ -> do writeMU a i a1+ writeMU a j a2+ writeMU a k a0+ -- writeMU a l a3+ _ -> case cmp a0 a3 of+ GT -> case cmp a1 a3 of+ GT -> do writeMU a i a3+ -- writeMU a j a1+ writeMU a k a0+ writeMU a l a2+ _ -> do writeMU a i a1+ writeMU a j a3+ writeMU a k a0+ writeMU a l a2+ _ -> case cmp a2 a3 of+ GT -> do writeMU a i a1 writeMU a j a0- _ -> case cmp a2 a3 of- LT -> do writeMU a i a2+ writeMU a k a3+ writeMU a l a2+ _ -> do writeMU a i a1+ writeMU a j a0+ -- writeMU a k a2+ -- writeMU a l a3+ _ -> case cmp a1 a2 of+ GT -> case cmp a0 a2 of+ GT -> case cmp a0 a3 of+ GT -> case cmp a2 a3 of+ GT -> do writeMU a i a3+ writeMU a j a2 writeMU a k a0- writeMU a j a3 writeMU a l a1- _ -> do writeMU a j a2+ _ -> do writeMU a i a2+ writeMU a j a3 writeMU a k a0- writeMU a i a3 writeMU a l a1- _ -> case cmp a0 a2 of- LT -> case cmp a0 a3 of- LT -> do writeMU a i a1- writeMU a j a0- case cmp a2 a3 of- GT -> do writeMU a k a3- writeMU a l a2- _ -> return ()- _ -> do case cmp a1 a3 of- LT -> do writeMU a i a1- writeMU a j a3- _ -> writeMU a i a3- writeMU a l a2- writeMU a k a0- _ -> case cmp a1 a2 of- LT -> case cmp a2 a3 of- LT -> do writeMU a i a1- writeMU a j a2- case cmp a0 a3 of- LT -> writeMU a k a0- _ -> do writeMU a k a3- writeMU a l a0- _ -> do case cmp a1 a3 of- LT -> do writeMU a i a1- writeMU a j a3- _ -> writeMU a i a3- writeMU a l a0- _ -> case cmp a1 a3 of- LT -> do writeMU a i a2- case cmp a0 a3 of- LT -> writeMU a k a0- _ -> do writeMU a k a3- writeMU a l a0- _ -> case cmp a2 a3 of- LT -> do writeMU a i a2+ _ -> case cmp a1 a3 of+ GT -> do writeMU a i a2+ writeMU a j a0+ writeMU a k a3+ writeMU a l a1+ _ -> do writeMU a i a2+ writeMU a j a0 writeMU a k a1+ -- writeMU a l a3+ _ -> case cmp a2 a3 of+ GT -> case cmp a0 a3 of+ GT -> do writeMU a i a3+ writeMU a j a0+ -- writeMU a k a2+ writeMU a l a1+ _ -> do -- writeMU a i a0 writeMU a j a3- writeMU a l a0- _ -> do writeMU a i a3- writeMU a l a0+ -- writeMU a k a2+ writeMU a l a1+ _ -> case cmp a1 a3 of+ GT -> do -- writeMU a i a0 writeMU a j a2+ writeMU a k a3+ writeMU a l a1+ _ -> do -- writeMU a i a0+ writeMU a j a2 writeMU a k a1+ -- writeMU a l a3+ _ -> case cmp a1 a3 of+ GT -> case cmp a0 a3 of+ GT -> do writeMU a i a3+ writeMU a j a0+ writeMU a k a1+ writeMU a l a2+ _ -> do -- writeMU a i a0+ writeMU a j a3+ writeMU a k a1+ writeMU a l a2+ _ -> case cmp a2 a3 of+ GT -> do -- writeMU a i a0+ -- writeMU a j a1+ writeMU a k a3+ writeMU a l a2+ _ -> do -- writeMU a i a0+ -- writeMU a j a1+ -- writeMU a k a2+ -- writeMU a l a3+ return () {-# INLINE sort4ByIndex #-}
Data/Array/Vector/Algorithms/Radix.hs view
@@ -1,9 +1,9 @@-{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables, BangPatterns, TypeOperators #-} -- --------------------------------------------------------------------------- -- | -- Module : Data.Array.Vector.Algorithms.Radix--- Copyright : (c) 2008 Dan Doel+-- Copyright : (c) 2008-2009 Dan Doel -- Maintainer : Dan Doel <dan.doel@gmail.com> -- Stability : Experimental -- Portability : Non-portable (scoped type variables, bang patterns)@@ -33,7 +33,7 @@ -- -- > radix k e = (e `shiftR` (k*8)) .&. 256 -module Data.Array.Vector.Algorithms.Radix (sort, Radix(..)) where+module Data.Array.Vector.Algorithms.Radix (sort, sortBy, Radix(..)) where import Control.Monad import Control.Monad.ST@@ -63,7 +63,7 @@ {-# INLINE size #-} radix 0 e = e .&. 255 radix i e- | i == passes e - 1 = radix' (e + minBound)+ | i == passes e - 1 = radix' (e `xor` minBound) | otherwise = radix' e where radix' e = (e `shiftR` (i `shiftL` 3)) .&. 255 {-# INLINE radix #-}@@ -73,7 +73,7 @@ {-# INLINE passes #-} size _ = 256 {-# INLINE size #-}- radix _ e = fromIntegral e + 128+ radix _ e = 255 .&. fromIntegral e `xor` 128 {-# INLINE radix #-} instance Radix Int16 where@@ -82,7 +82,7 @@ size _ = 256 {-# INLINE size #-} radix 0 e = fromIntegral (e .&. 255)- radix 1 e = fromIntegral (((e + minBound) `shiftR` 8) .&. 255)+ radix 1 e = fromIntegral (((e `xor` minBound) `shiftR` 8) .&. 255) {-# INLINE radix #-} instance Radix Int32 where@@ -93,7 +93,7 @@ radix 0 e = fromIntegral (e .&. 255) radix 1 e = fromIntegral ((e `shiftR` 8) .&. 255) radix 2 e = fromIntegral ((e `shiftR` 16) .&. 255)- radix 3 e = fromIntegral (((e + minBound) `shiftR` 24) .&. 255)+ radix 3 e = fromIntegral (((e `xor` minBound) `shiftR` 24) .&. 255) {-# INLINE radix #-} instance Radix Int64 where@@ -108,7 +108,7 @@ radix 4 e = fromIntegral ((e `shiftR` 32) .&. 255) radix 5 e = fromIntegral ((e `shiftR` 40) .&. 255) radix 6 e = fromIntegral ((e `shiftR` 48) .&. 255)- radix 7 e = fromIntegral (((e + minBound) `shiftR` 56) .&. 255)+ radix 7 e = fromIntegral (((e `xor` minBound) `shiftR` 56) .&. 255) {-# INLINE radix #-} instance Radix Word where@@ -163,44 +163,114 @@ radix 7 e = fromIntegral ((e `shiftR` 56) .&. 255) {-# INLINE radix #-} +instance (Radix i, Radix j) => Radix (i :*: j) where+ passes ~(i :*: j) = passes i + passes j+ {-# INLINE passes #-}+ size ~(i :*: j) = size i `max` size j+ {-# INLINE size #-}+ radix k ~(i :*: j) | k < passes j = radix k j+ | otherwise = radix (k - passes j) i+ {-# INLINE radix #-}+ -- | Sorts an array based on the Radix instance. sort :: forall e s. Radix e => MUArr e s -> ST s ()-sort arr = do- tmp <- newMU len- count <- newMU (size e)- prefix <- newMU (size e)- go False arr tmp count prefix 0+sort arr = sortBy (passes e) (size e) radix arr where- len = lengthMU arr e :: e e = undefined- go !swap src dst count prefix k- | k < passes e = do zero 0 count- countLoop 0 k src count- writeMU prefix 0 0- prefixLoop 1 0 count prefix- moveLoop 0 k src dst prefix- go (not swap) dst src count prefix (k+1)- | otherwise = when swap (mcopyMU src dst 0 0 len)- zero i a- | i < size e = writeMU a i 0 >> zero (i+1) a- | otherwise = return ()- countLoop i k src count- | i < len = readMU src i >>= inc count . radix k >> countLoop (i+1) k src count- | otherwise = return ()- prefixLoop i pi count prefix- | i < size e = do ci <- readMU count (i-1)- let pi' = pi + ci- writeMU prefix i pi'- prefixLoop (i+1) pi' count prefix+{-# INLINE sort #-}++-- | Radix sorts an array using custom radix information+-- requires the number of passes to fully sort the array,+-- the size of of auxiliary arrays necessary (should be+-- one greater than the maximum value returned by the radix+-- function), and a radix function, which takes the pass+-- and an element, and returns the relevant radix.+sortBy :: (UA e) => Int -- ^ the number of passes+ -> Int -- ^ the size of auxiliary arrays+ -> (Int -> e -> Int) -- ^ the radix function+ -> MUArr e s -- ^ the array to be sorted+ -> ST s ()+sortBy passes size rdx arr = do+ tmp <- newMU (lengthMU arr)+ count <- newMU (size)+ prefix <- newMU (size)+ radixLoop passes rdx arr tmp count prefix+{-# INLINE sortBy #-}++radixLoop :: (UA e) => Int -- passes+ -> (Int -> e -> Int) -- radix function+ -> MUArr e s -- array to sort+ -> MUArr e s -- temporary array+ -> MUArr Int s -- radix count array+ -> MUArr Int s -- placement array+ -> ST s ()+radixLoop passes rdx src dst count prefix = go False 0+ where+ len = lengthMU src+ go swap k+ | k < passes = if swap+ then body rdx dst src count prefix k >> go (not swap) (k+1)+ else body rdx src dst count prefix k >> go (not swap) (k+1)+ | otherwise = when swap (mcopyMU dst src 0 0 len)+{-# INLINE radixLoop #-}++body :: (UA e) => (Int -> e -> Int) -- radix function+ -> MUArr e s -- source array+ -> MUArr e s -- destination array+ -> MUArr Int s -- radix count+ -> MUArr Int s -- placement+ -> Int -- current pass+ -> ST s ()+body rdx src dst count prefix k = do+ zero count+ countLoop k rdx src count+ writeMU prefix 0 0+ prefixLoop count prefix+ moveLoop k rdx src dst prefix+{-# INLINE body #-}++zero :: MUArr Int s -> ST s ()+zero a = go 0+ where+ len = lengthMU a+ go i+ | i < len = writeMU a i 0 >> go (i+1)+ | otherwise = return ()+{-# INLINE zero #-}++countLoop :: (UA e) => Int -> (Int -> e -> Int) -> MUArr e s -> MUArr Int s -> ST s ()+countLoop k rdx src count = go 0+ where+ len = lengthMU src+ go i+ | i < len = readMU src i >>= inc count . rdx k >> go (i+1) | otherwise = return ()- moveLoop i k src dst prefix+{-# INLINE countLoop #-}++prefixLoop :: MUArr Int s -> MUArr Int s -> ST s ()+prefixLoop count prefix = go 1 0+ where+ len = lengthMU count+ go i pi+ | i < len = do ci <- readMU count (i-1)+ let pi' = pi + ci+ writeMU prefix i pi'+ go (i+1) pi'+ | otherwise = return ()+{-# INLINE prefixLoop #-}++moveLoop :: (UA e) => Int -> (Int -> e -> Int) -> MUArr e s -> MUArr e s -> MUArr Int s -> ST s ()+moveLoop k rdx src dst prefix = go 0+ where+ len = lengthMU src+ go i | i < len = do srci <- readMU src i- pf <- inc prefix (radix k srci)+ pf <- inc prefix (rdx k srci) writeMU dst pf srci- moveLoop (i+1) k src dst prefix+ go (i+1) | otherwise = return ()-{-# INLINE sort #-}+{-# INLINE moveLoop #-} inc :: MUArr Int s -> Int -> ST s Int inc arr i = readMU arr i >>= \e -> writeMU arr i (e+1) >> return e
Data/Array/Vector/Algorithms/TriHeap.hs view
@@ -3,7 +3,7 @@ -- --------------------------------------------------------------------------- -- | -- Module : Data.Array.Vector.Algorithms.TriHeap--- Copyright : (c) 2008 Dan Doel+-- Copyright : (c) 2008-2009 Dan Doel -- Maintainer : Dan Doel <dan.doel@gmail.com> -- Stability : Experimental -- Portability : Non-portable (type operators)@@ -82,7 +82,9 @@ -- array into the positions [l,k+l). The elements will be in -- no particular order. selectByBounds :: (UA e) => Comparison e -> MUArr e s -> Int -> Int -> Int -> ST s ()-selectByBounds cmp a k l u = heapify cmp a l (l + k) >> go l (l + k) u+selectByBounds cmp a k l u+ | l + k <= u = heapify cmp a l (l + k) >> go l (l + k) (u - 1)+ | otherwise = return () where go l m u | u < m = return ()@@ -108,11 +110,22 @@ -- | Moves the lowest k elements in the portion [l,u) of the array -- into positions [l,k+l), sorted. partialSortByBounds :: (UA e) => Comparison e -> MUArr e s -> Int -> Int -> Int -> ST s ()-partialSortByBounds cmp a k l u = do selectByBounds cmp a k l u- sortHeap cmp a l (l + 4) (l + k)- O.sort4ByOffset cmp a l- -- this technically does extra work for k < 4, but- -- I'm not sure that's a significant concern.+partialSortByBounds cmp a k l u+ -- this potentially does more work than absolutely required,+ -- but using a heap to find the least 2 of 4 elements+ -- seems unlikely to be better than just sorting all of them+ -- with an optimal sort, and the latter is obviously index+ -- correct.+ | len < 2 = return ()+ | len == 2 = O.sort2ByOffset cmp a l+ | len == 3 = O.sort3ByOffset cmp a l+ | len == 4 = O.sort4ByOffset cmp a l+ | u <= l + k = sortByBounds cmp a l u+ | otherwise = do selectByBounds cmp a k l u+ sortHeap cmp a l (l + 4) (l + k)+ O.sort4ByOffset cmp a l+ where+ len = u - l {-# INLINE partialSortByBounds #-} -- | Constructs a heap in a portion of an array [l, u)
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2008 Dan Doel+Copyright (c) 2008-2009 Dan Doel All rights reserved.
+ bench/Blocks.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE Rank2Types #-}++module Blocks where++import Control.Monad+import Control.Monad.ST++import Data.Array.Vector++import System.CPUTime++import System.Random.Mersenne++-- Some conveniences for doing evil stuff in the ST monad.+-- All the tests get run in IO, but uvector stuff happens+-- in ST, so we temporarily coerce.+clock :: ST s Integer+clock = unsafeIOToST getCPUTime++-- Strategies for filling the initial arrays+rand :: (MTRandom e) => MTGen -> Int -> ST s e+rand g _ = unsafeIOToST (random g)++ascend :: Num e => Int -> ST s e+ascend = return . fromIntegral++descend :: Num e => e -> Int -> ST s e+descend m n = return $ m - fromIntegral n++modulo :: Integral e => e -> Int -> ST s e+modulo m n = return $ fromIntegral n `mod` m++-- This is the worst case for the median-of-three quicksort+-- used in the introsort implementation.+medianKiller :: Integral e => e -> Int -> ST s e+medianKiller m n'+ | n < k = return $ if even n then n + 1 else n + k+ | otherwise = return $ (n - k + 1) * 2+ where+ n = fromIntegral n'+ k = m `div` 2+{-# INLINE medianKiller #-}++initialize :: (UA e) => MUArr e s -> Int -> (Int -> ST s e) -> ST s ()+initialize arr len fill = init $ len - 1+ where init n = fill n >>= writeMU arr n >> when (n > 0) (init $ n - 1)+{-# INLINE initialize #-}++speedTest :: (UA e) => Int+ -> (forall s. Int -> ST s e)+ -> (forall s. MUArr e s -> ST s ())+ -> IO Integer+speedTest n fill algo = stToIO $ do+ arr <- newMU n+ initialize arr n fill+ t0 <- clock+ algo arr+ t1 <- clock+ return $ t1 - t0+{-# INLINE speedTest #-}++
+ bench/LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2009 Dan Doel++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ bench/Main.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE Rank2Types #-}++module Main (main) where++import Control.Monad.ST+import Control.Monad.Error++import Data.Char+import Data.Ord (comparing)+import Data.List (maximumBy)+import Data.Array.Vector++import qualified Data.Array.Vector.Algorithms.Insertion as INS+import qualified Data.Array.Vector.Algorithms.Intro as INT+import qualified Data.Array.Vector.Algorithms.TriHeap as TH+import qualified Data.Array.Vector.Algorithms.Merge as M+import qualified Data.Array.Vector.Algorithms.Radix as R++import System.Environment+import System.Console.GetOpt+import System.Random.Mersenne++import Blocks++-- Does nothing. For testing the speed/heap allocation of the building blocks.+noalgo :: (UA e) => MUArr e s -> ST s ()+noalgo _ = return ()++-- Allocates a temporary buffer, like mergesort for similar purposes as noalgo.+alloc :: (UA e) => MUArr e s -> ST s ()+alloc arr | len <= 4 = arr `seq` return ()+ | otherwise = (newMU (len `div` 2) :: ST s (MUArr Int s)) >> return ()+ where len = lengthMU arr++displayTime :: String -> Integer -> IO ()+displayTime s elapsed = putStrLn $+ s ++ " : " ++ show (fromIntegral elapsed / 1e12) ++ " seconds"++run :: String -> IO Integer -> IO ()+run s t = t >>= displayTime s++sortSuite :: String -> MTGen -> Int -> (forall s. MUArr Int s -> ST s ()) -> IO ()+sortSuite str g n sort = do+ putStrLn $ "Testing: " ++ str+ run "Random " $ speedTest n (rand g >=> modulo n) sort+ run "Sorted " $ speedTest n ascend sort+ run "Reverse-sorted " $ speedTest n (descend n) sort+ run "Random duplicates " $ speedTest n (rand g >=> modulo 1000) sort+ let m = 4 * (n `div` 4)+ run "Median killer " $ speedTest m (medianKiller m) sort++partialSortSuite :: String -> MTGen -> Int -> Int+ -> (forall s. MUArr Int s -> Int -> ST s ()) -> IO ()+partialSortSuite str g n k sort = sortSuite str g n (\a -> sort a k)++-- -----------------+-- Argument handling+-- -----------------++data Algorithm = DoNothing+ | Allocate+ | InsertionSort+ | IntroSort+ | IntroPartialSort+ | IntroSelect+ | TriHeapSort+ | TriHeapPartialSort+ | TriHeapSelect+ | MergeSort+ | RadixSort+ deriving (Show, Read, Enum, Bounded)++data Options = O { algos :: [Algorithm], elems :: Int, portion :: Int, usage :: Bool } deriving (Show)++defaultOptions :: Options+defaultOptions = O [] 10000 1000 False++type OptionsT = Options -> Either String Options++options :: [OptDescr OptionsT]+options = [ Option ['A'] ["algorithm"] (ReqArg parseAlgo "ALGO")+ ("Specify an algorithm to be run. Options:\n" ++ algoOpts)+ , Option ['n'] ["num-elems"] (ReqArg parseN "INT")+ "Specify the size of arrays in algorithms."+ , Option ['k'] ["portion"] (ReqArg parseK "INT")+ "Specify the number of elements to partial sort/select in\nrelevant algorithms."+ , Option ['?','v'] ["help"] (NoArg $ \o -> Right $ o { usage = True })+ "Show options."+ ]+ where+ allAlgos :: [Algorithm]+ allAlgos = [minBound .. maxBound]+ algoOpts = fmt allAlgos+ fmt (x:y:zs) = '\t' : pad (show x) ++ show y ++ "\n" ++ fmt zs+ fmt [x] = '\t' : show x ++ "\n"+ fmt [] = ""+ size = (" " ++) . maximumBy (comparing length) . map show $ allAlgos+ pad str = zipWith const (str ++ repeat ' ') size++parseAlgo :: String -> Options -> Either String Options+parseAlgo "None" o = Right $ o { algos = [] }+parseAlgo "All" o = Right $ o { algos = [DoNothing .. RadixSort] }+parseAlgo s o = leftMap (\e -> "Unrecognized algorithm `" ++ e ++ "'")+ . fmap (\v -> o { algos = v : algos o }) $ readEither s++leftMap :: (a -> b) -> Either a c -> Either b c+leftMap f (Left a) = Left (f a)+leftMap _ (Right c) = Right c++parseNum :: (Int -> Options) -> String -> Either String Options+parseNum f = leftMap (\e -> "Invalid numeric argument `" ++ e ++ "'") . fmap f . readEither++parseN, parseK :: String -> Options -> Either String Options+parseN s o = parseNum (\n -> o { elems = n }) s+parseK s o = parseNum (\k -> o { portion = k }) s++readEither :: Read a => String -> Either String a+readEither s = case reads s of+ [(x,t)] | all isSpace t -> Right x+ _ -> Left s++runTest :: MTGen -> Int -> Int -> Algorithm -> IO ()+runTest g n k alg = case alg of+ DoNothing -> sortSuite "no algorithm" g n noalgo+ Allocate -> sortSuite "allocate" g n alloc+ InsertionSort -> sortSuite "insertion sort" g n INS.sort+ IntroSort -> sortSuite "introsort" g n INT.sort+ IntroPartialSort -> partialSortSuite "partial introsort" g n k INT.partialSort+ IntroSelect -> partialSortSuite "introselect" g n k INT.select+ TriHeapSort -> sortSuite "tri-heap sort" g n TH.sort+ TriHeapPartialSort -> partialSortSuite "partial tri-heap sort" g n k TH.partialSort+ TriHeapSelect -> partialSortSuite "tri-heap select" g n k TH.select+ MergeSort -> sortSuite "merge sort" g n M.sort+ RadixSort -> sortSuite "radix sort" g n R.sort+ _ -> putStrLn $ "Currently unsupported algorithm: " ++ show alg++main :: IO ()+main = do args <- getArgs+ gen <- getStdGen+ case getOpt Permute options args of+ (fs, _, []) -> case foldl (>>=) (Right defaultOptions) fs of+ Left err -> putStrLn $ usageInfo err options+ Right opts | not (usage opts) ->+ mapM_ (runTest gen (elems opts) (portion opts)) (algos opts)+ | otherwise -> putStrLn $ usageInfo "uvector-algorithms-bench" options+ (_, _, errs) -> putStrLn $ usageInfo (concat errs) options++
+ bench/RadSieve.hs view
@@ -0,0 +1,97 @@+-- ------------------------------------------------------------------+--+-- Module : RadSieve+-- Copyright : (c) 2009 Dan Doel+--+-- ------------------------------------------------------------------+-- An implementation of a radical sieve, inspired by solving Project+-- Euler problem #124.+--+-- Reproduction fo the problem text:+--+-- The radical of n, rad(n), is the product of distinct prime factors+-- of n. For example, 504 = 23 × 32 × 7, so rad(504) = 2 × 3 × 7 = 42.+--+-- If we calculate rad(n) for 1 ≤ n ≤ 10, then sort them on rad(n),+-- and sorting on n if the radical values are equal, we get:+--+-- Unsorted Sorted+-- n rad(n) n rad(n) k+-- 1 1 1 1 1+-- 2 2 2 2 2+-- 3 3 4 2 3+-- 4 2 8 2 4+-- 5 5 3 3 5+-- 6 6 9 3 6+-- 7 7 5 5 7+-- 8 2 6 6 8+-- 9 3 7 7 9+-- 10 10 10 10 10+--+-- Let E(k) be the kth element in the sorted n column; for example,+-- E(4) = 8 and E(6) = 9.+--+-- If rad(n) is sorted for 1 ≤ n ≤ 100000, find E(10000).++module RadSieve where++import Control.Monad+import Control.Monad.ST++import Data.Array.Vector++-- Radicals can be sieved as follows:+-- set a[1,n] = 1+-- for i from 2 to n+-- if a[i] == 1 -- i must be prime+-- then a[j*i] *= i for positive integers j, j*i <= n+-- else do nothing -- i is composite, so its prime factors+-- -- have been accounted for+--+-- This sieves for radicals up to the given integer.+radSieve :: Int -> ST s (MUArr Int s)+radSieve n = do arr <- newMU (n + 1)+ fill arr n+ sieve arr 1+ return arr+ where+ fill arr i | i < 0 = return ()+ | otherwise = writeMU arr i 1 >> fill arr (i-1)+ sieve arr i | n < i = return ()+ | otherwise = do e <- readMU arr i+ when (e == 1) $ mark arr i i+ sieve arr (i+1)+ mark arr p j | n < j = return ()+ | otherwise = readMU arr j >>= writeMU arr j . (*p)+ >> mark arr p (j+p)++-- Computes the answer to the above Project Euler problem. The correct+-- answer is only generated for a stable sorting function.+stableSortedRad :: Int -> Int+ -> (forall s e. UA e => Comparison e -> MUArr e s -> ST s ()) + -> Int+stableSortedRad n k sortBy = runST (do rads <- radSieve n+ index <- newMU (n + 1)+ fillUp index n+ sortBy (comparing fstS)+ (unsafeZipMU rads index)+ readMU k index)+ where+ fillUp arr k | k < 0 = return ()+ | otherwise = writeMU arr k k >> fillUp arr (k-1)++-- Computes the answer to the above Project Euler problem. This version+-- will generate the correct answer even for unstable sorts, but may be+-- marginally slower.+unstableSortedRad :: Int -> Int+ -> (forall s e. UA e => Comparison e -> MUArr e s -> ST s ()) + -> Int+unstableSortedRad n k sortBy = runST (do rads <- radSieve n+ index <- newMU (n + 1)+ fillUp index n+ sortBy compare (unsafeZipMU rads index)+ readMU k index)+ where+ fillUp arr k | k < 0 = return ()+ | otherwise = writeMU arr k k >> fillUp arr (k-1)+
+ bench/uvector-algorithms-bench.cabal view
@@ -0,0 +1,22 @@+name: uvector-algorithms-bench+version: 0.2+license: BSD3+license-file: LICENSE+author: Dan Doel+maintainer: Dan Doel <dan.doel@gmail.com>+homepage: http://code.haskell.org/~doio/+category: Benchmark+synopsis: Benchmarks for uvector-algorithms+description: A suite of various benchmarks for verifying the+ performance of the algorithms in uvector-algorithms.+build-type: Simple+cabal-version: >= 1.2++executable uvec-bench+ build-depends: base, mersenne-random, uvector, uvector-algorithms, mtl++ ghc-options: -Wall -O2+ main-is: Main.hs++ extensions:+ Rank2Types
+ tests/Optimal.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE TypeOperators #-}++-- Exhaustive test sets for proper sorting and stability of+-- optimal sorts++module Optimal where++import Control.Arrow+import Control.Monad++import Data.List+import Data.Function++import Data.Array.Vector++interleavings :: [a] -> [a] -> [[a]]+interleavings [ ] ys = [ys]+interleavings xs [ ] = [xs]+interleavings xs@(x:xt) ys@(y:yt) = map (x:) (interleavings xt ys)+ ++ map (y:) (interleavings xs yt)++zipS [ ] _ = []+zipS _ [ ] = []+zipS (x:xs) (y:ys) = (x:*:y) : zipS xs ys++monotones :: Int -> Int -> [[Int]]+monotones k = atLeastOne 0+ where+ atLeastOne i 0 = [[]]+ atLeastOne i n = map (i:) $ picks i (n-1)+ picks _ 0 = [[]]+ picks i n | i >= k = [replicate n k]+ | otherwise = map (i:) (picks i (n-1)) ++ atLeastOne (i+1) n+++stability :: Int -> [UArr (Int :*: Int)]+stability n = concatMap ( map toU+ . foldM interleavings []+ . groupBy ((==) `on` fstS)+ . flip zipS [0..])+ $ monotones (n-2) n++sort2 :: [UArr Int]+sort2 = map toU $ permutations [0,1]++stability2 :: [UArr (Int :*: Int)]+stability2 = [toU [0 :*: 0, 0 :*: 1]]++sort3 :: [UArr Int]+sort3 = map toU $ permutations [0..2]++{-+stability3 :: [UArr (Int :*: Int)]+stability3 = map toU [ [0:*:0, 0:*:1, 0:*:2]+ , [0:*:0, 0:*:1, 1:*:2]+ , [0:*:0, 1:*:2, 0:*:1]+ , [1:*:2, 0:*:0, 0:*:1]+ , [0:*:0, 1:*:1, 1:*:2]+ , [1:*:1, 0:*:0, 1:*:2]+ , [1:*:1, 1:*:2, 0:*:0]+ ]+-}++sort4 :: [UArr Int]+sort4 = map toU $ permutations [0..3]+
+ tests/Properties.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE RankNTypes #-}++module Properties where++import Optimal++import Control.Monad+import Control.Monad.ST++import Data.List+import Data.Ord++import Data.Array.Vector++import Data.Array.Vector.Algorithms.Optimal (Comparison)+import Data.Array.Vector.Algorithms.Radix+import Data.Array.Vector.Algorithms.Combinators++import qualified Data.Map as M++import Test.QuickCheck++import Util++prop_sorted :: (UA e, Ord e) => UArr e -> Property+prop_sorted arr | lengthU arr < 2 = property True+ | otherwise = check (headU arr) (tailU arr)+ where+ check e arr | nullU arr = property True+ | otherwise = e <= headU arr .&. check (headU arr) (tailU arr)++prop_fullsort :: (UA e, Ord e)+ => (forall s. MUArr e s -> ST s ()) -> UArr e -> Property+prop_fullsort algo arr = prop_sorted $ apply algo arr++prop_schwartzian :: (UA e, UA k, Ord k)+ => (e -> k)+ -> (forall e s. (UA e) => (e -> e -> Ordering) -> MUArr e s -> ST s ())+ -> UArr e -> Property+prop_schwartzian f algo arr+ | lengthU arr < 2 = property True+ | otherwise = let srt = apply (algo `usingKeys` f) arr+ in check (headU srt) (tailU srt)+ where+ check e arr | nullU arr = property True+ | otherwise = f e <= f (headU arr) .&. check (headU arr) (tailU arr)++longGen :: (UA e, Arbitrary e) => Int -> Gen (UArr e)+longGen k = liftM2 (\l r -> toU (l ++ r)) (vectorOf k arbitrary) arbitrary++sanity :: Int+sanity = 100++prop_partialsort :: (UA e, Ord e, Arbitrary e, Show e)+ => (forall s. MUArr e s -> Int -> ST s ())+ -> Positive Int -> Property+prop_partialsort = prop_sized $ \algo k ->+ prop_sorted . takeU k . apply algo++prop_select :: (UA e, Ord e, Arbitrary e, Show e)+ => (forall s. MUArr e s -> Int -> ST s ())+ -> Positive Int -> Property+prop_select = prop_sized $ \algo k arr ->+ let (l, r) = splitAtU k $ apply algo arr+ in allU (\e -> allU (e <=) r) l++prop_sized :: (UA e, Arbitrary e, Show e, Testable prop)+ => ((forall s. MUArr e s -> ST s ()) -> Int -> UArr e -> prop)+ -> (forall s. MUArr e s -> Int -> ST s ())+ -> Positive Int -> Property+prop_sized prop algo (Positive k) =+ let k' = k `mod` sanity+ in forAll (longGen k') $ prop (\marr -> algo marr k') k'++prop_stable :: (forall e s. (UA e) => Comparison e -> MUArr e s -> ST s ())+ -> UArr Int -> Property+-- prop_stable algo arr = property $ apply algo arr == arr+prop_stable algo arr = stable $ apply (algo (comparing fstS)) $ zipU arr ix+ where+ ix = toU [1 .. lengthU arr]++stable arr | nullU arr = property True+ | otherwise = let e :*: i = headU arr+ in allU (\(e' :*: i') -> e < e' || i < i') (tailU arr)+ .&. stable (tailU arr)++prop_stable_radix :: (forall e s. UA e => + Int -> Int -> (Int -> e -> Int) -> MUArr e s -> ST s ())+ -> UArr Int -> Property+prop_stable_radix algo arr =+ stable . apply (algo (passes e) (size e) (\k (e :*: _) -> radix k e))+ $ zipU arr ix+ where+ ix = toU [1 .. lengthU arr]+ e = headU arr+ +prop_optimal :: Int+ -> (forall e s. (UA e) => Comparison e -> MUArr e s -> Int -> ST s ())+ -> Property+prop_optimal n algo = label "sorting" sortn .&. label "stability" stabn+ where+ arrn = toU [0..n-1]+ sortn = all ( (== arrn)+ . apply (\a -> algo compare a 0)+ . toU)+ $ permutations [0..n-1]+ stabn = all ( (== arrn)+ . sndS+ . unzipU+ . apply (\a -> algo (comparing fstS) a 0))+ $ stability n++type Bag e = M.Map e Int++toBag :: (UA e, Ord e) => UArr e -> Bag e+toBag = M.fromListWith (+) . flip zip (repeat 1) . fromU++prop_permutation :: (UA e, Ord e)+ => (forall s. MUArr e s -> ST s ())+ -> UArr e -> Property+prop_permutation algo arr = property $ + toBag arr == toBag (apply algo arr)
+ tests/Tests.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE ImpredicativeTypes, RankNTypes, TypeOperators #-}++module Main (main) where++import Properties++import Util++import Test.QuickCheck++import Control.Monad+import Control.Monad.ST++import Data.Int+import Data.Word++import Data.Array.Vector++import Data.Array.Vector.Algorithms.Combinators++import qualified Data.Array.Vector.Algorithms.Insertion as INS+import qualified Data.Array.Vector.Algorithms.Intro as INT+import qualified Data.Array.Vector.Algorithms.Merge as M+import qualified Data.Array.Vector.Algorithms.Radix as R+import qualified Data.Array.Vector.Algorithms.TriHeap as TH+import qualified Data.Array.Vector.Algorithms.Optimal as O++type Algo e = forall s. MUArr e s -> ST s ()+type SizeAlgo e = forall s. MUArr e s -> Int -> ST s ()++args = stdArgs+ { maxSuccess = 300+ , maxDiscard = 200+ }++check_Int_sort = forM_ algos $ \(name,algo) ->+ quickCheckWith args (label name . prop_fullsort algo)+ where+ algos :: [(String, Algo Int)]+ algos = [ ("introsort", INT.sort)+ , ("insertion sort", INS.sort)+ , ("merge sort", M.sort)+ , ("tri-heapsort", TH.sort)+ ]++check_Int_partialsort = forM_ algos $ \(name,algo) ->+ quickCheckWith args (label name . prop_partialsort algo)+ where+ algos :: [(String, SizeAlgo Int)]+ algos = [ ("intro-partialsort", INT.partialSort)+ , ("tri-heap partialsort", TH.partialSort)+ ]++check_Int_select = forM_ algos $ \(name,algo) ->+ quickCheckWith args (label name . prop_select algo)+ where+ algos :: [(String, SizeAlgo Int)]+ algos = [ ("intro-select", INT.select)+ , ("tri-heap select", TH.select)+ ]++check_radix_sorts = do+ qc (label "Word8" . prop_fullsort (R.sort :: Algo Word8))+ qc (label "Word16" . prop_fullsort (R.sort :: Algo Word16))+ qc (label "Word32" . prop_fullsort (R.sort :: Algo Word32))+ qc (label "Word64" . prop_fullsort (R.sort :: Algo Word64))+ qc (label "Word" . prop_fullsort (R.sort :: Algo Word))+ qc (label "Int8" . prop_fullsort (R.sort :: Algo Int8))+ qc (label "Int16" . prop_fullsort (R.sort :: Algo Int16))+ qc (label "Int32" . prop_fullsort (R.sort :: Algo Int32))+ qc (label "Int64" . prop_fullsort (R.sort :: Algo Int64))+ qc (label "Int" . prop_fullsort (R.sort :: Algo Int))+ qc (label "Int :*: Int" . prop_fullsort (R.sort :: Algo (Int :*: Int)))+ where+ qc algo = quickCheckWith args algo++check_schwartzian = do+ quickCheckWith args (prop_schwartzian i2w INS.sortBy)+ where+ i2w :: Int -> Word+ i2w = fromIntegral++check_stable = do quickCheckWith args (label "merge sort" . prop_stable M.sortBy)+ quickCheckWith args (label "radix sort" . prop_stable_radix R.sortBy)++check_optimal = do qc . label "size 2" $ prop_optimal 2 O.sort2ByOffset+ qc . label "size 3" $ prop_optimal 3 O.sort3ByOffset+ qc . label "size 4" $ prop_optimal 4 O.sort4ByOffset+ where+ qc = quickCheck++check_permutation = do+ qc $ label "introsort" . prop_permutation (INT.sort :: Algo Int)+ qc $ label "intropartial" . prop_sized (const . prop_permutation)+ (INT.partialSort :: SizeAlgo Int)+ qc $ label "introselect" . prop_sized (const . prop_permutation)+ (INT.select :: SizeAlgo Int)+ qc $ label "heapsort" . prop_permutation (TH.sort :: Algo Int)+ qc $ label "heappartial" . prop_sized (const . prop_permutation)+ (TH.partialSort :: SizeAlgo Int)+ qc $ label "heapselect" . prop_sized (const . prop_permutation)+ (TH.select :: SizeAlgo Int)+ qc $ label "mergesort" . prop_permutation (M.sort :: Algo Int)+ qc $ label "radix I8" . prop_permutation (R.sort :: Algo Int8)+ qc $ label "radix I16" . prop_permutation (R.sort :: Algo Int16)+ qc $ label "radix I32" . prop_permutation (R.sort :: Algo Int32)+ qc $ label "radix I64" . prop_permutation (R.sort :: Algo Int64)+ qc $ label "radix Int" . prop_permutation (R.sort :: Algo Int)+ qc $ label "radix W8" . prop_permutation (R.sort :: Algo Word8)+ qc $ label "radix W16" . prop_permutation (R.sort :: Algo Word16)+ qc $ label "radix W32" . prop_permutation (R.sort :: Algo Word32)+ qc $ label "radix W64" . prop_permutation (R.sort :: Algo Word64)+ qc $ label "radix Word" . prop_permutation (R.sort :: Algo Word)+ where+ qc prop = quickCheckWith args prop+++main = do putStrLn "Int tests:"+ check_Int_sort+ check_Int_partialsort+ check_Int_select+ putStrLn "Radix sort tests:"+ check_radix_sorts+ putStrLn "Schwartzian transform (Int -> Word):"+ check_schwartzian+ putStrLn "Stability:"+ check_stable+ putStrLn "Optimals:"+ check_optimal+ putStrLn "Permutation:"+ check_permutation
+ tests/Util.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE TypeOperators #-}++module Util where++import Control.Monad++import Data.Word+import Data.Int++import Data.Array.Vector++import Test.QuickCheck+++instance (Arbitrary e, UA e) => Arbitrary (UArr e) where+ arbitrary = fmap toU arbitrary++instance (Arbitrary a, Arbitrary b) => Arbitrary (a :*: b) where+ arbitrary = (:*:) `fmap` arbitrary `ap` arbitrary++instance Arbitrary Int8 where+ arbitrary = fromInteger `fmap` arbitrary++instance Arbitrary Int16 where+ arbitrary = fromInteger `fmap` arbitrary++instance Arbitrary Int32 where+ arbitrary = fromInteger `fmap` arbitrary++instance Arbitrary Int64 where+ arbitrary = fromInteger `fmap` arbitrary++instance Arbitrary Word8 where+ arbitrary = fromInteger `fmap` arbitrary++instance Arbitrary Word16 where+ arbitrary = fromInteger `fmap` arbitrary++instance Arbitrary Word32 where+ arbitrary = fromInteger `fmap` arbitrary++instance Arbitrary Word64 where+ arbitrary = fromInteger `fmap` arbitrary++instance Arbitrary Word where+ arbitrary = fromInteger `fmap` arbitrary
uvector-algorithms.cabal view
@@ -1,5 +1,5 @@ Name: uvector-algorithms-Version: 0.1.1+Version: 0.2 License: BSD3 License-File: LICENSE Author: Dan Doel@@ -11,13 +11,13 @@ be sure to compile with -O2, and -fvia-C -optc-O3 is recommended. Build-Type: Simple-Cabal-Version: >= 1.2+Cabal-Version: >= 1.2.3 Library- Build-Depends: base, uvector+ Build-Depends: base >= 3 && < 5, uvector >= 0.1.0.4 Exposed-Modules:- Data.Array.Vector.Algorithms.Immutable+ Data.Array.Vector.Algorithms.Combinators Data.Array.Vector.Algorithms.Optimal Data.Array.Vector.Algorithms.Insertion Data.Array.Vector.Algorithms.Intro@@ -36,5 +36,4 @@ GHC-Options: -O2- -fvia-C -optc-O3 -funbox-strict-fields