diff options
Diffstat (limited to 'examples')
-rw-r--r-- | examples/tests.hs | 70 |
1 files changed, 66 insertions, 4 deletions
diff --git a/examples/tests.hs b/examples/tests.hs index 9f0ae2a..3b1d878 100644 --- a/examples/tests.hs +++ b/examples/tests.hs | |||
@@ -8,8 +8,13 @@ import Data.Packed.Internal | |||
8 | import Data.Packed.Vector | 8 | import Data.Packed.Vector |
9 | import Data.Packed.Matrix | 9 | import Data.Packed.Matrix |
10 | import Data.Packed.Internal.Matrix | 10 | import Data.Packed.Internal.Matrix |
11 | import GSL.Vector | ||
12 | import GSL.Integration | ||
13 | import GSL.Differentiation | ||
14 | import GSL.Special | ||
11 | import LAPACK | 15 | import LAPACK |
12 | import Test.QuickCheck | 16 | import Test.QuickCheck |
17 | import Test.HUnit | ||
13 | import Complex | 18 | import Complex |
14 | 19 | ||
15 | {- | 20 | {- |
@@ -53,11 +58,18 @@ aprox fun a b = rows a == rows b && | |||
53 | 58 | ||
54 | aproxL fun v1 v2 = sum (zipWith (\a b-> fun (a-b)) v1 v2) / fromIntegral (length v1) | 59 | aproxL fun v1 v2 = sum (zipWith (\a b-> fun (a-b)) v1 v2) / fromIntegral (length v1) |
55 | 60 | ||
56 | (|~|) = aprox abs | 61 | normVR a b = toScalarR AbsSum (vectorZipR Sub a b) |
62 | |||
63 | a |~| b = rows a == rows b && cols a == cols b && eps > normVR (t a) (t b) | ||
64 | where t = if (order a == RowMajor) `xor` isTrans a then cdat else fdat | ||
65 | |||
57 | (|~~|) = aprox magnitude | 66 | (|~~|) = aprox magnitude |
58 | 67 | ||
59 | v1 ~~ v2 = reshape 1 v1 |~~| reshape 1 v2 | 68 | v1 ~~ v2 = reshape 1 v1 |~~| reshape 1 v2 |
60 | 69 | ||
70 | u ~|~ v = normVR u v < eps | ||
71 | |||
72 | |||
61 | eps = 1E-8::Double | 73 | eps = 1E-8::Double |
62 | 74 | ||
63 | asFortran m = (rows m >|< cols m) $ toList (fdat m) | 75 | asFortran m = (rows m >|< cols m) $ toList (fdat m) |
@@ -139,12 +151,24 @@ instance (Num a, Field a, Arbitrary a) => Arbitrary (PairSM a) where | |||
139 | --return $ PairSM ((a><a) l1) ((a><c) l2) | 151 | --return $ PairSM ((a><a) l1) ((a><c) l2) |
140 | coarbitrary = undefined | 152 | coarbitrary = undefined |
141 | 153 | ||
154 | instance (Field a, Arbitrary a) => Arbitrary (Vector a) where | ||
155 | arbitrary = do --m <- sized $ \max -> choose (1,1+3*max) | ||
156 | m <- choose (1,100) | ||
157 | l <- vector m | ||
158 | return $ fromList l | ||
159 | coarbitrary = undefined | ||
142 | 160 | ||
161 | data PairV a = PairV (Vector a) (Vector a) | ||
162 | instance (Field a, Arbitrary a) => Arbitrary (PairV a) where | ||
163 | arbitrary = do --m <- sized $ \max -> choose (1,1+3*max) | ||
164 | m <- choose (1,100) | ||
165 | l1 <- vector m | ||
166 | l2 <- vector m | ||
167 | return $ PairV (fromList l1) (fromList l2) | ||
168 | coarbitrary = undefined | ||
143 | 169 | ||
144 | 170 | ||
145 | addM m1 m2 = liftMatrix2 addV m1 m2 | 171 | addM m1 m2 = liftMatrix2 add m1 m2 |
146 | |||
147 | addV v1 v2 = fromList $ zipWith (+) (toList v1) (toList v2) | ||
148 | 172 | ||
149 | 173 | ||
150 | type BaseType = Double | 174 | type BaseType = Double |
@@ -220,6 +244,37 @@ pinvSVDR m = linearSolveSVDR Nothing m (ident (rows m)) | |||
220 | 244 | ||
221 | pinvSVDC m = linearSolveSVDC Nothing m (ident (rows m)) | 245 | pinvSVDC m = linearSolveSVDC Nothing m (ident (rows m)) |
222 | 246 | ||
247 | --------------------------------------------------------------------- | ||
248 | |||
249 | arit1 u = vectorMapValR PowVS 2 (vectorMapR Sin u) | ||
250 | `add` vectorMapValR PowVS 2 (vectorMapR Cos u) | ||
251 | ~|~ constant (dim u) 1 | ||
252 | |||
253 | arit2 u = (vectorMapR Cos u) `mul` (vectorMapR Tan u) | ||
254 | ~|~ vectorMapR Sin u | ||
255 | |||
256 | |||
257 | --arit3 (PairV u v) = vectorMap Sin . VectorMap Cos | ||
258 | |||
259 | --------------------------------------------------------------------- | ||
260 | |||
261 | besselTest = do | ||
262 | let (r,e) = bessel_J0_e 5.0 | ||
263 | let expected = -0.17759677131433830434739701 | ||
264 | assertBool "bessel_J0_e" ( abs (r-expected) < e ) | ||
265 | |||
266 | exponentialTest = do | ||
267 | let (v,e,err) = exp_e10_e 30.0 | ||
268 | let expected = exp 30.0 | ||
269 | assertBool "exp_e10_e" ( abs (v*10^e - expected) < 4E-2 ) | ||
270 | |||
271 | tests = TestList | ||
272 | [ TestCase $ besselTest | ||
273 | , TestCase $ exponentialTest | ||
274 | ] | ||
275 | |||
276 | ---------------------------------------------------------------------- | ||
277 | |||
223 | main = do | 278 | main = do |
224 | putStrLn "--------- general -----" | 279 | putStrLn "--------- general -----" |
225 | quickCheck (\(Sym m) -> m |=| (trans m:: Matrix BaseType)) | 280 | quickCheck (\(Sym m) -> m |=| (trans m:: Matrix BaseType)) |
@@ -255,7 +310,14 @@ main = do | |||
255 | quickCheck (pinvTest pinvC (|~~|)) | 310 | quickCheck (pinvTest pinvC (|~~|)) |
256 | quickCheck (pinvTest pinvSVDR (|~|)) | 311 | quickCheck (pinvTest pinvSVDR (|~|)) |
257 | quickCheck (pinvTest pinvSVDC (|~~|)) | 312 | quickCheck (pinvTest pinvSVDC (|~~|)) |
313 | putStrLn "--------- VEC OPER ------" | ||
314 | quickCheck arit1 | ||
315 | quickCheck arit2 | ||
316 | putStrLn "--------- GSL ------" | ||
317 | runTestTT tests | ||
258 | 318 | ||
259 | kk = (2><2) | 319 | kk = (2><2) |
260 | [ 1.0, 0.0 | 320 | [ 1.0, 0.0 |
261 | , -1.5, 1.0 ::Double] | 321 | , -1.5, 1.0 ::Double] |
322 | |||
323 | v = 11 # [0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0::Double] \ No newline at end of file | ||