Reorder and complete polymorphic properties
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Wed, 18 Nov 2009 00:28:31 +0000 (00:28 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Wed, 18 Nov 2009 00:28:31 +0000 (00:28 +0000)
tests/Properties.hs
tests/Utilities.hs

index 75cf2db..0e7348c 100644 (file)
@@ -25,7 +25,6 @@ import Data.List           (foldl', foldl1', unfoldr, find, findIndex)
 #define VECTOR_CONTEXT(a, v) \
   Eq (v a), Show (v a), Arbitrary (v a), Model (v a) [a], V.Vector v a
 
-
 -- TODO: implement Vector equivalents of list functions for some of the commented out properties
 
 -- TODO: test and implement some of these other Prelude functions:
@@ -74,61 +73,119 @@ testSanity _ = [
 
 testPolymorphicFunctions :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
 testPolymorphicFunctions _ = $(testProperties [
-        'prop_eq, 'prop_length, 'prop_null, 'prop_reverse,
-        'prop_append, 'prop_concatMap,
-        'prop_empty, 'prop_cons,
-        'prop_head, 'prop_tail, 'prop_init, 'prop_last,
-        'prop_drop, 'prop_dropWhile, 'prop_take, 'prop_takeWhile,
-        'prop_filter, 'prop_map, 'prop_replicate,
-        'prop_zipWith, 'prop_zipWith3,
+        'prop_eq,
+
+        'prop_length, 'prop_null,
+
+        'prop_empty, 'prop_singleton, 'prop_replicate,
+        'prop_cons, 'prop_snoc, 'prop_append, 'prop_copy,
+
+        'prop_head, 'prop_last, 'prop_index,
+
+        'prop_slice, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,
+
+        'prop_accum, 'prop_write, -- 'prop_backpermute,
+        'prop_reverse,
+
+        'prop_map, 'prop_zipWith, 'prop_zipWith3,
+        'prop_filter, 'prop_takeWhile, 'prop_dropWhile,
+
         'prop_elem, 'prop_notElem,
-        'prop_foldr, 'prop_foldl, 'prop_foldr1, 'prop_foldl1,
-        'prop_foldl', 'prop_foldl1',
         'prop_find, 'prop_findIndex,
-        'prop_unfoldr,
-        'prop_singleton, 'prop_snoc
+
+        'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',
+        'prop_foldr, 'prop_foldr1,
+
+        'prop_prescanl, 'prop_prescanl',
+        'prop_postscanl, 'prop_postscanl',
+        'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',
+
+        'prop_concatMap,
+        'prop_unfoldr
     ])
   where
     -- Prelude
     prop_eq           = ((==) :: v a -> v a -> Bool)                  `eq2` (==)
+
     prop_length       = (V.length :: v a -> Int)                      `eq1` length
     prop_null         = (V.null :: v a -> Bool)                       `eq1` null
-    prop_reverse      = (V.reverse :: v a -> v a)                     `eq1` reverse
-    prop_append       = ((V.++) :: v a -> v a -> v a)                 `eq2` (++)
-    prop_concatMap    = (V.concatMap :: (a -> v a) -> v a -> v a)     `eq2` concatMap
+
     prop_empty        = (V.empty :: v a)                              `eq0` []
+    prop_singleton     = (V.singleton :: a -> v a)                    `eq1` singleton
+    prop_replicate    = (V.replicate :: Int -> a -> v a)              `eq2` replicate
     prop_cons         = (V.cons :: a -> v a -> v a)                   `eq2` (:)
-    --prop_index        = compare (V.!) to (!!)
+    prop_snoc         = (V.snoc :: v a -> a -> v a)                   `eq2` snoc
+    prop_append       = ((V.++) :: v a -> v a -> v a)                 `eq2` (++)
+    prop_copy         = (V.copy :: v a -> v a)                        `eq1` id
+
     prop_head         = (V.head :: v a -> a)                          `eqNotNull1` head
+    prop_last         = (V.last :: v a -> a)                          `eqNotNull1` last
+    prop_index        = \xs i -> (i >= 0 && i < V.length xs)
+                          ==> (((V.!) :: v a -> Int -> a) `eq2` (!!)) xs i
+
+
+    prop_slice        = forAll arbitrary                     $ \xs ->
+                        forAll (choose (0, V.length xs))     $ \i ->
+                        forAll (choose (0, V.length xs - i)) $ \n ->
+                        ((V.slice :: v a -> Int -> Int -> v a) `eq3` slice)
+                          xs i n
     prop_tail         = (V.tail :: v a -> v a)                        `eqNotNull1` tail
     prop_init         = (V.init :: v a -> v a)                        `eqNotNull1` init
-    prop_last         = (V.last :: v a -> a)                          `eqNotNull1` last
-    prop_drop         = (V.drop :: Int -> v a -> v a)                 `eq2` drop
-    prop_dropWhile    = (V.dropWhile :: (a -> Bool) -> v a -> v a)    `eq2` dropWhile
     prop_take         = (V.take :: Int -> v a -> v a)                 `eq2` take
-    prop_takeWhile    = (V.takeWhile :: (a -> Bool) -> v a -> v a)    `eq2` takeWhile
-    prop_filter       = (V.filter :: (a -> Bool) -> v a -> v a)       `eq2` filter
+    prop_drop         = (V.drop :: Int -> v a -> v a)                 `eq2` drop
+
+    prop_accum        = forAll arbitrary                         $ \f ->
+                        forAll arbitrary                         $ \xs ->
+                        forAll (index_value_pairs (V.length xs)) $ \ps ->
+                        ((V.accum :: (a -> a -> a) -> v a -> [(Int,a)] -> v a)
+                         `eq3` accum) f xs ps
+    prop_write        = forAll arbitrary                         $ \xs ->
+                        forAll (index_value_pairs (V.length xs)) $ \ps ->
+                        (((V.//) :: v a -> [(Int,a)] -> v a) `eq2` (//)) xs ps
+    -- prop_backpermute  = forAll arbitrary                         $ \xs ->
+    --                     forAll (indices (V.length xs))           $ \is ->
+    --                     ((V.backpermute :: v a -> v Int -> v a) `eq2` backpermute)
+    --                             xs is
+    prop_reverse      = (V.reverse :: v a -> v a)                     `eq1` reverse
+
     prop_map          = (V.map :: (a -> a) -> v a -> v a)             `eq2` map
-    prop_replicate    = (V.replicate :: Int -> a -> v a)              `eq2` replicate
     prop_zipWith      = (V.zipWith :: (a -> a -> a) -> v a -> v a -> v a) `eq3` zipWith
     prop_zipWith3     = (V.zipWith3 :: (a -> a -> a -> a) -> v a -> v a -> v a -> v a) `eq4` zipWith3
-    --prop_span         = (V.span :: (a -> Bool) -> v a -> (v a, v a))  `eq2` span
-    --prop_break        = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break
-    --prop_splitAt      = (V.splitAt :: Int -> v a -> (v a, v a))       `eq2` splitAt
+
+    prop_filter       = (V.filter :: (a -> Bool) -> v a -> v a)       `eq2` filter
+    prop_takeWhile    = (V.takeWhile :: (a -> Bool) -> v a -> v a)    `eq2` takeWhile
+    prop_dropWhile    = (V.dropWhile :: (a -> Bool) -> v a -> v a)    `eq2` dropWhile
+
     prop_elem         = (V.elem :: a -> v a -> Bool)                  `eq2` elem
     prop_notElem      = (V.notElem :: a -> v a -> Bool)               `eq2` notElem
-    prop_foldr        = (V.foldr :: (a -> a -> a) -> a -> v a -> a)   `eq3` foldr
+    prop_find         = (V.find :: (a -> Bool) -> v a -> Maybe a)        `eq2` find
+    prop_findIndex    = (V.findIndex :: (a -> Bool) -> v a -> Maybe Int) `eq2` findIndex
+
     prop_foldl        = (V.foldl :: (a -> a -> a) -> a -> v a -> a)   `eq3` foldl
-    prop_foldr1       = (V.foldr1 :: (a -> a -> a) -> v a -> a)       `eqNotNull2` foldr1
     prop_foldl1       = (V.foldl1 :: (a -> a -> a) -> v a -> a)       `eqNotNull2` foldl1
+    prop_foldl'       = (V.foldl' :: (a -> a -> a) -> a -> v a -> a)     `eq3` foldl'
+    prop_foldl1'      = (V.foldl1' :: (a -> a -> a) -> v a -> a)         `eqNotNull2` foldl1'
+    prop_foldr        = (V.foldr :: (a -> a -> a) -> a -> v a -> a)   `eq3` foldr
+    prop_foldr1       = (V.foldr1 :: (a -> a -> a) -> v a -> a)       `eqNotNull2` foldr1
+
+    prop_prescanl     = (V.prescanl :: (a -> a -> a) -> a -> v a -> v a) `eq3` prescanl
+    prop_prescanl'    = (V.prescanl' :: (a -> a -> a) -> a -> v a -> v a) `eq3` prescanl
+    prop_postscanl    = (V.postscanl :: (a -> a -> a) -> a -> v a -> v a) `eq3` postscanl
+    prop_postscanl'   = (V.postscanl' :: (a -> a -> a) -> a -> v a -> v a) `eq3` postscanl
+    prop_scanl        = (V.scanl :: (a -> a -> a) -> a -> v a -> v a) `eq3` scanl
+    prop_scanl'       = (V.scanl' :: (a -> a -> a) -> a -> v a -> v a) `eq3` scanl
+    prop_scanl1       = (V.scanl1 :: (a -> a -> a) -> v a -> v a)     `eqNotNull2` scanl1
+    prop_scanl1'      = (V.scanl1' :: (a -> a -> a) -> v a -> v a)    `eqNotNull2` scanl1
+    prop_concatMap    = (V.concatMap :: (a -> v a) -> v a -> v a)     `eq2` concatMap
+
+    --prop_span         = (V.span :: (a -> Bool) -> v a -> (v a, v a))  `eq2` span
+    --prop_break        = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break
+    --prop_splitAt      = (V.splitAt :: Int -> v a -> (v a, v a))       `eq2` splitAt
     --prop_all          = (V.all :: (a -> Bool) -> v a -> Bool)         `eq2` all
     --prop_any          = (V.any :: (a -> Bool) -> v a -> Bool)         `eq2` any
 
     -- Data.List
