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