diff options
Diffstat (limited to 'lib/Numeric/LinearAlgebra/Tests/Instances.hs')
-rw-r--r-- | lib/Numeric/LinearAlgebra/Tests/Instances.hs | 249 |
1 files changed, 0 insertions, 249 deletions
diff --git a/lib/Numeric/LinearAlgebra/Tests/Instances.hs b/lib/Numeric/LinearAlgebra/Tests/Instances.hs deleted file mode 100644 index 6dd9cfe..0000000 --- a/lib/Numeric/LinearAlgebra/Tests/Instances.hs +++ /dev/null | |||
@@ -1,249 +0,0 @@ | |||
1 | {-# LANGUAGE FlexibleContexts, UndecidableInstances, CPP, FlexibleInstances #-} | ||
2 | {-# OPTIONS_GHC -fno-warn-unused-imports #-} | ||
3 | ----------------------------------------------------------------------------- | ||
4 | {- | | ||
5 | Module : Numeric.LinearAlgebra.Tests.Instances | ||
6 | Copyright : (c) Alberto Ruiz 2008 | ||
7 | License : GPL-style | ||
8 | |||
9 | Maintainer : Alberto Ruiz (aruiz at um dot es) | ||
10 | Stability : provisional | ||
11 | Portability : portable | ||
12 | |||
13 | Arbitrary instances for vectors, matrices. | ||
14 | |||
15 | -} | ||
16 | |||
17 | module Numeric.LinearAlgebra.Tests.Instances( | ||
18 | Sq(..), rSq,cSq, | ||
19 | Rot(..), rRot,cRot, | ||
20 | Her(..), rHer,cHer, | ||
21 | WC(..), rWC,cWC, | ||
22 | SqWC(..), rSqWC, cSqWC, | ||
23 | PosDef(..), rPosDef, cPosDef, | ||
24 | Consistent(..), rConsist, cConsist, | ||
25 | RM,CM, rM,cM, | ||
26 | FM,ZM, fM,zM | ||
27 | ) where | ||
28 | |||
29 | import System.Random | ||
30 | |||
31 | import Numeric.LinearAlgebra | ||
32 | import Control.Monad(replicateM) | ||
33 | #include "quickCheckCompat.h" | ||
34 | |||
35 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
36 | shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]] | ||
37 | shrinkListElementwise [] = [] | ||
38 | shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ] | ||
39 | ++ [ x:ys | ys <- shrinkListElementwise xs ] | ||
40 | |||
41 | shrinkPair :: (Arbitrary a, Arbitrary b) => (a,b) -> [(a,b)] | ||
42 | shrinkPair (a,b) = [ (a,x) | x <- shrink b ] ++ [ (x,b) | x <- shrink a ] | ||
43 | #endif | ||
44 | |||
45 | #if MIN_VERSION_QuickCheck(2,1,1) | ||
46 | #else | ||
47 | instance (Arbitrary a, RealFloat a) => Arbitrary (Complex a) where | ||
48 | arbitrary = do | ||
49 | re <- arbitrary | ||
50 | im <- arbitrary | ||
51 | return (re :+ im) | ||
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 | ||
60 | |||
61 | #endif | ||
62 | |||
63 | chooseDim = sized $ \m -> choose (1,max 1 m) | ||
64 | |||
65 | instance (Field a, Arbitrary a) => Arbitrary (Vector a) where | ||
66 | arbitrary = do m <- chooseDim | ||
67 | l <- vector m | ||
68 | return $ fromList l | ||
69 | |||
70 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
71 | -- shrink any one of the components | ||
72 | shrink = map fromList . shrinkListElementwise . toList | ||
73 | |||
74 | #else | ||
75 | coarbitrary = undefined | ||
76 | #endif | ||
77 | |||
78 | instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where | ||
79 | arbitrary = do | ||
80 | m <- chooseDim | ||
81 | n <- chooseDim | ||
82 | l <- vector (m*n) | ||
83 | return $ (m><n) l | ||
84 | |||
85 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
86 | -- shrink any one of the components | ||
87 | shrink a = map (rows a >< cols a) | ||
88 | . shrinkListElementwise | ||
89 | . concat . toLists | ||
90 | $ a | ||
91 | #else | ||
92 | coarbitrary = undefined | ||
93 | #endif | ||
94 | |||
95 | |||
96 | -- a square matrix | ||
97 | newtype (Sq a) = Sq (Matrix a) deriving Show | ||
98 | instance (Element a, Arbitrary a) => Arbitrary (Sq a) where | ||
99 | arbitrary = do | ||
100 | n <- chooseDim | ||
101 | l <- vector (n*n) | ||
102 | return $ Sq $ (n><n) l | ||
103 | |||
104 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
105 | shrink (Sq a) = [ Sq b | b <- shrink a ] | ||
106 | #else | ||
107 | coarbitrary = undefined | ||
108 | #endif | ||
109 | |||
110 | |||
111 | -- a unitary matrix | ||
112 | newtype (Rot a) = Rot (Matrix a) deriving Show | ||
113 | instance (Field a, Arbitrary a) => Arbitrary (Rot a) where | ||
114 | arbitrary = do | ||
115 | Sq m <- arbitrary | ||
116 | let (q,_) = qr m | ||
117 | return (Rot q) | ||
118 | |||
119 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
120 | #else | ||
121 | coarbitrary = undefined | ||
122 | #endif | ||
123 | |||
124 | |||
125 | -- a complex hermitian or real symmetric matrix | ||
126 | newtype (Her a) = Her (Matrix a) deriving Show | ||
127 | instance (Field a, Arbitrary a, Num (Vector a)) => Arbitrary (Her a) where | ||
128 | arbitrary = do | ||
129 | Sq m <- arbitrary | ||
130 | let m' = m/2 | ||
131 | return $ Her (m' + ctrans m') | ||
132 | |||
133 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
134 | #else | ||
135 | coarbitrary = undefined | ||
136 | #endif | ||
137 | |||
138 | class (Field a, Arbitrary a, Element (RealOf a), Random (RealOf a)) => ArbitraryField a | ||
139 | instance ArbitraryField Double | ||
140 | instance ArbitraryField (Complex Double) | ||
141 | |||
142 | |||
143 | -- a well-conditioned general matrix (the singular values are between 1 and 100) | ||
144 | newtype (WC a) = WC (Matrix a) deriving Show | ||
145 | instance (ArbitraryField a) => Arbitrary (WC a) where | ||
146 | arbitrary = do | ||
147 | m <- arbitrary | ||
148 | let (u,_,v) = svd m | ||
149 | r = rows m | ||
150 | c = cols m | ||
151 | n = min r c | ||
152 | sv' <- replicateM n (choose (1,100)) | ||
153 | let s = diagRect 0 (fromList sv') r c | ||
154 | return $ WC (u <> real s <> trans v) | ||
155 | |||
156 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
157 | #else | ||
158 | coarbitrary = undefined | ||
159 | #endif | ||
160 | |||
161 | |||
162 | -- a well-conditioned square matrix (the singular values are between 1 and 100) | ||
163 | newtype (SqWC a) = SqWC (Matrix a) deriving Show | ||
164 | instance (ArbitraryField a) => Arbitrary (SqWC a) where | ||
165 | arbitrary = do | ||
166 | Sq m <- arbitrary | ||
167 | let (u,_,v) = svd m | ||
168 | n = rows m | ||
169 | sv' <- replicateM n (choose (1,100)) | ||
170 | let s = diag (fromList sv') | ||
171 | return $ SqWC (u <> real s <> trans v) | ||
172 | |||
173 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
174 | #else | ||
175 | coarbitrary = undefined | ||
176 | #endif | ||
177 | |||
178 | |||
179 | -- a positive definite square matrix (the eigenvalues are between 0 and 100) | ||
180 | newtype (PosDef a) = PosDef (Matrix a) deriving Show | ||
181 | instance (ArbitraryField a, Num (Vector a)) | ||
182 | => Arbitrary (PosDef a) where | ||
183 | arbitrary = do | ||
184 | Her m <- arbitrary | ||
185 | let (_,v) = eigSH m | ||
186 | n = rows m | ||
187 | l <- replicateM n (choose (0,100)) | ||
188 | let s = diag (fromList l) | ||
189 | p = v <> real s <> ctrans v | ||
190 | return $ PosDef (0.5 * p + 0.5 * ctrans p) | ||
191 | |||
192 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
193 | #else | ||
194 | coarbitrary = undefined | ||
195 | #endif | ||
196 | |||
197 | |||
198 | -- a pair of matrices that can be multiplied | ||
199 | newtype (Consistent a) = Consistent (Matrix a, Matrix a) deriving Show | ||
200 | instance (Field a, Arbitrary a) => Arbitrary (Consistent a) where | ||
201 | arbitrary = do | ||
202 | n <- chooseDim | ||
203 | k <- chooseDim | ||
204 | m <- chooseDim | ||
205 | la <- vector (n*k) | ||
206 | lb <- vector (k*m) | ||
207 | return $ Consistent ((n><k) la, (k><m) lb) | ||
208 | |||
209 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
210 | shrink (Consistent (x,y)) = [ Consistent (u,v) | (u,v) <- shrinkPair (x,y) ] | ||
211 | #else | ||
212 | coarbitrary = undefined | ||
213 | #endif | ||
214 | |||
215 | |||
216 | |||
217 | type RM = Matrix Double | ||
218 | type CM = Matrix (Complex Double) | ||
219 | type FM = Matrix Float | ||
220 | type ZM = Matrix (Complex Float) | ||
221 | |||
222 | |||
223 | rM m = m :: RM | ||
224 | cM m = m :: CM | ||
225 | fM m = m :: FM | ||
226 | zM m = m :: ZM | ||
227 | |||
228 | |||
229 | rHer (Her m) = m :: RM | ||
230 | cHer (Her m) = m :: CM | ||
231 | |||
232 | rRot (Rot m) = m :: RM | ||
233 | cRot (Rot m) = m :: CM | ||
234 | |||
235 | rSq (Sq m) = m :: RM | ||
236 | cSq (Sq m) = m :: CM | ||
237 | |||
238 | rWC (WC m) = m :: RM | ||
239 | cWC (WC m) = m :: CM | ||
240 | |||
241 | rSqWC (SqWC m) = m :: RM | ||
242 | cSqWC (SqWC m) = m :: CM | ||
243 | |||
244 | rPosDef (PosDef m) = m :: RM | ||
245 | cPosDef (PosDef m) = m :: CM | ||
246 | |||
247 | rConsist (Consistent (a,b)) = (a,b::RM) | ||
248 | cConsist (Consistent (a,b)) = (a,b::CM) | ||
249 | |||