[commit: dph] master: Add quickcheck tests for permutes. (da6f960)

[Ben Lippmeier]

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 <groldugin at cse.unsw.edu.au>
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
+ |])
+