diff options
Diffstat (limited to 'packages/tests/src/Numeric/LinearAlgebra')
-rw-r--r-- | packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs | 72 | ||||
-rw-r--r-- | packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs | 8 |
2 files changed, 5 insertions, 75 deletions
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs index e2c3840..904ae05 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs | |||
@@ -1,5 +1,4 @@ | |||
1 | {-# LANGUAGE FlexibleContexts, UndecidableInstances, CPP, FlexibleInstances #-} | 1 | {-# LANGUAGE FlexibleContexts, UndecidableInstances, FlexibleInstances #-} |
2 | {-# OPTIONS_GHC -fno-warn-unused-imports #-} | ||
3 | ----------------------------------------------------------------------------- | 2 | ----------------------------------------------------------------------------- |
4 | {- | | 3 | {- | |
5 | Module : Numeric.LinearAlgebra.Tests.Instances | 4 | Module : Numeric.LinearAlgebra.Tests.Instances |
@@ -27,13 +26,10 @@ module Numeric.LinearAlgebra.Tests.Instances( | |||
27 | import System.Random | 26 | import System.Random |
28 | 27 | ||
29 | import Numeric.LinearAlgebra.HMatrix hiding (vector) | 28 | import Numeric.LinearAlgebra.HMatrix hiding (vector) |
30 | import Numeric.LinearAlgebra.Devel | ||
31 | import Control.Monad(replicateM) | 29 | import Control.Monad(replicateM) |
32 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector | 30 | import Test.QuickCheck(Arbitrary,arbitrary,choose,vector,sized,shrink) |
33 | ,sized,classify,Testable,Property | 31 | |
34 | ,quickCheckWith,maxSize,stdArgs,shrink) | ||
35 | 32 | ||
36 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
37 | shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]] | 33 | shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]] |
38 | shrinkListElementwise [] = [] | 34 | shrinkListElementwise [] = [] |
39 | shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ] | 35 | shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ] |
@@ -41,25 +37,6 @@ shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ] | |||
41 | 37 | ||
42 | shrinkPair :: (Arbitrary a, Arbitrary b) => (a,b) -> [(a,b)] | 38 | shrinkPair :: (Arbitrary a, Arbitrary b) => (a,b) -> [(a,b)] |
43 | shrinkPair (a,b) = [ (a,x) | x <- shrink b ] ++ [ (x,b) | x <- shrink a ] | 39 | shrinkPair (a,b) = [ (a,x) | x <- shrink b ] ++ [ (x,b) | x <- shrink a ] |
44 | #endif | ||
45 | |||
46 | #if MIN_VERSION_QuickCheck(2,1,1) | ||
47 | #else | ||
48 | instance (Arbitrary a, RealFloat a) => Arbitrary (Complex a) where | ||
49 | arbitrary = do | ||
50 | re <- arbitrary | ||
51 | im <- arbitrary | ||
52 | return (re :+ im) | ||
53 | |||
54 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
55 | shrink (re :+ im) = | ||
56 | [ u :+ v | (u,v) <- shrinkPair (re,im) ] | ||
57 | #else | ||
58 | -- this has been moved to the 'Coarbitrary' class in QuickCheck 2 | ||
59 | coarbitrary = undefined | ||
60 | #endif | ||
61 | |||
62 | #endif | ||
63 | 40 | ||
64 | chooseDim = sized $ \m -> choose (1,max 1 m) | 41 | chooseDim = sized $ \m -> choose (1,max 1 m) |
65 | 42 | ||
@@ -67,15 +44,9 @@ instance (Field a, Arbitrary a) => Arbitrary (Vector a) where | |||
67 | arbitrary = do m <- chooseDim | 44 | arbitrary = do m <- chooseDim |
68 | l <- vector m | 45 | l <- vector m |
69 | return $ fromList l | 46 | return $ fromList l |
70 | |||
71 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
72 | -- shrink any one of the components | 47 | -- shrink any one of the components |
73 | shrink = map fromList . shrinkListElementwise . toList | 48 | shrink = map fromList . shrinkListElementwise . toList |
74 | 49 | ||
75 | #else | ||
76 | coarbitrary = undefined | ||
77 | #endif | ||
78 | |||
79 | instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where | 50 | instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where |
80 | arbitrary = do | 51 | arbitrary = do |
81 | m <- chooseDim | 52 | m <- chooseDim |
@@ -83,16 +54,11 @@ instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where | |||
83 | l <- vector (m*n) | 54 | l <- vector (m*n) |
84 | return $ (m><n) l | 55 | return $ (m><n) l |
85 | 56 | ||
86 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
87 | -- shrink any one of the components | 57 | -- shrink any one of the components |
88 | shrink a = map (rows a >< cols a) | 58 | shrink a = map (rows a >< cols a) |
89 | . shrinkListElementwise | 59 | . shrinkListElementwise |
90 | . concat . toLists | 60 | . concat . toLists |
91 | $ a | 61 | $ a |
92 | #else | ||
93 | coarbitrary = undefined | ||
94 | #endif | ||
95 | |||
96 | 62 | ||
97 | -- a square matrix | 63 | -- a square matrix |
98 | newtype (Sq a) = Sq (Matrix a) deriving Show | 64 | newtype (Sq a) = Sq (Matrix a) deriving Show |
@@ -102,11 +68,7 @@ instance (Element a, Arbitrary a) => Arbitrary (Sq a) where | |||
102 | l <- vector (n*n) | 68 | l <- vector (n*n) |
103 | return $ Sq $ (n><n) l | 69 | return $ Sq $ (n><n) l |
104 | 70 | ||
105 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
106 | shrink (Sq a) = [ Sq b | b <- shrink a ] | 71 | shrink (Sq a) = [ Sq b | b <- shrink a ] |
107 | #else | ||
108 | coarbitrary = undefined | ||
109 | #endif | ||
110 | 72 | ||
111 | 73 | ||
112 | -- a unitary matrix | 74 | -- a unitary matrix |
@@ -117,11 +79,6 @@ instance (Field a, Arbitrary a) => Arbitrary (Rot a) where | |||
117 | let (q,_) = qr m | 79 | let (q,_) = qr m |
118 | return (Rot q) | 80 | return (Rot q) |
119 | 81 | ||
120 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
121 | #else | ||
122 | coarbitrary = undefined | ||
123 | #endif | ||
124 | |||
125 | 82 | ||
126 | -- a complex hermitian or real symmetric matrix | 83 | -- a complex hermitian or real symmetric matrix |
127 | newtype (Her a) = Her (Matrix a) deriving Show | 84 | newtype (Her a) = Her (Matrix a) deriving Show |
@@ -131,10 +88,6 @@ instance (Field a, Arbitrary a, Num (Vector a)) => Arbitrary (Her a) where | |||
131 | let m' = m/2 | 88 | let m' = m/2 |
132 | return $ Her (m' + tr m') | 89 | return $ Her (m' + tr m') |
133 | 90 | ||
134 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
135 | #else | ||
136 | coarbitrary = undefined | ||
137 | #endif | ||
138 | 91 | ||
139 | class (Field a, Arbitrary a, Element (RealOf a), Random (RealOf a)) => ArbitraryField a | 92 | class (Field a, Arbitrary a, Element (RealOf a), Random (RealOf a)) => ArbitraryField a |
140 | instance ArbitraryField Double | 93 | instance ArbitraryField Double |
@@ -154,11 +107,6 @@ instance (Numeric a, ArbitraryField a) => Arbitrary (WC a) where | |||
154 | let s = diagRect 0 (fromList sv') r c | 107 | let s = diagRect 0 (fromList sv') r c |
155 | return $ WC (u <> real s <> tr v) | 108 | return $ WC (u <> real s <> tr v) |
156 | 109 | ||
157 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
158 | #else | ||
159 | coarbitrary = undefined | ||
160 | #endif | ||
161 | |||
162 | 110 | ||
163 | -- a well-conditioned square matrix (the singular values are between 1 and 100) | 111 | -- a well-conditioned square matrix (the singular values are between 1 and 100) |
164 | newtype (SqWC a) = SqWC (Matrix a) deriving Show | 112 | newtype (SqWC a) = SqWC (Matrix a) deriving Show |
@@ -171,11 +119,6 @@ instance (ArbitraryField a, Numeric a) => Arbitrary (SqWC a) where | |||
171 | let s = diag (fromList sv') | 119 | let s = diag (fromList sv') |
172 | return $ SqWC (u <> real s <> tr v) | 120 | return $ SqWC (u <> real s <> tr v) |
173 | 121 | ||
174 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
175 | #else | ||
176 | coarbitrary = undefined | ||
177 | #endif | ||
178 | |||
179 | 122 | ||
180 | -- a positive definite square matrix (the eigenvalues are between 0 and 100) | 123 | -- a positive definite square matrix (the eigenvalues are between 0 and 100) |
181 | newtype (PosDef a) = PosDef (Matrix a) deriving Show | 124 | newtype (PosDef a) = PosDef (Matrix a) deriving Show |
@@ -190,11 +133,6 @@ instance (Numeric a, ArbitraryField a, Num (Vector a)) | |||
190 | p = v <> real s <> tr v | 133 | p = v <> real s <> tr v |
191 | return $ PosDef (0.5 * p + 0.5 * tr p) | 134 | return $ PosDef (0.5 * p + 0.5 * tr p) |
192 | 135 | ||
193 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
194 | #else | ||
195 | coarbitrary = undefined | ||
196 | #endif | ||
197 | |||
198 | 136 | ||
199 | -- a pair of matrices that can be multiplied | 137 | -- a pair of matrices that can be multiplied |
200 | newtype (Consistent a) = Consistent (Matrix a, Matrix a) deriving Show | 138 | newtype (Consistent a) = Consistent (Matrix a, Matrix a) deriving Show |
@@ -207,11 +145,7 @@ instance (Field a, Arbitrary a) => Arbitrary (Consistent a) where | |||
207 | lb <- vector (k*m) | 145 | lb <- vector (k*m) |
208 | return $ Consistent ((n><k) la, (k><m) lb) | 146 | return $ Consistent ((n><k) la, (k><m) lb) |
209 | 147 | ||
210 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
211 | shrink (Consistent (x,y)) = [ Consistent (u,v) | (u,v) <- shrinkPair (x,y) ] | 148 | shrink (Consistent (x,y)) = [ Consistent (u,v) | (u,v) <- shrinkPair (x,y) ] |
212 | #else | ||
213 | coarbitrary = undefined | ||
214 | #endif | ||
215 | 149 | ||
216 | 150 | ||
217 | 151 | ||
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs index 941f747..e2492dd 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs | |||
@@ -1,5 +1,4 @@ | |||
1 | {-# LANGUAGE CPP, FlexibleContexts #-} | 1 | {-# LANGUAGE FlexibleContexts #-} |
2 | {-# OPTIONS_GHC -fno-warn-unused-imports #-} | ||
3 | {-# LANGUAGE TypeFamilies #-} | 2 | {-# LANGUAGE TypeFamilies #-} |
4 | 3 | ||
5 | ----------------------------------------------------------------------------- | 4 | ----------------------------------------------------------------------------- |
@@ -44,10 +43,7 @@ module Numeric.LinearAlgebra.Tests.Properties ( | |||
44 | ) where | 43 | ) where |
45 | 44 | ||
46 | import Numeric.LinearAlgebra.HMatrix hiding (Testable)--hiding (real,complex) | 45 | import Numeric.LinearAlgebra.HMatrix hiding (Testable)--hiding (real,complex) |
47 | import Debug.Trace | 46 | import Test.QuickCheck |
48 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector | ||
49 | ,sized,classify,Testable,Property | ||
50 | ,quickCheckWith,maxSize,stdArgs,shrink) | ||
51 | 47 | ||
52 | trivial :: Testable a => Bool -> a -> Property | 48 | trivial :: Testable a => Bool -> a -> Property |
53 | trivial = (`classify` "trivial") | 49 | trivial = (`classify` "trivial") |