-    prop_foldl'       = (V.foldl' :: (a -> a -> a) -> a -> v a -> a)     `eq3` foldl'
-    prop_foldl1'      = (V.foldl1' :: (a -> a -> a) -> v a -> a)         `eqNotNull2` foldl1'
-    prop_find         = (V.find :: (a -> Bool) -> v a -> Maybe a)        `eq2` find
-    prop_findIndex    = (V.findIndex :: (a -> Bool) -> v a -> Maybe Int) `eq2` findIndex
     --prop_findIndices  = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int)
     --prop_isPrefixOf   = V.isPrefixOf  `eq2` (isPrefixOf  :: v a -> v a -> Bool)
     --prop_elemIndex    = V.elemIndex   `eq2` (elemIndex   :: a -> v a -> Maybe Int)
@@ -150,12 +207,6 @@ testPolymorphicFunctions _ = $(testProperties [
     prop_unfoldr      = ((\n f a -> V.unfoldr (limitUnfolds f) (a, n)) :: Int -> ((Int, Int) -> Maybe (a, (Int, Int))) -> (Int, Int) -> v a)
                         `eq3` (\n f a -> unfoldr (limitUnfolds f) (a, n))
 
-    -- Extras
-    singleton x = [x]
-    prop_singleton = (V.singleton :: a -> v a) `eq1` singleton
-    
-    snoc xs x = xs ++ [x]
-    prop_snoc = (V.snoc :: v a -> a -> v a) `eq2` snoc
 
 testTuplyFunctions:: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT((a, a), v), VECTOR_CONTEXT((a, a, a), v)) => v a -> [Test]
 testTuplyFunctions _ = $(testProperties ['prop_zip, 'prop_zip3, 'prop_unzip, 'prop_unzip3])
index cec38da..2a8ab5f 100644 (file)
@@ -7,6 +7,8 @@ import qualified Data.Vector.Generic as DVG
 import qualified Data.Vector.Primitive as DVP
 import qualified Data.Vector.Fusion.Stream as S
 
+import Data.List ( sortBy )
+
 
 instance Show a => Show (S.Stream a) where
     show s = "Data.Vector.Fusion.Stream.fromList " ++ show (S.toList s)
@@ -43,6 +45,7 @@ instance Model Ordering Ordering where model = id
 -- Functorish models
 -- All of these need UndecidableInstances although they are actually well founded. Oh well.
 instance Model a b                            => Model (Maybe a) (Maybe b)    where model           = fmap model
+instance Model a b                            => Model [a] [b]                where model           = fmap model
 instance (Model a a', Model b b')             => Model (a, b) (a', b')        where model (a, b)    = (model a, model b)
 instance (Model a a', Model b b', Model c c') => Model (a, b, c) (a', b', c') where model (a, b, c) = (model a, model b, model c)
 instance (Model c a, Model b d)               => Model (a -> b) (c -> d)      where model f         = model . f . model
@@ -58,3 +61,50 @@ eqNotNull1 f g = \a       -> (not (DVG.null a)) ==> eq1 f g a
 eqNotNull2 f g = \a b     -> (not (DVG.null b)) ==> eq2 f g a b
 eqNotNull3 f g = \a b c   -> (not (DVG.null c)) ==> eq3 f g a b c
 eqNotNull4 f g = \a b c d -> (not (DVG.null d)) ==> eq4 f g a b c d
+
+-- Generators
+index_value_pairs :: Arbitrary a => Int -> Gen [(Int,a)]
+index_value_pairs 0 = return [] 
+index_value_pairs m = sized $ \n ->
+  do
+    len <- choose (0,n)
+    is <- sequence [choose (0,m-1) | i <- [1..len]]
+    xs <- vector len
+    return $ zip is xs
+
+indices :: Int -> Gen [Int]
+indices 0 = return []
+indices m = sized $ \n ->
+  do
+    len <- choose (0,n)
+    sequence [choose (0,m-1) | i <- [1..len]]
+
+
+-- Additional list functions
+singleton x = [x]
+snoc xs x = xs ++ [x]
+slice xs i n = take n (drop i xs)
+backpermute xs is = map (xs!!) is
+prescanl f z = init . scanl f z
+postscanl f z = tail . scanl f z
+
+accum :: (a -> b -> a) -> [a] -> [(Int,b)] -> [a]
+accum f xs ps = go xs ps' 0
+  where
+    ps' = sortBy (\p q -> compare (fst p) (fst q)) ps
+
+    go (x:xs) ((i,y) : ps) j
+      | i == j     = go (f x y : xs) ps j
+    go (x:xs) ps j = x : go xs ps (j+1)
+    go [] _ _      = []  
+
+(//) :: [a] -> [(Int, a)] -> [a]
+xs // ps = go xs ps' 0
+  where
+    ps' = sortBy (\p q -> compare (fst p) (fst q)) ps
+
+    go (x:xs) ((i,y) : ps) j
+      | i == j     = go (y:xs) ps j
+    go (x:xs) ps j = x : go xs ps (j+1)
+    go [] _ _      = []
+