diff options
author | Alberto Ruiz <aruiz@um.es> | 2007-06-11 12:34:06 +0000 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2007-06-11 12:34:06 +0000 |
commit | eb28c0981f4da42c15ac267f7f6ba28d6f8bffbc (patch) | |
tree | 4c55b9c31751536fdfb5016503cf8aba3990d418 /examples/tests.hs | |
parent | 473df6136476dfa07331dd25a6020260c4f02a9b (diff) |
ok linearSolve
Diffstat (limited to 'examples/tests.hs')
-rw-r--r-- | examples/tests.hs | 26 |
1 files changed, 25 insertions, 1 deletions
diff --git a/examples/tests.hs b/examples/tests.hs index 53436c8..50f0a03 100644 --- a/examples/tests.hs +++ b/examples/tests.hs | |||
@@ -138,6 +138,18 @@ instance {-(Field a, Arbitrary a, Num a) =>-} Arbitrary Her where | |||
138 | return $ Her (m `addM` (liftMatrix conj) (trans m)) | 138 | return $ Her (m `addM` (liftMatrix conj) (trans m)) |
139 | coarbitrary = undefined | 139 | coarbitrary = undefined |
140 | 140 | ||
141 | data PairSM a = PairSM (Matrix a) (Matrix a) deriving Show | ||
142 | instance (Num a, Field a, Arbitrary a) => Arbitrary (PairSM a) where | ||
143 | arbitrary = do | ||
144 | a <- choose (1,10) | ||
145 | c <- choose (1,10) | ||
146 | l1 <- vector (a*a) | ||
147 | l2 <- vector (a*c) | ||
148 | return $ PairSM ((a><a) (map fromIntegral (l1::[Int]))) ((a><c) (map fromIntegral (l2::[Int]))) | ||
149 | --return $ PairSM ((a><a) l1) ((a><c) l2) | ||
150 | coarbitrary = undefined | ||
151 | |||
152 | |||
141 | 153 | ||
142 | 154 | ||
143 | addM m1 m2 = liftMatrix2 addV m1 m2 | 155 | addM m1 m2 = liftMatrix2 addV m1 m2 |
@@ -181,7 +193,18 @@ eigTestH prod (Her m) = (m <> v) |~~| (v <> diag (comp s)) | |||
181 | where (s,v) = eigH m | 193 | where (s,v) = eigH m |
182 | (<>) = prod | 194 | (<>) = prod |
183 | 195 | ||
196 | linearSolveSQTest fun eqfun singu prod (PairSM a b) = singu a || (a <> fun a b) ==== b | ||
197 | where (<>) = prod | ||
198 | (====) = eqfun | ||
199 | |||
184 | 200 | ||
201 | prec = 1E-15 | ||
202 | |||
203 | singular fun m = s1 < prec || s2/s1 < prec | ||
204 | where (_,ss,v) = fun m | ||
205 | s = toList ss | ||
206 | s1 = maximum s | ||
207 | s2 = minimum s | ||
185 | 208 | ||
186 | main = do | 209 | main = do |
187 | quickCheck $ \l -> null l || (toList . fromList) l == (l :: [BaseType]) | 210 | quickCheck $ \l -> null l || (toList . fromList) l == (l :: [BaseType]) |
@@ -204,7 +227,8 @@ main = do | |||
204 | quickCheck (eigTestS mulF) | 227 | quickCheck (eigTestS mulF) |
205 | quickCheck (eigTestH mulC) | 228 | quickCheck (eigTestH mulC) |
206 | quickCheck (eigTestH mulF) | 229 | quickCheck (eigTestH mulF) |
207 | 230 | quickCheck (linearSolveSQTest linearSolveR (|~|) (singular svdR') mulC) | |
231 | quickCheck (linearSolveSQTest linearSolveC (|~~|) (singular svdC') mulC) | ||
208 | 232 | ||
209 | kk = (2><2) | 233 | kk = (2><2) |
210 | [ 1.0, 0.0 | 234 | [ 1.0, 0.0 |