Implement and test zipWith3, zip3, unzip, unzip3
authorMax Bolingbroke <batterseapower@hotmail.com>
Tue, 10 Feb 2009 00:39:03 +0000 (00:39 +0000)
committerMax Bolingbroke <batterseapower@hotmail.com>
Tue, 10 Feb 2009 00:39:03 +0000 (00:39 +0000)
Data/Vector/Fusion/Stream.hs
Data/Vector/Fusion/Stream/Monadic.hs
Data/Vector/IVector.hs
tests/Properties.hs
tests/Utilities.hs

index 62070ef..b10b78c 100644 (file)
@@ -33,8 +33,11 @@ module Data.Vector.Fusion.Stream (
   -- * Substreams
   extract, init, tail, take, drop,
 
-  -- * Mapping and zipping
-  map, zipWith,
+  -- * Mapping
+  map, concatMap,
+  
+  -- * Zipping
+  zipWith, zipWith3,
 
   -- * Filtering
   filter, takeWhile, dropWhile,
@@ -46,7 +49,7 @@ module Data.Vector.Fusion.Stream (
   foldl, foldl1, foldl', foldl1', foldr, foldr1,
 
   -- * Specialised folds
-  and, or, concatMap,
+  and, or,
 
   -- * Unfolding
   unfoldr,
@@ -69,11 +72,12 @@ import Prelude hiding ( length, null,
                         replicate, (++),
                         head, last, (!!),
                         init, tail, take, drop,
-                        map, zipWith,
+                        map, concatMap,
+                        zipWith, zipWith3,
                         filter, takeWhile, dropWhile,
                         elem, notElem,
                         foldl, foldl1, foldr, foldr1,
-                        and, or, concatMap,
+                        and, or,
                         mapM_ )
 
 
@@ -203,7 +207,7 @@ drop :: Int -> Stream a -> Stream a
 {-# INLINE drop #-}
 drop = M.drop
 
--- Mapping/zipping
+-- Mapping
 -- ---------------
 
 -- | Map a function over a 'Stream'
@@ -211,11 +215,23 @@ map :: (a -> b) -> Stream a -> Stream b
 {-# INLINE map #-}
 map = M.map
 
+concatMap :: (a -> Stream b) -> Stream a -> Stream b
+{-# INLINE concatMap #-}
+concatMap = M.concatMap
+
+-- Zipping
+-- -------
+
 -- | Zip two 'Stream's with the given function
 zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c
 {-# INLINE zipWith #-}
 zipWith = M.zipWith
 
+-- | Zip three 'Stream's with the given function
+zipWith3 :: (a -> b -> c -> d) -> Stream a -> Stream b -> Stream c -> Stream d
+{-# INLINE zipWith3 #-}
+zipWith3 = M.zipWith3
+
 -- Filtering
 -- ---------
 
@@ -305,10 +321,6 @@ or :: Stream Bool -> Bool
 {-# INLINE or #-}
 or = unId . M.or
 
-concatMap :: (a -> Stream b) -> Stream a -> Stream b
-{-# INLINE concatMap #-}
-concatMap = M.concatMap
-
 -- Unfolding
 -- ---------
 
index b76eb6d..a04a001 100644 (file)
@@ -32,8 +32,11 @@ module Data.Vector.Fusion.Stream.Monadic (
   -- * Substreams
   extract, init, tail, take, drop,
 
-  -- * Mapping and zipping
-  map, mapM, mapM_, zipWith, zipWithM,
+  -- * Mapping
+  map, mapM, mapM_, concatMap,
+  
+  -- * Zipping
+  zipWith, zipWithM, zipWith3, zipWith3M,
 
   -- * Filtering
   filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM,
@@ -47,7 +50,7 @@ module Data.Vector.Fusion.Stream.Monadic (
   foldr, foldrM, foldr1, foldr1M,
 
   -- * Specialised folds
-  and, or, concatMap, concatMapM,
+  and, or, concatMapM,
 
   -- * Unfolding
   unfoldr, unfoldrM,
@@ -66,11 +69,12 @@ import Prelude hiding ( length, null,
                         replicate, (++),
                         head, last, (!!),
                         init, tail, take, drop,
-                        map, mapM, mapM_, zipWith,
+                        map, mapM, mapM_, concatMap,
+                        zipWith, zipWith3,
                         filter, takeWhile, dropWhile,
                         elem, notElem,
                         foldl, foldl1, foldr, foldr1,
-                        and, or, concatMap )
+                        and, or )
 import qualified Prelude
 
 -- | Result of taking a single step in a stream
@@ -295,8 +299,8 @@ drop n (Stream step s sz) = Stream step' (s, Just n) (sz - Exact n)
                            ) (step s)
                      
 
--- Mapping/zipping
--- ---------------
+-- Mapping
+-- -------
 
 instance Monad m => Functor (Stream m) where
   {-# INLINE fmap #-}
@@ -332,6 +336,9 @@ mapM_ m (Stream step s _) = mapM_go s
                     Skip    s' -> mapM_go s'
                     Done       -> return ()
 
+-- Zipping
+-- -------
+
 -- | Zip two 'Stream's with the given function
 zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
 {-# INLINE zipWith #-}
@@ -361,6 +368,39 @@ zipWithM f (Stream stepa sa na) (Stream stepb sb nb)
                                  Skip    sb' -> return $ Skip (sa, sb', Just x)
                                  Done        -> return $ Done
 
+-- | Zip three 'Stream's with the given function
+zipWith3 :: Monad m => (a -> b -> c -> d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d
+{-# INLINE zipWith3 #-}
+zipWith3 f = zipWith3M (\a b c -> return (f a b c))
+
+-- | Zip three 'Stream's with the given monadic function
+zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d
+{-# INLINE_STREAM zipWith3M #-}
+zipWith3M f (Stream stepa sa na) (Stream stepb sb nb) (Stream stepc sc nc)
+  = Stream step (sa, sb, sc, Nothing) (smaller na (smaller nb nc))
+  where
+    {-# INLINE step #-}
+    step (sa, sb, sc, Nothing) = do
+        r <- stepa sa
+        return $ case r of
+            Yield x sa' -> Skip (sa', sb, sc, Just (x, Nothing))
+            Skip    sa' -> Skip (sa', sb, sc, Nothing)
+            Done        -> Done
+
+    step (sa, sb, sc, Just (x, Nothing)) = do
+        r <- stepb sb
+        return $ case r of
+            Yield y sb' -> Skip (sa, sb', sc, Just (x, Just y))
+            Skip    sb' -> Skip (sa, sb', sc, Just (x, Nothing))
+            Done        -> Done
+
+    step (sa, sb, sc, Just (x, Just y)) = do
+        r <- stepc sc
+        case r of
+            Yield z sc' -> f x y z >>= (\res -> return $ Yield res (sa, sb, sc', Nothing))
+            Skip    sc' -> return $ Skip (sa, sb, sc', Just (x, Just y))
+            Done        -> return $ Done
+
 -- Filtering
 -- ---------
 
index 2947a65..af9d95e 100644 (file)
@@ -33,8 +33,11 @@ module Data.Vector.IVector (
   -- * Permutations
   accum, (//), update, backpermute, reverse,
 
-  -- * Mapping and zipping
-  map, zipWith, zip,
+  -- * Mapping
+  map, concatMap,
+
+  -- * Zipping and unzipping
+  zipWith, zipWith3, zip, zip3, unzip, unzip3,
 
   -- * Comparisons
   eq, cmp,
@@ -49,8 +52,7 @@ module Data.Vector.IVector (
   foldl, foldl1, foldl', foldl1', foldr, foldr1,
  
   -- * Specialised folds
-  and, or, concatMap,
-  sum, product, maximum, minimum,
+  and, or, sum, product, maximum, minimum,
   
   -- * Enumeration
   enumFromTo, enumFromThenTo,
@@ -94,12 +96,12 @@ import Prelude hiding ( length, null,
                         replicate, (++),
                         head, last,
                         init, tail, take, drop, reverse,
-                        map, zipWith, zip,
+                        map, concatMap,
+                        zipWith, zipWith3, zip, zip3, unzip, unzip3,
                         filter, takeWhile, dropWhile,
                         elem, notElem,
                         foldl, foldl1, foldr, foldr1,
-                        and, or, concatMap,
-                        sum, product, maximum, minimum,
+                        and, or, sum, product, maximum, minimum,
                         enumFromTo, enumFromThenTo )
 
 -- | Class of immutable vectors.
@@ -384,8 +386,8 @@ reverse :: (IVector v a) => v a -> v a
 {-# INLINE reverse #-}
 reverse = new . New.reverse . New.unstream . stream
 
--- Mapping/zipping
--- ---------------
+-- Mapping
+-- -------
 
 -- | Map a function over a vector
 map :: (IVector v a, IVector v b) => (a -> b) -> v a -> v b
@@ -402,15 +404,39 @@ inplace_map f = unstream . inplace (MStream.map f) . stream
 
  #-}
 
+concatMap :: (IVector v a, IVector v b) => (a -> v b) -> v a -> v b
+{-# INLINE concatMap #-}
+concatMap f = unstream . Stream.concatMap (stream . f) . stream
+
+-- Zipping/unzipping
+-- -----------------
+
 -- | Zip two vectors with the given function.
 zipWith :: (IVector v a, IVector v b, IVector v c) => (a -> b -> c) -> v a -> v b -> v c
 {-# INLINE zipWith #-}
 zipWith f xs ys = unstream (Stream.zipWith f (stream xs) (stream ys))
 
+-- | Zip three vectors with the given function.
+zipWith3 :: (IVector v a, IVector v b, IVector v c, IVector v d) => (a -> b -> c -> d) -> v a -> v b -> v c -> v d
+{-# INLINE zipWith3 #-}
+zipWith3 f xs ys zs = unstream (Stream.zipWith3 f (stream xs) (stream ys) (stream zs))
+
 zip :: (IVector v a, IVector v b, IVector v (a,b)) => v a -> v b -> v (a, b)
 {-# INLINE zip #-}
 zip = zipWith (,)
 
+zip3 :: (IVector v a, IVector v b, IVector v c, IVector v (a, b, c)) => v a -> v b -> v c -> v (a, b, c)
+{-# INLINE zip3 #-}
+zip3 = zipWith3 (,,)
+
+unzip :: (IVector v a, IVector v b, IVector v (a,b)) => v (a, b) -> (v a, v b)
+{-# INLINE unzip #-}
+unzip xs = (map fst xs, map snd xs)
+
+unzip3 :: (IVector v a, IVector v b, IVector v c, IVector v (a, b, c)) => v (a, b, c) -> (v a, v b, v c)
+{-# INLINE unzip3 #-}
+unzip3 xs = (map (\(a, b, c) -> a) xs, map (\(a, b, c) -> b) xs, map (\(a, b, c) -> c) xs)
+
 -- Comparisons
 -- -----------
 
@@ -511,10 +537,6 @@ or :: IVector v Bool => v Bool -> Bool
 {-# INLINE or #-}
 or = Stream.or . stream
 
-concatMap :: (IVector v a, IVector v b) => (a -> v b) -> v a -> v b
-{-# INLINE concatMap #-}
-concatMap f = unstream . Stream.concatMap (stream . f) . stream
-
 sum :: (IVector v a, Num a) => v a -> a
 {-# INLINE sum #-}
 sum = Stream.foldl' (+) 0 . stream
index ecc8eda..fa123aa 100644 (file)
@@ -17,13 +17,18 @@ import Text.Show.Functions ()
 import Data.List           (foldl', foldl1', unfoldr, find, findIndex)
 
 #define COMMON_CONTEXT(a, v) \
-  Eq a, Eq (v a), \
-  Show a,     Arbitrary a,     Model a a, \
-  Show (v a), Arbitrary (v a), Model (v a) [a], V.IVector v a
+ VANILLA_CONTEXT(a, v), VECTOR_CONTEXT(a, v)
 
+#define VANILLA_CONTEXT(a, v) \
+  Eq a,     Show a,     Arbitrary a,     Model a a
 
--- TODO: implement Vector equivalents for some of the commented out list functions from Prelude
--- TODO: test and implement some of these other functions:
+#define VECTOR_CONTEXT(a, v) \
+  Eq (v a), Show (v a), Arbitrary (v a), Model (v a) [a], V.IVector 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:
 --  mapM *
 --  mapM_ *
 --  sequence
@@ -35,10 +40,6 @@ import Data.List           (foldl', foldl1', unfoldr, find, findIndex)
 --  scanr *
 --  scanr1 *
 --  lookup *
---  zip3 *
---  zipWith3 *
---  unzip *
---  unzip3 *
 --  lines
 --  words
 --  unlines
@@ -46,6 +47,18 @@ import Data.List           (foldl', foldl1', unfoldr, find, findIndex)
 -- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors.
 -- Ones with *s are the most plausible candidates.
 
+-- TODO: add tests for the other extra functions
+-- IVector exports still needing tests:
+--  copy,
+--  slice,
+--  (//), update, bpermute,
+--  prescanl, prescanl',
+--  new,
+--  unsafeSlice, unsafeIndex,
+--  vlength, vnew
+
+-- TODO: test non-IVector stuff?
+
 testSanity :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
 testSanity _ = [
         testProperty "fromList.toList == id" prop_fromList_toList,
@@ -66,7 +79,8 @@ testPolymorphicFunctions _ = $(testProperties [
         '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_zipWith, 'prop_replicate,
+        'prop_filter, 'prop_map, 'prop_replicate,
+        'prop_zipWith, 'prop_zipWith3,
         'prop_elem, 'prop_notElem,
         'prop_foldr, 'prop_foldl, 'prop_foldr1, 'prop_foldl1,
         'prop_foldl', 'prop_foldl1',
@@ -95,9 +109,9 @@ testPolymorphicFunctions _ = $(testProperties [
     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_map          = (V.map :: (a -> a) -> v a -> v a)             `eq2` map
-    --prop_zip          = (V.zip :: v a -> v a -> v (a, a))             `eq2` zip
-    prop_zipWith      = (V.zipWith :: (a -> a -> a) -> v a -> v a -> v a) `eq3` zipWith
     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
@@ -111,7 +125,6 @@ testPolymorphicFunctions _ = $(testProperties [
     --prop_any          = (V.any :: (a -> Bool) -> v a -> Bool)         `eq2` any
 
     -- Data.List
-    -- TODO: implement Vector equivalents for some of the commented out list functions from 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
@@ -143,16 +156,14 @@ testPolymorphicFunctions _ = $(testProperties [
     
     snoc xs x = xs ++ [x]
     prop_snoc = (V.snoc :: v a -> a -> v a) `eq2` snoc
-    
-    -- TODO: add tests for the other extra functions
-    -- IVector exports still needing tests:
-    --  copy,
-    --  slice,
-    --  (//), update, bpermute,
-    --  prescanl, prescanl',
-    --  new,
-    --  unsafeSlice, unsafeIndex,
-    --  vlength, vnew
+
+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])
+  where
+    prop_zip          = (V.zip :: v a -> v a -> v (a, a))             `eq2` zip
+    prop_zip3         = (V.zip3 :: v a -> v a -> v a -> v (a, a, a))  `eq3` zip3
+    prop_unzip        = (V.unzip :: v (a, a) -> (v a, v a))           `eq1` unzip
+    prop_unzip3       = (V.unzip3 :: v (a, a, a) -> (v a, v a, v a))  `eq1` unzip3
 
 testOrdFunctions :: forall a v. (COMMON_CONTEXT(a, v), Ord a, Ord (v a)) => v a -> [Test]
 testOrdFunctions _ = $(testProperties ['prop_compare, 'prop_maximum, 'prop_minimum])
@@ -197,6 +208,7 @@ testGeneralBoxedVector dummy = concatMap ($ dummy) [
         testPolymorphicFunctions,
         testOrdFunctions,
         testEnumFunctions,
+        testTuplyFunctions,
         testNestedVectorFunctions
     ]
 
@@ -213,7 +225,6 @@ testGeneralUnboxedVector dummy = concatMap ($ dummy) [
 testBoolUnboxedVector dummy = testGeneralUnboxedVector dummy ++ testBoolFunctions dummy
 testNumericUnboxedVector dummy = testGeneralUnboxedVector dummy ++ testNumFunctions dummy
 
--- TODO: test non-IVector stuff?
 tests = [
         testGroup "Data.Vector.Vector (Bool)"           (testBoolBoxedVector      (undefined :: Data.Vector.Vector Bool)),
         testGroup "Data.Vector.Vector (Int)"            (testNumericBoxedVector   (undefined :: Data.Vector.Vector Int)),
index 4322366..bdccf19 100644 (file)
@@ -43,16 +43,19 @@ 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 c, Model b d) => Model (a, b) (c, d)       where model (a, b) = (model a, model b)
-instance (Model c a, Model b d) => Model (a -> b) (c -> d)   where model f = model . f . model
-
-
-eq0 f g =           model f         == g
-eq1 f g = \a     -> model (f a)     == g (model a)
-eq2 f g = \a b   -> model (f a b)   == g (model a) (model b)
-eq3 f g = \a b c -> model (f a b c) == g (model a) (model b) (model c)
-
-eqNotNull1 f g = \x     -> (not (DVI.null x)) ==> eq1 f g x
-eqNotNull2 f g = \x y   -> (not (DVI.null y)) ==> eq2 f g x y
-eqNotNull3 f g = \x y z -> (not (DVI.null z)) ==> eq3 f g x y z
+instance Model a b                            => Model (Maybe a) (Maybe 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
+
+
+eq0 f g =             model f           == g
+eq1 f g = \a       -> model (f a)       == g (model a)
+eq2 f g = \a b     -> model (f a b)     == g (model a) (model b)
+eq3 f g = \a b c   -> model (f a b c)   == g (model a) (model b) (model c)
+eq4 f g = \a b c d -> model (f a b c d) == g (model a) (model b) (model c) (model d)
+
+eqNotNull1 f g = \a       -> (not (DVI.null a)) ==> eq1 f g a
+eqNotNull2 f g = \a b     -> (not (DVI.null b)) ==> eq2 f g a b
+eqNotNull3 f g = \a b c   -> (not (DVI.null c)) ==> eq3 f g a b c
+eqNotNull4 f g = \a b c d -> (not (DVI.null d)) ==> eq4 f g a b c d