Repository : ssh://darcs.haskell.org//srv/darcs/packages/dph On branch : master
http://hackage.haskell.org/trac/ghc/changeset/da6f9604f0c266672322a6e6706d146d54f49da9 >--------------------------------------------------------------- commit da6f9604f0c266672322a6e6706d146d54f49da9 Author: George Roldugin <[email protected]> Date: Tue May 17 02:35:52 2011 +1000 Add quickcheck tests for permutes. >--------------------------------------------------------------- examples/quickcheck/Testsuite/Utils.hs | 37 ++++++++++++++++++++++-- examples/quickcheck/tests/Unlifted_Permutes.hs | 37 ++++++++++++++++++++++++ 2 files changed, 71 insertions(+), 3 deletions(-) diff --git a/examples/quickcheck/Testsuite/Utils.hs b/examples/quickcheck/Testsuite/Utils.hs index c9e2fab..50ef342 100644 --- a/examples/quickcheck/Testsuite/Utils.hs +++ b/examples/quickcheck/Testsuite/Utils.hs @@ -1,5 +1,5 @@ module Testsuite.Utils ( - Len(..) + Len(..), Perm(..), BPerm(..), DftPerm(..) --gvector, gdist, gtype, vtype ) where @@ -9,14 +9,25 @@ import Test.QuickCheck.Batch import Text.Show.Functions -import Data.Array.Parallel.Unlifted +import Data.Array.Parallel.Unlifted as U import Data.Char +import Data.List ( permutations ) import Control.Monad (liftM) +import Prelude as P -- infix 4 === -newtype Len = Len Int deriving(Eq,Ord,Enum,Show,Num) +newtype Len = Len Int deriving (Eq,Ord,Enum,Show,Num) + +-- permutation of [0..n-1] with all values appearing exactly once +newtype Perm = Perm (Array Int) deriving (Eq,Show) + +-- array of elements taken from [0..n-1] +newtype BPerm = BPerm (Array Int) deriving (Eq,Show) + +-- array of index-value pairs with indices taken from [0..n-1] +newtype DftPerm a = DftPerm (Array (Int, a)) deriving (Eq, Show) instance Arbitrary Char where arbitrary = fmap chr . sized $ \n -> choose (0,n) @@ -32,6 +43,21 @@ instance Arbitrary Len where arbitrary = sized $ \n -> Len `fmap` choose (0,n) coarbitrary (Len n) = coarbitrary n +instance Arbitrary Perm where + arbitrary = Perm `fmap` (sized $ \n -> elements $ P.map fromList (permutations [0..n-1])) + coarbitrary = \(Perm arr) -> coarbitrary (toList arr) + +instance Arbitrary BPerm where + arbitrary = sized $ \n -> (BPerm . fromList . P.map (`mod` n)) `fmap` enlarge n arbitrary + coarbitrary = \(BPerm arr) -> coarbitrary (toList arr) + +instance (Elt a, Arbitrary a) => Arbitrary (DftPerm a) where + arbitrary = do + BPerm idxs <- arbitrary -- :: Gen BPerm + vals <- sized $ \n -> enlarge n arbitrary -- :: Gen (Array a) + return $ DftPerm (U.zip idxs vals) + coarbitrary = \(DftPerm arr) -> coarbitrary (toList arr) + {- instance Arbitrary a => Arbitrary (MaybeS a) where arbitrary = frequency [(1, return NothingS), (3, liftM JustS arbitrary)] @@ -53,6 +79,11 @@ instance Arbitrary Gang where coarbitrary = coarbitrary . gangSize -} +-- wrapper to Test.QuickCheck.resize facilitating the generation of +-- longer permutations while keeping indices within bounds +enlarge n = resize $ case n of 0 -> 0 -- potential corner cases + 1 -> 1 -- these too + n -> 2*n {- gvector :: Arbitrary a => Gang -> Gen [a] gvector = vector . gangSize diff --git a/examples/quickcheck/tests/Unlifted_Permutes.hs b/examples/quickcheck/tests/Unlifted_Permutes.hs new file mode 100644 index 0000000..6037080 --- /dev/null +++ b/examples/quickcheck/tests/Unlifted_Permutes.hs @@ -0,0 +1,37 @@ +import Testsuite + +import Data.Array.Parallel.Unlifted as U +import Prelude as P +import Data.List ( sort ) + +$(testcases [ "" <@ [t| ( Bool, Int ) |] + , "acc" <@ [t| ( Int ) |] + , "num" <@ [t| ( Int ) |] + , "ord" <@ [t| ( Bool, Int ) |] + , "enum" <@ [t| ( Bool, Int ) |] + ] + [d| + prop_permute :: (Elt a, Eq a) => Array a -> Perm -> Property + prop_permute arr (Perm is) = (U.length arr == U.length is) + ==> permute arr is == U.map (arr!:) is + + prop_bpermute :: (Elt a, Eq a) => Array a -> BPerm -> Property + prop_bpermute arr (BPerm is) = + (is == empty) || (maximum $ toList is) < U.length arr + ==> bpermute arr is == U.map (arr!:) is + + prop_mbpermute :: (Elt a, Eq b, Elt b) => (a -> b) -> Array a -> BPerm -> Property + prop_mbpermute f arr (BPerm is) = + (is == empty) || (maximum $ toList is) < U.length arr + ==> mbpermute f arr is == U.map (\i -> f (arr!:i)) is + + prop_bpermuteDft :: (Elt a, Eq a) => Len -> (Int -> a) -> DftPerm a -> Property + prop_bpermuteDft (Len n) init (DftPerm pairs) = + (pairs == empty) || (maximum (toList $ fsts pairs) < n) + ==> toList (bpermuteDft n init pairs) == update (P.map init [0..n-1]) (toList pairs) + where set xs i x = (P.take i xs) ++ [x] ++ (P.drop (i+1) xs) + -- update :: [a] -> [(Int, a)] -> [a] + update xs [] = xs + update xs ((i,x):ps) = update (set xs i x) ps + |]) + _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
