1 files changed, 84 insertions, 7 deletions

diff --git a/lib/Numeric/LinearAlgebra/Tests/Instances.hs b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
index 4e829d2..9b18513 100644
--- a/lib/Numeric/LinearAlgebra/Tests/Instances.hs
+++ b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts, UndecidableInstances, CPP #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
 -----------------------------------------------------------------------------
 {- |
 Module      :  Numeric.LinearAlgebra.Tests.Instances
@@ -24,24 +25,53 @@ module Numeric.LinearAlgebra.Tests.Instances(
     RM,CM, rM,cM
 ) where
 
+
+
+
 import Numeric.LinearAlgebra
-import Test.QuickCheck
 import Control.Monad(replicateM)
+#include "quickCheckCompat.h"
+
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]]
+shrinkListElementwise []     = []
+shrinkListElementwise (x:xs) = [ y:xs | y  <- shrink x                 ]
+                            ++ [ x:ys | ys <- shrinkListElementwise xs ]
+
+shrinkPair :: (Arbitrary a, Arbitrary b) => (a,b) -> [(a,b)]
+shrinkPair (a,b) = [ (a,x) | x <- shrink b ] ++ [ (x,b) | x <- shrink a ]
+#endif
+
 
 instance (Arbitrary a, RealFloat a) => Arbitrary (Complex a) where
     arbitrary = do
         re <- arbitrary
         im <- arbitrary
         return (re :+ im)
-    coarbitrary = undefined
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+    shrink (re :+ im) = 
+        [ u :+ v | (u,v) <- shrinkPair (re,im) ]
+#else
+    -- this has been moved to the 'Coarbitrary' class in QuickCheck 2
+    coarbitrary = undefined 
+#endif
 
 chooseDim = sized $ \m -> choose (1,max 1 m)
 
 instance (Field a, Arbitrary a) => Arbitrary (Vector a) where 
-   arbitrary = do m <- chooseDim
-                  l <- vector m
-                  return $ fromList l
-   coarbitrary = undefined
+    arbitrary = do m <- chooseDim
+                   l <- vector m
+                   return $ fromList l
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+    -- shrink any one of the components
+    shrink = map fromList . shrinkListElementwise . toList
+                              
+#else
+    coarbitrary = undefined
+#endif
 
 instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where 
     arbitrary = do
@@ -49,7 +79,17 @@ instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where
         n <- chooseDim
         l <- vector (m*n)
         return $ (m><n) l
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+    -- shrink any one of the components
+    shrink a = map ((rows a) >< (cols a))
+               . shrinkListElementwise
+               . concat . toLists 
+                     $ a
+#else
     coarbitrary = undefined
+#endif
+
 
 -- a square matrix
 newtype (Sq a) = Sq (Matrix a) deriving Show
@@ -58,7 +98,13 @@ instance (Element a, Arbitrary a) => Arbitrary (Sq a) where
         n <- chooseDim
         l <- vector (n*n)
         return $ Sq $ (n><n) l
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+    shrink (Sq a) = [ Sq b | b <- shrink a ]
+#else
     coarbitrary = undefined
+#endif
+
 
 -- a unitary matrix
 newtype (Rot a) = Rot (Matrix a) deriving Show
@@ -67,7 +113,12 @@ instance (Field a, Arbitrary a) => Arbitrary (Rot a) where
         Sq m <- arbitrary
         let (q,_) = qr m
         return (Rot q)
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+#else
     coarbitrary = undefined
+#endif
+
 
 -- a complex hermitian or real symmetric matrix
 newtype (Her a) = Her (Matrix a) deriving Show
@@ -76,7 +127,12 @@ instance (Field a, Arbitrary a, Num (Vector a)) => Arbitrary (Her a) where
         Sq m <- arbitrary
         let m' = m/2
         return $ Her (m' + ctrans m')
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+#else
     coarbitrary = undefined
+#endif
+
 
 -- a well-conditioned general matrix (the singular values are between 1 and 100)
 newtype (WC a) = WC (Matrix a) deriving Show
@@ -90,7 +146,12 @@ instance (Field a, Arbitrary a) => Arbitrary (WC a) where
         sv <- replicateM n (choose (1,100))
         let s = diagRect (fromList sv) r c
         return $ WC (u <> real s <> trans v)
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+#else
     coarbitrary = undefined
+#endif
+
 
 -- a well-conditioned square matrix (the singular values are between 1 and 100)
 newtype (SqWC a) = SqWC (Matrix a) deriving Show
@@ -102,7 +163,12 @@ instance (Field a, Arbitrary a) => Arbitrary (SqWC a) where
         sv <- replicateM n (choose (1,100))
         let s = diag (fromList sv)
         return $ SqWC (u <> real s <> trans v)
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+#else
     coarbitrary = undefined
+#endif
+
 
 -- a positive definite square matrix (the eigenvalues are between 0 and 100)
 newtype (PosDef a) = PosDef (Matrix a) deriving Show
@@ -115,7 +181,12 @@ instance (Field a, Arbitrary a, Num (Vector a)) => Arbitrary (PosDef a) where
         let s = diag (fromList l)
             p = v <> real s <> ctrans v
         return $ PosDef (0.5 .* p + 0.5 .* ctrans p)
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+#else
     coarbitrary = undefined
+#endif
+
 
 -- a pair of matrices that can be multiplied
 newtype (Consistent a) = Consistent (Matrix a, Matrix a) deriving Show
@@ -127,7 +198,13 @@ instance (Field a, Arbitrary a) => Arbitrary (Consistent a) where
         la <- vector (n*k)
         lb <- vector (k*m)
         return $ Consistent ((n><k) la, (k><m) lb)
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+    shrink (Consistent (x,y)) = [ Consistent (u,v) | (u,v) <- shrinkPair (x,y) ]
+#else
     coarbitrary = undefined
+#endif
+
 
 
 type RM = Matrix Double