diff options
-rw-r--r-- | hmatrix.cabal | 6 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/Tests.hs | 8 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/Tests/Instances.hs | 91 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/Tests/Properties.hs | 5 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/Tests/quickCheckCompat.h | 33 |
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 | ||
16 | cabal-version: >=1.2 | 16 | cabal-version: >=1.2 |
17 | build-type: Simple | 17 | build-type: Simple |
18 | extra-source-files: lib/Numeric/LinearAlgebra/Tests/quickCheckCompat.h | ||
19 | |||
18 | 20 | ||
19 | flag splitBase | 21 | flag 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 | ||
35 | library | 37 | library |
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 | {- | |
3 | Module : Numeric.LinearAlgebra.Tests | 5 | Module : Numeric.LinearAlgebra.Tests |
@@ -22,18 +24,16 @@ module Numeric.LinearAlgebra.Tests( | |||
22 | import Numeric.LinearAlgebra | 24 | import Numeric.LinearAlgebra |
23 | import Numeric.LinearAlgebra.Tests.Instances | 25 | import Numeric.LinearAlgebra.Tests.Instances |
24 | import Numeric.LinearAlgebra.Tests.Properties | 26 | import Numeric.LinearAlgebra.Tests.Properties |
25 | import Test.QuickCheck hiding (test) | 27 | import Test.HUnit hiding ((~:),test,Testable) |
26 | import Test.HUnit hiding ((~:),test) | ||
27 | import System.Info | 28 | import System.Info |
28 | import Data.List(foldl1') | 29 | import Data.List(foldl1') |
29 | import Numeric.GSL hiding (sin,cos,exp,choose) | 30 | import Numeric.GSL hiding (sin,cos,exp,choose) |
30 | import Prelude hiding ((^)) | 31 | import Prelude hiding ((^)) |
31 | import qualified Prelude | 32 | import qualified Prelude |
33 | #include "Tests/quickCheckCompat.h" | ||
32 | 34 | ||
33 | a ^ b = a Prelude.^ (b :: Int) | 35 | a ^ b = a Prelude.^ (b :: Int) |
34 | 36 | ||
35 | qCheck n = check defaultConfig {configSize = const n} | ||
36 | |||
37 | utest str b = TestCase $ assertBool str b | 37 | utest str b = TestCase $ assertBool str b |
38 | 38 | ||
39 | feye n = flipud (ident n) :: Matrix Double | 39 | feye 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 | {- | |
4 | Module : Numeric.LinearAlgebra.Tests.Instances | 5 | Module : 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 | |||
27 | import Numeric.LinearAlgebra | 31 | import Numeric.LinearAlgebra |
28 | import Test.QuickCheck | ||
29 | import Control.Monad(replicateM) | 32 | import Control.Monad(replicateM) |
33 | #include "quickCheckCompat.h" | ||
34 | |||
35 | |||
36 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
37 | shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]] | ||
38 | shrinkListElementwise [] = [] | ||
39 | shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ] | ||
40 | ++ [ x:ys | ys <- shrinkListElementwise xs ] | ||
41 | |||
42 | shrinkPair :: (Arbitrary a, Arbitrary b) => (a,b) -> [(a,b)] | ||
43 | shrinkPair (a,b) = [ (a,x) | x <- shrink b ] ++ [ (x,b) | x <- shrink a ] | ||
44 | #endif | ||
45 | |||
30 | 46 | ||
31 | instance (Arbitrary a, RealFloat a) => Arbitrary (Complex a) where | 47 | instance (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 | ||
38 | chooseDim = sized $ \m -> choose (1,max 1 m) | 61 | chooseDim = sized $ \m -> choose (1,max 1 m) |
39 | 62 | ||
40 | instance (Field a, Arbitrary a) => Arbitrary (Vector a) where | 63 | instance (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 | ||
46 | instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where | 76 | instance (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 |
55 | newtype (Sq a) = Sq (Matrix a) deriving Show | 95 | newtype (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 |
64 | newtype (Rot a) = Rot (Matrix a) deriving Show | 110 | newtype (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 |
73 | newtype (Her a) = Her (Matrix a) deriving Show | 124 | newtype (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) |
82 | newtype (WC a) = WC (Matrix a) deriving Show | 138 | newtype (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) |
96 | newtype (SqWC a) = SqWC (Matrix a) deriving Show | 157 | newtype (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) |
108 | newtype (PosDef a) = PosDef (Matrix a) deriving Show | 174 | newtype (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 |
121 | newtype (Consistent a) = Consistent (Matrix a, Matrix a) deriving Show | 192 | newtype (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 | ||
133 | type RM = Matrix Double | 210 | type 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 | {- | |
4 | Module : Numeric.LinearAlgebra.Tests.Properties | 5 | Module : Numeric.LinearAlgebra.Tests.Properties |
@@ -40,7 +41,7 @@ module Numeric.LinearAlgebra.Tests.Properties ( | |||
40 | ) where | 41 | ) where |
41 | 42 | ||
42 | import Numeric.LinearAlgebra | 43 | import Numeric.LinearAlgebra |
43 | import 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) | ||
6 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector | ||
7 | ,sized,classify,Testable,Property | ||
8 | |||
9 | ,quickCheckWith,maxSize,stdArgs,shrink) | ||
10 | |||
11 | #else | ||
12 | import 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) | ||
21 | trivial :: Testable a => Bool -> a -> Property | ||
22 | trivial = (`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) | ||
29 | qCheck n = quickCheckWith stdArgs {maxSize = n} | ||
30 | #else | ||
31 | qCheck n = check defaultConfig {configSize = const n} | ||
32 | #endif | ||
33 | |||