summaryrefslogtreecommitdiff
path: root/examples/tests.hs
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2007-06-16 11:20:50 +0000
committerAlberto Ruiz <aruiz@um.es>2007-06-16 11:20:50 +0000
commitcc2c8c39dc088dcace0d2749cfe9180bf5fdbfd2 (patch)
tree0c33b9e728eec572ebcf5a5806f35d89cdcf8dbc /examples/tests.hs
parentf71a0a7e65f5fcd4e4e05a3cf114fc7d76419091 (diff)
differentiation, integration, special
Diffstat (limited to 'examples/tests.hs')
-rw-r--r--examples/tests.hs70
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
8import Data.Packed.Vector 8import Data.Packed.Vector
9import Data.Packed.Matrix 9import Data.Packed.Matrix
10import Data.Packed.Internal.Matrix 10import Data.Packed.Internal.Matrix
11import GSL.Vector
12import GSL.Integration
13import GSL.Differentiation
14import GSL.Special
11import LAPACK 15import LAPACK
12import Test.QuickCheck 16import Test.QuickCheck
17import Test.HUnit
13import Complex 18import Complex
14 19
15{- 20{-
@@ -53,11 +58,18 @@ aprox fun a b = rows a == rows b &&
53 58
54aproxL fun v1 v2 = sum (zipWith (\a b-> fun (a-b)) v1 v2) / fromIntegral (length v1) 59aproxL fun v1 v2 = sum (zipWith (\a b-> fun (a-b)) v1 v2) / fromIntegral (length v1)
55 60
56(|~|) = aprox abs 61normVR a b = toScalarR AbsSum (vectorZipR Sub a b)
62
63a |~| 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
59v1 ~~ v2 = reshape 1 v1 |~~| reshape 1 v2 68v1 ~~ v2 = reshape 1 v1 |~~| reshape 1 v2
60 69
70u ~|~ v = normVR u v < eps
71
72
61eps = 1E-8::Double 73eps = 1E-8::Double
62 74
63asFortran m = (rows m >|< cols m) $ toList (fdat m) 75asFortran 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
154instance (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
161data PairV a = PairV (Vector a) (Vector a)
162instance (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
145addM m1 m2 = liftMatrix2 addV m1 m2 171addM m1 m2 = liftMatrix2 add m1 m2
146
147addV v1 v2 = fromList $ zipWith (+) (toList v1) (toList v2)
148 172
149 173
150type BaseType = Double 174type BaseType = Double
@@ -220,6 +244,37 @@ pinvSVDR m = linearSolveSVDR Nothing m (ident (rows m))
220 244
221pinvSVDC m = linearSolveSVDC Nothing m (ident (rows m)) 245pinvSVDC m = linearSolveSVDC Nothing m (ident (rows m))
222 246
247---------------------------------------------------------------------
248
249arit1 u = vectorMapValR PowVS 2 (vectorMapR Sin u)
250 `add` vectorMapValR PowVS 2 (vectorMapR Cos u)
251 ~|~ constant (dim u) 1
252
253arit2 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
261besselTest = 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
266exponentialTest = 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
271tests = TestList
272 [ TestCase $ besselTest
273 , TestCase $ exponentialTest
274 ]
275
276----------------------------------------------------------------------
277
223main = do 278main = 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
259kk = (2><2) 319kk = (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
323v = 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