summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2007-06-11 12:34:06 +0000
committerAlberto Ruiz <aruiz@um.es>2007-06-11 12:34:06 +0000
commiteb28c0981f4da42c15ac267f7f6ba28d6f8bffbc (patch)
tree4c55b9c31751536fdfb5016503cf8aba3990d418 /examples
parent473df6136476dfa07331dd25a6020260c4f02a9b (diff)
ok linearSolve
Diffstat (limited to 'examples')
-rw-r--r--examples/tests.hs26
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
141data PairSM a = PairSM (Matrix a) (Matrix a) deriving Show
142instance (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
143addM m1 m2 = liftMatrix2 addV m1 m2 155addM 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
196linearSolveSQTest fun eqfun singu prod (PairSM a b) = singu a || (a <> fun a b) ==== b
197 where (<>) = prod
198 (====) = eqfun
199
184 200
201prec = 1E-15
202
203singular 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
186main = do 209main = 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
209kk = (2><2) 233kk = (2><2)
210 [ 1.0, 0.0 234 [ 1.0, 0.0