summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--hmatrix.cabal6
-rw-r--r--lib/Numeric/LinearAlgebra/Tests.hs8
-rw-r--r--lib/Numeric/LinearAlgebra/Tests/Instances.hs91
-rw-r--r--lib/Numeric/LinearAlgebra/Tests/Properties.hs5
-rw-r--r--lib/Numeric/LinearAlgebra/Tests/quickCheckCompat.h33
5 files changed, 128 insertions, 15 deletions
diff --git a/hmatrix.cabal b/hmatrix.cabal
index 516e6b5..c1b4e01 100644
--- a/hmatrix.cabal
+++ b/hmatrix.cabal
@@ -15,6 +15,8 @@ tested-with: GHC ==6.10.1
15 15
16cabal-version: >=1.2 16cabal-version: >=1.2
17build-type: Simple 17build-type: Simple
18extra-source-files: lib/Numeric/LinearAlgebra/Tests/quickCheckCompat.h
19
18 20
19flag splitBase 21flag splitBase
20 description: Choose the new smaller, split-up base package. 22 description: Choose the new smaller, split-up base package.
@@ -34,9 +36,9 @@ flag unsafe
34 36
35library 37library
36 if flag(splitBase) 38 if flag(splitBase)
37 build-depends: base >= 3, array, QuickCheck < 2, HUnit, storable-complex 39 build-depends: base >= 3, array, QuickCheck, HUnit, storable-complex
38 else 40 else
39 build-depends: base < 3, QuickCheck < 2, HUnit, storable-complex 41 build-depends: base < 3, QuickCheck, HUnit, storable-complex
40 42
41 Build-Depends: haskell98 43 Build-Depends: haskell98
42 Extensions: ForeignFunctionInterface, 44 Extensions: ForeignFunctionInterface,
diff --git a/lib/Numeric/LinearAlgebra/Tests.hs b/lib/Numeric/LinearAlgebra/Tests.hs
index 9617a7a..8b92287 100644
--- a/lib/Numeric/LinearAlgebra/Tests.hs
+++ b/lib/Numeric/LinearAlgebra/Tests.hs
@@ -1,3 +1,5 @@
1{-# LANGUAGE CPP #-}
2{-# OPTIONS_GHC -fno-warn-unused-imports #-}
1----------------------------------------------------------------------------- 3-----------------------------------------------------------------------------
2{- | 4{- |
3Module : Numeric.LinearAlgebra.Tests 5Module : Numeric.LinearAlgebra.Tests
@@ -22,18 +24,16 @@ module Numeric.LinearAlgebra.Tests(
22import Numeric.LinearAlgebra 24import Numeric.LinearAlgebra
23import Numeric.LinearAlgebra.Tests.Instances 25import Numeric.LinearAlgebra.Tests.Instances
24import Numeric.LinearAlgebra.Tests.Properties 26import Numeric.LinearAlgebra.Tests.Properties
25import Test.QuickCheck hiding (test) 27import Test.HUnit hiding ((~:),test,Testable)
26import Test.HUnit hiding ((~:),test)
27import System.Info 28import System.Info
28import Data.List(foldl1') 29import Data.List(foldl1')
29import Numeric.GSL hiding (sin,cos,exp,choose) 30import Numeric.GSL hiding (sin,cos,exp,choose)
30import Prelude hiding ((^)) 31import Prelude hiding ((^))
31import qualified Prelude 32import qualified Prelude
33#include "Tests/quickCheckCompat.h"
32 34
33a ^ b = a Prelude.^ (b :: Int) 35a ^ b = a Prelude.^ (b :: Int)
34 36
35qCheck n = check defaultConfig {configSize = const n}
36
37utest str b = TestCase $ assertBool str b 37utest str b = TestCase $ assertBool str b
38 38
39feye n = flipud (ident n) :: Matrix Double 39feye n = flipud (ident n) :: Matrix Double
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 @@
1{-# LANGUAGE FlexibleContexts, UndecidableInstances #-} 1{-# LANGUAGE FlexibleContexts, UndecidableInstances, CPP #-}
2{-# OPTIONS_GHC -fno-warn-unused-imports #-}
2----------------------------------------------------------------------------- 3-----------------------------------------------------------------------------
3{- | 4{- |
4Module : Numeric.LinearAlgebra.Tests.Instances 5Module : Numeric.LinearAlgebra.Tests.Instances
@@ -24,24 +25,53 @@ module Numeric.LinearAlgebra.Tests.Instances(
24 RM,CM, rM,cM 25 RM,CM, rM,cM
25) where 26) where
26 27
28
29
30
27import Numeric.LinearAlgebra 31import Numeric.LinearAlgebra
28import Test.QuickCheck
29import Control.Monad(replicateM) 32import Control.Monad(replicateM)
33#include "quickCheckCompat.h"
34
35
36#if MIN_VERSION_QuickCheck(2,0,0)
37shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]]
38shrinkListElementwise [] = []
39shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ]
40 ++ [ x:ys | ys <- shrinkListElementwise xs ]
41
42shrinkPair :: (Arbitrary a, Arbitrary b) => (a,b) -> [(a,b)]
43shrinkPair (a,b) = [ (a,x) | x <- shrink b ] ++ [ (x,b) | x <- shrink a ]
44#endif
45
30 46
31instance (Arbitrary a, RealFloat a) => Arbitrary (Complex a) where 47instance (Arbitrary a, RealFloat a) => Arbitrary (Complex a) where
32 arbitrary = do 48 arbitrary = do
33 re <- arbitrary 49 re <- arbitrary
34 im <- arbitrary 50 im <- arbitrary
35 return (re :+ im) 51 return (re :+ im)
36 coarbitrary = undefined 52
53#if MIN_VERSION_QuickCheck(2,0,0)
54 shrink (re :+ im) =
55 [ u :+ v | (u,v) <- shrinkPair (re,im) ]
56#else
57 -- this has been moved to the 'Coarbitrary' class in QuickCheck 2
58 coarbitrary = undefined
59#endif
37 60
38chooseDim = sized $ \m -> choose (1,max 1 m) 61chooseDim = sized $ \m -> choose (1,max 1 m)
39 62
40instance (Field a, Arbitrary a) => Arbitrary (Vector a) where 63instance (Field a, Arbitrary a) => Arbitrary (Vector a) where
41 arbitrary = do m <- chooseDim 64 arbitrary = do m <- chooseDim
42 l <- vector m 65 l <- vector m
43 return $ fromList l 66 return $ fromList l
44 coarbitrary = undefined 67
68#if MIN_VERSION_QuickCheck(2,0,0)
69 -- shrink any one of the components
70 shrink = map fromList . shrinkListElementwise . toList
71
72#else
73 coarbitrary = undefined
74#endif
45 75
46instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where 76instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where
47 arbitrary = do 77 arbitrary = do
@@ -49,7 +79,17 @@ instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where
49 n <- chooseDim 79 n <- chooseDim
50 l <- vector (m*n) 80 l <- vector (m*n)
51 return $ (m><n) l 81 return $ (m><n) l
82
83#if MIN_VERSION_QuickCheck(2,0,0)
84 -- shrink any one of the components
85 shrink a = map ((rows a) >< (cols a))
86 . shrinkListElementwise
87 . concat . toLists
88 $ a
89#else
52 coarbitrary = undefined 90 coarbitrary = undefined
91#endif
92
53 93
54-- a square matrix 94-- a square matrix
55newtype (Sq a) = Sq (Matrix a) deriving Show 95newtype (Sq a) = Sq (Matrix a) deriving Show
@@ -58,7 +98,13 @@ instance (Element a, Arbitrary a) => Arbitrary (Sq a) where
58 n <- chooseDim 98 n <- chooseDim
59 l <- vector (n*n) 99 l <- vector (n*n)
60 return $ Sq $ (n><n) l 100 return $ Sq $ (n><n) l
101
102#if MIN_VERSION_QuickCheck(2,0,0)
103 shrink (Sq a) = [ Sq b | b <- shrink a ]
104#else
61 coarbitrary = undefined 105 coarbitrary = undefined
106#endif
107
62 108
63-- a unitary matrix 109-- a unitary matrix
64newtype (Rot a) = Rot (Matrix a) deriving Show 110newtype (Rot a) = Rot (Matrix a) deriving Show
@@ -67,7 +113,12 @@ instance (Field a, Arbitrary a) => Arbitrary (Rot a) where
67 Sq m <- arbitrary 113 Sq m <- arbitrary
68 let (q,_) = qr m 114 let (q,_) = qr m
69 return (Rot q) 115 return (Rot q)
116
117#if MIN_VERSION_QuickCheck(2,0,0)
118#else
70 coarbitrary = undefined 119 coarbitrary = undefined
120#endif
121
71 122
72-- a complex hermitian or real symmetric matrix 123-- a complex hermitian or real symmetric matrix
73newtype (Her a) = Her (Matrix a) deriving Show 124newtype (Her a) = Her (Matrix a) deriving Show
@@ -76,7 +127,12 @@ instance (Field a, Arbitrary a, Num (Vector a)) => Arbitrary (Her a) where
76 Sq m <- arbitrary 127 Sq m <- arbitrary
77 let m' = m/2 128 let m' = m/2
78 return $ Her (m' + ctrans m') 129 return $ Her (m' + ctrans m')
130
131#if MIN_VERSION_QuickCheck(2,0,0)
132#else
79 coarbitrary = undefined 133 coarbitrary = undefined
134#endif
135
80 136
81-- a well-conditioned general matrix (the singular values are between 1 and 100) 137-- a well-conditioned general matrix (the singular values are between 1 and 100)
82newtype (WC a) = WC (Matrix a) deriving Show 138newtype (WC a) = WC (Matrix a) deriving Show
@@ -90,7 +146,12 @@ instance (Field a, Arbitrary a) => Arbitrary (WC a) where
90 sv <- replicateM n (choose (1,100)) 146 sv <- replicateM n (choose (1,100))
91 let s = diagRect (fromList sv) r c 147 let s = diagRect (fromList sv) r c
92 return $ WC (u <> real s <> trans v) 148 return $ WC (u <> real s <> trans v)
149
150#if MIN_VERSION_QuickCheck(2,0,0)
151#else
93 coarbitrary = undefined 152 coarbitrary = undefined
153#endif
154
94 155
95-- a well-conditioned square matrix (the singular values are between 1 and 100) 156-- a well-conditioned square matrix (the singular values are between 1 and 100)
96newtype (SqWC a) = SqWC (Matrix a) deriving Show 157newtype (SqWC a) = SqWC (Matrix a) deriving Show
@@ -102,7 +163,12 @@ instance (Field a, Arbitrary a) => Arbitrary (SqWC a) where
102 sv <- replicateM n (choose (1,100)) 163 sv <- replicateM n (choose (1,100))
103 let s = diag (fromList sv) 164 let s = diag (fromList sv)
104 return $ SqWC (u <> real s <> trans v) 165 return $ SqWC (u <> real s <> trans v)
166
167#if MIN_VERSION_QuickCheck(2,0,0)
168#else
105 coarbitrary = undefined 169 coarbitrary = undefined
170#endif
171
106 172
107-- a positive definite square matrix (the eigenvalues are between 0 and 100) 173-- a positive definite square matrix (the eigenvalues are between 0 and 100)
108newtype (PosDef a) = PosDef (Matrix a) deriving Show 174newtype (PosDef a) = PosDef (Matrix a) deriving Show
@@ -115,7 +181,12 @@ instance (Field a, Arbitrary a, Num (Vector a)) => Arbitrary (PosDef a) where
115 let s = diag (fromList l) 181 let s = diag (fromList l)
116 p = v <> real s <> ctrans v 182 p = v <> real s <> ctrans v
117 return $ PosDef (0.5 .* p + 0.5 .* ctrans p) 183 return $ PosDef (0.5 .* p + 0.5 .* ctrans p)
184
185#if MIN_VERSION_QuickCheck(2,0,0)
186#else
118 coarbitrary = undefined 187 coarbitrary = undefined
188#endif
189
119 190
120-- a pair of matrices that can be multiplied 191-- a pair of matrices that can be multiplied
121newtype (Consistent a) = Consistent (Matrix a, Matrix a) deriving Show 192newtype (Consistent a) = Consistent (Matrix a, Matrix a) deriving Show
@@ -127,7 +198,13 @@ instance (Field a, Arbitrary a) => Arbitrary (Consistent a) where
127 la <- vector (n*k) 198 la <- vector (n*k)
128 lb <- vector (k*m) 199 lb <- vector (k*m)
129 return $ Consistent ((n><k) la, (k><m) lb) 200 return $ Consistent ((n><k) la, (k><m) lb)
201
202#if MIN_VERSION_QuickCheck(2,0,0)
203 shrink (Consistent (x,y)) = [ Consistent (u,v) | (u,v) <- shrinkPair (x,y) ]
204#else
130 coarbitrary = undefined 205 coarbitrary = undefined
206#endif
207
131 208
132 209
133type RM = Matrix Double 210type RM = Matrix Double
diff --git a/lib/Numeric/LinearAlgebra/Tests/Properties.hs b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
index ec87ad0..d4c2770 100644
--- a/lib/Numeric/LinearAlgebra/Tests/Properties.hs
+++ b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
@@ -1,4 +1,5 @@
1{-# OPTIONS #-} 1{-# LANGUAGE CPP #-}
2{-# OPTIONS_GHC -fno-warn-unused-imports #-}
2----------------------------------------------------------------------------- 3-----------------------------------------------------------------------------
3{- | 4{- |
4Module : Numeric.LinearAlgebra.Tests.Properties 5Module : Numeric.LinearAlgebra.Tests.Properties
@@ -40,7 +41,7 @@ module Numeric.LinearAlgebra.Tests.Properties (
40) where 41) where
41 42
42import Numeric.LinearAlgebra 43import Numeric.LinearAlgebra
43import Test.QuickCheck 44#include "quickCheckCompat.h"
44-- import Debug.Trace 45-- import Debug.Trace
45 46
46-- debug x = trace (show x) x 47-- debug x = trace (show x) x
diff --git a/lib/Numeric/LinearAlgebra/Tests/quickCheckCompat.h b/lib/Numeric/LinearAlgebra/Tests/quickCheckCompat.h
new file mode 100644
index 0000000..714587b
--- /dev/null
+++ b/lib/Numeric/LinearAlgebra/Tests/quickCheckCompat.h
@@ -0,0 +1,33 @@
1#ifndef MIN_VERSION_QuickCheck
2#define MIN_VERSION_QuickCheck(A,B,C) 1
3#endif
4
5#if MIN_VERSION_QuickCheck(2,0,0)
6import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector
7 ,sized,classify,Testable,Property
8
9 ,quickCheckWith,maxSize,stdArgs,shrink)
10
11#else
12import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector
13 ,sized,classify,Testable,Property
14
15 ,check,configSize,defaultConfig,trivial)
16#endif
17
18
19
20#if MIN_VERSION_QuickCheck(2,0,0)
21trivial :: Testable a => Bool -> a -> Property
22trivial = (`classify` "trivial")
23#else
24#endif
25
26
27-- define qCheck, which used to be in Tests.hs
28#if MIN_VERSION_QuickCheck(2,0,0)
29qCheck n = quickCheckWith stdArgs {maxSize = n}
30#else
31qCheck n = check defaultConfig {configSize = const n}
32#endif
33