diff options
Diffstat (limited to 'examples/tests.hs')
-rw-r--r-- | examples/tests.hs | 76 |
1 files changed, 59 insertions, 17 deletions
diff --git a/examples/tests.hs b/examples/tests.hs index 5af33ba..53436c8 100644 --- a/examples/tests.hs +++ b/examples/tests.hs | |||
@@ -81,8 +81,6 @@ cf = mulF af bc | |||
81 | 81 | ||
82 | r = mulC cc (trans cf) | 82 | r = mulC cc (trans cf) |
83 | 83 | ||
84 | ident n = diag (constant n 1) | ||
85 | |||
86 | rd = (2><2) | 84 | rd = (2><2) |
87 | [ 43492.0, 50572.0 | 85 | [ 43492.0, 50572.0 |
88 | , 102550.0, 119242.0 :: Double] | 86 | , 102550.0, 119242.0 :: Double] |
@@ -126,33 +124,64 @@ instance (Field a, Arbitrary a) => Arbitrary (SqM a) where | |||
126 | return $ SqM $ (n><n) l | 124 | return $ SqM $ (n><n) l |
127 | coarbitrary = undefined | 125 | coarbitrary = undefined |
128 | 126 | ||
127 | data Sym a = Sym (Matrix a) deriving Show | ||
128 | instance (Field a, Arbitrary a, Num a) => Arbitrary (Sym a) where | ||
129 | arbitrary = do | ||
130 | SqM m <- arbitrary | ||
131 | return $ Sym (m `addM` trans m) | ||
132 | coarbitrary = undefined | ||
129 | 133 | ||
130 | type BaseType = Double | 134 | data Her = Her (Matrix (Complex Double)) deriving Show |
135 | instance {-(Field a, Arbitrary a, Num a) =>-} Arbitrary Her where | ||
136 | arbitrary = do | ||
137 | SqM m <- arbitrary | ||
138 | return $ Her (m `addM` (liftMatrix conj) (trans m)) | ||
139 | coarbitrary = undefined | ||
140 | |||
141 | |||
142 | |||
143 | addM m1 m2 = liftMatrix2 addV m1 m2 | ||
131 | 144 | ||
145 | addV v1 v2 = fromList $ zipWith (+) (toList v1) (toList v2) | ||
132 | 146 | ||
133 | svdTestR fun prod m = u <> s <> trans v |~| m | 147 | |
148 | type BaseType = Double | ||
149 | |||
150 | svdTestR prod m = u <> s <> trans v |~| m | ||
134 | && u <> trans u |~| ident (rows m) | 151 | && u <> trans u |~| ident (rows m) |
135 | && v <> trans v |~| ident (cols m) | 152 | && v <> trans v |~| ident (cols m) |
136 | where (u,s,v) = fun m | 153 | where (u,s,v) = svdR m |
137 | (<>) = prod | 154 | (<>) = prod |
138 | 155 | ||
139 | 156 | ||
140 | svdTestC fun prod m = u <> s' <> (trans v) |~~| m | 157 | svdTestC prod m = u <> s' <> (trans v) |~~| m |
141 | && u <> (liftMatrix conj) (trans u) |~~| ident (rows m) | 158 | && u <> (liftMatrix conj) (trans u) |~~| ident (rows m) |
142 | && v <> (liftMatrix conj) (trans v) |~~| ident (cols m) | 159 | && v <> (liftMatrix conj) (trans v) |~~| ident (cols m) |
143 | where (u,s,v) = fun m | 160 | where (u,s,v) = svdC m |
144 | (<>) = prod | 161 | (<>) = prod |
145 | s' = liftMatrix comp s | 162 | s' = liftMatrix comp s |
146 | 163 | ||
147 | eigTestC fun prod (SqM m) = (m <> v) |~~| (v <> diag s) | 164 | eigTestC prod (SqM m) = (m <> v) |~~| (v <> diag s) |
148 | && takeDiag ((liftMatrix conj (trans v)) `mulC` v) ~~ constant (rows m) 1 | 165 | && takeDiag ((liftMatrix conj (trans v)) <> v) ~~ constant (rows m) 1 --normalized |
149 | where (s,v) = fun m | 166 | where (s,v) = eigC m |
167 | (<>) = prod | ||
168 | |||
169 | eigTestR prod (SqM m) = (liftMatrix comp m <> v) |~~| (v <> diag s) | ||
170 | -- && takeDiag ((liftMatrix conj (trans v)) <> v) ~~ constant (rows m) 1 --normalized ??? | ||
171 | where (s,v) = eigR m | ||
172 | (<>) = prod | ||
173 | |||
174 | eigTestS prod (Sym m) = (m <> v) |~| (v <> diag s) | ||
175 | && v <> trans v |~| ident (cols m) | ||
176 | where (s,v) = eigS m | ||
150 | (<>) = prod | 177 | (<>) = prod |
151 | 178 | ||
152 | takeDiag m = fromList [cdat m `at` (k*cols m+k) | k <- [0 .. min (rows m) (cols m) -1]] | 179 | eigTestH prod (Her m) = (m <> v) |~~| (v <> diag (comp s)) |
180 | && v <> (liftMatrix conj) (trans v) |~~| ident (cols m) | ||
181 | where (s,v) = eigH m | ||
182 | (<>) = prod | ||
153 | 183 | ||
154 | 184 | ||
155 | comp v = toComplex (v,constant (dim v) 0) | ||
156 | 185 | ||
157 | main = do | 186 | main = do |
158 | quickCheck $ \l -> null l || (toList . fromList) l == (l :: [BaseType]) | 187 | quickCheck $ \l -> null l || (toList . fromList) l == (l :: [BaseType]) |
@@ -162,8 +191,21 @@ main = do | |||
162 | quickCheck $ \(PairM m1 m2) -> mulC m1 m2 |=| mulF m1 (m2 :: Matrix BaseType) | 191 | quickCheck $ \(PairM m1 m2) -> mulC m1 m2 |=| mulF m1 (m2 :: Matrix BaseType) |
163 | quickCheck $ \(PairM m1 m2) -> mulC m1 m2 |=| trans (mulF (trans m2) (trans m1 :: Matrix BaseType)) | 192 | quickCheck $ \(PairM m1 m2) -> mulC m1 m2 |=| trans (mulF (trans m2) (trans m1 :: Matrix BaseType)) |
164 | quickCheck $ \(PairM m1 m2) -> mulC m1 m2 |=| multiplyG m1 (m2 :: Matrix BaseType) | 193 | quickCheck $ \(PairM m1 m2) -> mulC m1 m2 |=| multiplyG m1 (m2 :: Matrix BaseType) |
165 | quickCheck (svdTestR svdR mulC) | 194 | quickCheck (svdTestR mulC) |
166 | quickCheck (svdTestR svdR mulF) | 195 | quickCheck (svdTestR mulF) |
167 | quickCheck (svdTestC svdC mulC) | 196 | quickCheck (svdTestC mulC) |
168 | quickCheck (svdTestC svdC mulF) | 197 | quickCheck (svdTestC mulF) |
169 | quickCheck (eigTestC eigC mulC) | 198 | quickCheck (eigTestC mulC) |
199 | quickCheck (eigTestC mulF) | ||
200 | quickCheck (eigTestR mulC) | ||
201 | quickCheck (eigTestR mulF) | ||
202 | quickCheck (\(Sym m) -> m |=| (trans m:: Matrix BaseType)) | ||
203 | quickCheck (eigTestS mulC) | ||
204 | quickCheck (eigTestS mulF) | ||
205 | quickCheck (eigTestH mulC) | ||
206 | quickCheck (eigTestH mulF) | ||
207 | |||
208 | |||
209 | kk = (2><2) | ||
210 | [ 1.0, 0.0 | ||
211 | , -1.5, 1.0 ::Double] | ||