diff options
Diffstat (limited to 'packages/tests/src/Numeric')
-rw-r--r-- | packages/tests/src/Numeric/GSL/Tests.hs | 131 | ||||
-rw-r--r-- | packages/tests/src/Numeric/LinearAlgebra/Tests.hs | 122 | ||||
-rw-r--r-- | packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs | 4 |
3 files changed, 157 insertions, 100 deletions
diff --git a/packages/tests/src/Numeric/GSL/Tests.hs b/packages/tests/src/Numeric/GSL/Tests.hs new file mode 100644 index 0000000..9dff6f5 --- /dev/null +++ b/packages/tests/src/Numeric/GSL/Tests.hs | |||
@@ -0,0 +1,131 @@ | |||
1 | {-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-incomplete-patterns #-} | ||
2 | {- | | ||
3 | Module : Numeric.GLS.Tests | ||
4 | Copyright : (c) Alberto Ruiz 2014 | ||
5 | License : BSD3 | ||
6 | Maintainer : Alberto Ruiz | ||
7 | Stability : provisional | ||
8 | |||
9 | Tests for GSL bindings. | ||
10 | |||
11 | -} | ||
12 | |||
13 | module Numeric.GSL.Tests( | ||
14 | runTests | ||
15 | ) where | ||
16 | |||
17 | import Control.Monad(when) | ||
18 | import System.Exit (exitFailure) | ||
19 | |||
20 | import Test.HUnit (runTestTT, failures, Test(..), errors) | ||
21 | |||
22 | import Numeric.LinearAlgebra | ||
23 | import Numeric.GSL | ||
24 | import Numeric.LinearAlgebra.Tests (qCheck, utest) | ||
25 | import Numeric.LinearAlgebra.Tests.Properties ((|~|), (~~)) | ||
26 | |||
27 | --------------------------------------------------------------------- | ||
28 | |||
29 | fittingTest = utest "levmar" (ok1 && ok2) | ||
30 | where | ||
31 | xs = map return [0 .. 39] | ||
32 | sigma = 0.1 | ||
33 | ys = map return $ toList $ fromList (map (head . expModel [5,0.1,1]) xs) | ||
34 | + scalar sigma * (randomVector 0 Gaussian 40) | ||
35 | dats = zip xs (zip ys (repeat sigma)) | ||
36 | dat = zip xs ys | ||
37 | |||
38 | expModel [a,lambda,b] [t] = [a * exp (-lambda * t) + b] | ||
39 | expModelDer [a,lambda,_b] [t] = [[exp (-lambda * t), -t * a * exp(-lambda*t) , 1]] | ||
40 | |||
41 | sols = fst $ fitModelScaled 1E-4 1E-4 20 (expModel, expModelDer) dats [1,0,0] | ||
42 | sol = fst $ fitModel 1E-4 1E-4 20 (expModel, expModelDer) dat [1,0,0] | ||
43 | |||
44 | ok1 = and (zipWith f sols [5,0.1,1]) where f (x,d) r = abs (x-r)<2*d | ||
45 | ok2 = norm2 (fromList (map fst sols) - fromList sol) < 1E-5 | ||
46 | |||
47 | --------------------------------------------------------------------- | ||
48 | |||
49 | odeTest = utest "ode" (last (toLists sol) ~~ newsol) | ||
50 | where | ||
51 | sol = odeSolveV RK8pd 1E-6 1E-6 0 (l2v $ vanderpol 10) (fromList [1,0]) ts | ||
52 | ts = linspace 101 (0,100) | ||
53 | l2v f = \t -> fromList . f t . toList | ||
54 | vanderpol mu _t [x,y] = [y, -x + mu * y * (1-x**2) ] | ||
55 | newsol = [-1.758888036617841, 8.364349410519058e-2] | ||
56 | -- oldsol = [-1.7588880332411019, 8.364348908711941e-2] | ||
57 | |||
58 | --------------------------------------------------------------------- | ||
59 | |||
60 | rootFindingTest = TestList [ utest "root Hybrids" (fst sol1 ~~ [1,1]) | ||
61 | , utest "root Newton" (rows (snd sol2) == 2) | ||
62 | ] | ||
63 | where sol1 = root Hybrids 1E-7 30 (rosenbrock 1 10) [-10,-5] | ||
64 | sol2 = rootJ Newton 1E-7 30 (rosenbrock 1 10) (jacobian 1 10) [-10,-5] | ||
65 | rosenbrock a b [x,y] = [ a*(1-x), b*(y-x**2) ] | ||
66 | jacobian a b [x,_y] = [ [-a , 0] | ||
67 | , [-2*b*x, b] ] | ||
68 | |||
69 | --------------------------------------------------------------------- | ||
70 | |||
71 | minimizationTest = TestList | ||
72 | [ utest "minimization conjugatefr" (minim1 f df [5,7] ~~ [1,2]) | ||
73 | , utest "minimization nmsimplex2" (minim2 f [5,7] `elem` [24,25]) | ||
74 | ] | ||
75 | where f [x,y] = 10*(x-1)**2 + 20*(y-2)**2 + 30 | ||
76 | df [x,y] = [20*(x-1), 40*(y-2)] | ||
77 | minim1 g dg ini = fst $ minimizeD ConjugateFR 1E-3 30 1E-2 1E-4 g dg ini | ||
78 | minim2 g ini = rows $ snd $ minimize NMSimplex2 1E-2 30 [1,1] g ini | ||
79 | |||
80 | --------------------------------------------------------------------- | ||
81 | |||
82 | derivTest = abs (d (\x-> x * d (\y-> x+y) 1) 1 - 1) < 1E-10 | ||
83 | where d f x = fst $ derivCentral 0.01 f x | ||
84 | |||
85 | --------------------------------------------------------------------- | ||
86 | |||
87 | quad f a b = fst $ integrateQAGS 1E-9 100 f a b | ||
88 | |||
89 | -- A multiple integral can be easily defined using partial application | ||
90 | quad2 f a b g1 g2 = quad h a b | ||
91 | where h x = quad (f x) (g1 x) (g2 x) | ||
92 | |||
93 | volSphere r = 8 * quad2 (\x y -> sqrt (r*r-x*x-y*y)) | ||
94 | 0 r (const 0) (\x->sqrt (r*r-x*x)) | ||
95 | |||
96 | --------------------------------------------------------------------- | ||
97 | |||
98 | -- besselTest = utest "bessel_J0_e" ( abs (r-expected) < e ) | ||
99 | -- where (r,e) = bessel_J0_e 5.0 | ||
100 | -- expected = -0.17759677131433830434739701 | ||
101 | |||
102 | -- exponentialTest = utest "exp_e10_e" ( abs (v*10^e - expected) < 4E-2 ) | ||
103 | -- where (v,e,_err) = exp_e10_e 30.0 | ||
104 | -- expected = exp 30.0 | ||
105 | |||
106 | -------------------------------------------------------------------- | ||
107 | |||
108 | polyEval cs x = foldr (\c ac->ac*x+c) 0 cs | ||
109 | |||
110 | polySolveProp p = length p <2 || last p == 0|| 1E-8 > maximum (map magnitude $ map (polyEval (map (:+0) p)) (polySolve p)) | ||
111 | |||
112 | |||
113 | -- | All tests must pass with a maximum dimension of about 20 | ||
114 | -- (some tests may fail with bigger sizes due to precision loss). | ||
115 | runTests :: Int -- ^ maximum dimension | ||
116 | -> IO () | ||
117 | runTests n = do | ||
118 | let test p = qCheck n p | ||
119 | putStrLn "------ fft" | ||
120 | test (\v -> ifft (fft v) |~| v) | ||
121 | c <- runTestTT $ TestList | ||
122 | [ fittingTest | ||
123 | , odeTest | ||
124 | , rootFindingTest | ||
125 | , minimizationTest | ||
126 | , utest "deriv" derivTest | ||
127 | , utest "integrate" (abs (volSphere 2.5 - 4/3*pi*2.5**3) < 1E-8) | ||
128 | , utest "polySolve" (polySolveProp [1,2,3,4]) | ||
129 | ] | ||
130 | when (errors c + failures c > 0) exitFailure | ||
131 | return () | ||
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs index c387b5c..8587561 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs | |||
@@ -17,7 +17,8 @@ Some tests. | |||
17 | module Numeric.LinearAlgebra.Tests( | 17 | module Numeric.LinearAlgebra.Tests( |
18 | -- module Numeric.LinearAlgebra.Tests.Instances, | 18 | -- module Numeric.LinearAlgebra.Tests.Instances, |
19 | -- module Numeric.LinearAlgebra.Tests.Properties, | 19 | -- module Numeric.LinearAlgebra.Tests.Properties, |
20 | -- qCheck, | 20 | qCheck, |
21 | utest, | ||
21 | runTests, | 22 | runTests, |
22 | runBenchmarks | 23 | runBenchmarks |
23 | -- , findNaN | 24 | -- , findNaN |
@@ -35,7 +36,6 @@ import Numeric.LinearAlgebra.Tests.Properties | |||
35 | import Test.HUnit hiding ((~:),test,Testable,State) | 36 | import Test.HUnit hiding ((~:),test,Testable,State) |
36 | import System.Info | 37 | import System.Info |
37 | import Data.List(foldl1') | 38 | import Data.List(foldl1') |
38 | import Numeric.GSL | ||
39 | import Prelude hiding ((^)) | 39 | import Prelude hiding ((^)) |
40 | import qualified Prelude | 40 | import qualified Prelude |
41 | import System.CPUTime | 41 | import System.CPUTime |
@@ -68,8 +68,6 @@ a ^ b = a Prelude.^ (b :: Int) | |||
68 | 68 | ||
69 | utest str b = TestCase $ assertBool str b | 69 | utest str b = TestCase $ assertBool str b |
70 | 70 | ||
71 | a ~~ b = fromList a |~| fromList b | ||
72 | |||
73 | feye n = flipud (ident n) :: Matrix Double | 71 | feye n = flipud (ident n) :: Matrix Double |
74 | 72 | ||
75 | 73 | ||
@@ -98,38 +96,6 @@ detTest2 = inv1 |~| inv2 && [det1] ~~ [det2] | |||
98 | (inv2,(lda,sa)) = invlndet m | 96 | (inv2,(lda,sa)) = invlndet m |
99 | det2 = sa * exp lda | 97 | det2 = sa * exp lda |
100 | 98 | ||
101 | -------------------------------------------------------------------- | ||
102 | |||
103 | polyEval cs x = foldr (\c ac->ac*x+c) 0 cs | ||
104 | |||
105 | polySolveProp p = length p <2 || last p == 0|| 1E-8 > maximum (map magnitude $ map (polyEval (map (:+0) p)) (polySolve p)) | ||
106 | |||
107 | --------------------------------------------------------------------- | ||
108 | |||
109 | quad f a b = fst $ integrateQAGS 1E-9 100 f a b | ||
110 | |||
111 | -- A multiple integral can be easily defined using partial application | ||
112 | quad2 f a b g1 g2 = quad h a b | ||
113 | where h x = quad (f x) (g1 x) (g2 x) | ||
114 | |||
115 | volSphere r = 8 * quad2 (\x y -> sqrt (r*r-x*x-y*y)) | ||
116 | 0 r (const 0) (\x->sqrt (r*r-x*x)) | ||
117 | |||
118 | --------------------------------------------------------------------- | ||
119 | |||
120 | derivTest = abs (d (\x-> x * d (\y-> x+y) 1) 1 - 1) < 1E-10 | ||
121 | where d f x = fst $ derivCentral 0.01 f x | ||
122 | |||
123 | --------------------------------------------------------------------- | ||
124 | |||
125 | -- besselTest = utest "bessel_J0_e" ( abs (r-expected) < e ) | ||
126 | -- where (r,e) = bessel_J0_e 5.0 | ||
127 | -- expected = -0.17759677131433830434739701 | ||
128 | |||
129 | -- exponentialTest = utest "exp_e10_e" ( abs (v*10^e - expected) < 4E-2 ) | ||
130 | -- where (v,e,_err) = exp_e10_e 30.0 | ||
131 | -- expected = exp 30.0 | ||
132 | |||
133 | --------------------------------------------------------------------- | 99 | --------------------------------------------------------------------- |
134 | 100 | ||
135 | nd1 = (3><3) [ 1/2, 1/4, 1/4 | 101 | nd1 = (3><3) [ 1/2, 1/4, 1/4 |
@@ -155,59 +121,6 @@ expmTest2 = expm nd2 :~15~: (2><2) | |||
155 | , 2.718281828459045 | 121 | , 2.718281828459045 |
156 | , 2.718281828459045 ] | 122 | , 2.718281828459045 ] |
157 | 123 | ||
158 | --------------------------------------------------------------------- | ||
159 | |||
160 | minimizationTest = TestList | ||
161 | [ utest "minimization conjugatefr" (minim1 f df [5,7] ~~ [1,2]) | ||
162 | , utest "minimization nmsimplex2" (minim2 f [5,7] `elem` [24,25]) | ||
163 | ] | ||
164 | where f [x,y] = 10*(x-1)^2 + 20*(y-2)^2 + 30 | ||
165 | df [x,y] = [20*(x-1), 40*(y-2)] | ||
166 | minim1 g dg ini = fst $ minimizeD ConjugateFR 1E-3 30 1E-2 1E-4 g dg ini | ||
167 | minim2 g ini = rows $ snd $ minimize NMSimplex2 1E-2 30 [1,1] g ini | ||
168 | |||
169 | --------------------------------------------------------------------- | ||
170 | |||
171 | rootFindingTest = TestList [ utest "root Hybrids" (fst sol1 ~~ [1,1]) | ||
172 | , utest "root Newton" (rows (snd sol2) == 2) | ||
173 | ] | ||
174 | where sol1 = root Hybrids 1E-7 30 (rosenbrock 1 10) [-10,-5] | ||
175 | sol2 = rootJ Newton 1E-7 30 (rosenbrock 1 10) (jacobian 1 10) [-10,-5] | ||
176 | rosenbrock a b [x,y] = [ a*(1-x), b*(y-x^2) ] | ||
177 | jacobian a b [x,_y] = [ [-a , 0] | ||
178 | , [-2*b*x, b] ] | ||
179 | |||
180 | --------------------------------------------------------------------- | ||
181 | |||
182 | odeTest = utest "ode" (last (toLists sol) ~~ newsol) | ||
183 | where | ||
184 | sol = odeSolveV RK8pd 1E-6 1E-6 0 (l2v $ vanderpol 10) (fromList [1,0]) ts | ||
185 | ts = linspace 101 (0,100) | ||
186 | l2v f = \t -> fromList . f t . toList | ||
187 | vanderpol mu _t [x,y] = [y, -x + mu * y * (1-x^2) ] | ||
188 | newsol = [-1.758888036617841, 8.364349410519058e-2] | ||
189 | -- oldsol = [-1.7588880332411019, 8.364348908711941e-2] | ||
190 | |||
191 | --------------------------------------------------------------------- | ||
192 | |||
193 | fittingTest = utest "levmar" (ok1 && ok2) | ||
194 | where | ||
195 | xs = map return [0 .. 39] | ||
196 | sigma = 0.1 | ||
197 | ys = map return $ toList $ fromList (map (head . expModel [5,0.1,1]) xs) | ||
198 | + scalar sigma * (randomVector 0 Gaussian 40) | ||
199 | dats = zip xs (zip ys (repeat sigma)) | ||
200 | dat = zip xs ys | ||
201 | |||
202 | expModel [a,lambda,b] [t] = [a * exp (-lambda * t) + b] | ||
203 | expModelDer [a,lambda,_b] [t] = [[exp (-lambda * t), -t * a * exp(-lambda*t) , 1]] | ||
204 | |||
205 | sols = fst $ fitModelScaled 1E-4 1E-4 20 (expModel, expModelDer) dats [1,0,0] | ||
206 | sol = fst $ fitModel 1E-4 1E-4 20 (expModel, expModelDer) dat [1,0,0] | ||
207 | |||
208 | ok1 = and (zipWith f sols [5,0.1,1]) where f (x,d) r = abs (x-r)<2*d | ||
209 | ok2 = norm2 (fromList (map fst sols) - fromList sol) < 1E-5 | ||
210 | |||
211 | ----------------------------------------------------- | 124 | ----------------------------------------------------- |
212 | 125 | ||
213 | mbCholTest = utest "mbCholTest" (ok1 && ok2) where | 126 | mbCholTest = utest "mbCholTest" (ok1 && ok2) where |
@@ -485,13 +398,33 @@ staticTest = utest "static" (fst $ checkT (undefined :: L 3 5)) | |||
485 | 398 | ||
486 | -------------------------------------------------------------------------------- | 399 | -------------------------------------------------------------------------------- |
487 | 400 | ||
401 | indexProp g f x = a1 == g a2 && a2 == a3 && b1 == g b2 && b2 == b3 | ||
402 | where | ||
403 | l = map g (toList (f x)) | ||
404 | a1 = maximum l | ||
405 | b1 = minimum l | ||
406 | a2 = x `atIndex` maxIndex x | ||
407 | b2 = x `atIndex` minIndex x | ||
408 | a3 = maxElement x | ||
409 | b3 = minElement x | ||
410 | |||
411 | -------------------------------------------------------------------------------- | ||
412 | |||
488 | -- | All tests must pass with a maximum dimension of about 20 | 413 | -- | All tests must pass with a maximum dimension of about 20 |
489 | -- (some tests may fail with bigger sizes due to precision loss). | 414 | -- (some tests may fail with bigger sizes due to precision loss). |
490 | runTests :: Int -- ^ maximum dimension | 415 | runTests :: Int -- ^ maximum dimension |
491 | -> IO () | 416 | -> IO () |
492 | runTests n = do | 417 | runTests n = do |
493 | setErrorHandlerOff | ||
494 | let test p = qCheck n p | 418 | let test p = qCheck n p |
419 | putStrLn "------ index" | ||
420 | test( \m -> indexProp id flatten (single (m :: RM)) ) | ||
421 | test( \v -> indexProp id id (single (v :: Vector Double)) ) | ||
422 | test( \m -> indexProp id flatten (m :: RM) ) | ||
423 | test( \v -> indexProp id id (v :: Vector Double) ) | ||
424 | test( \m -> indexProp magnitude flatten (single (m :: CM)) ) | ||
425 | test( \v -> indexProp magnitude id (single (v :: Vector (Complex Double))) ) | ||
426 | test( \m -> indexProp magnitude flatten (m :: CM) ) | ||
427 | test( \v -> indexProp magnitude id (v :: Vector (Complex Double)) ) | ||
495 | putStrLn "------ mult Double" | 428 | putStrLn "------ mult Double" |
496 | test (multProp1 10 . rConsist) | 429 | test (multProp1 10 . rConsist) |
497 | test (multProp1 10 . cConsist) | 430 | test (multProp1 10 . cConsist) |
@@ -595,8 +528,6 @@ runTests n = do | |||
595 | putStrLn "------ expm" | 528 | putStrLn "------ expm" |
596 | test (expmDiagProp . complex. rSqWC) | 529 | test (expmDiagProp . complex. rSqWC) |
597 | test (expmDiagProp . cSqWC) | 530 | test (expmDiagProp . cSqWC) |
598 | putStrLn "------ fft" | ||
599 | test (\v -> ifft (fft v) |~| v) | ||
600 | putStrLn "------ vector operations - Double" | 531 | putStrLn "------ vector operations - Double" |
601 | test (\u -> sin u ^ 2 + cos u ^ 2 |~| (1::RM)) | 532 | test (\u -> sin u ^ 2 + cos u ^ 2 |~| (1::RM)) |
602 | test $ (\u -> sin u ^ 2 + cos u ^ 2 |~| (1::CM)) . liftMatrix makeUnitary | 533 | test $ (\u -> sin u ^ 2 + cos u ^ 2 |~| (1::CM)) . liftMatrix makeUnitary |
@@ -632,11 +563,6 @@ runTests n = do | |||
632 | -- , utest "gamma" (gamma 5 == 24.0) | 563 | -- , utest "gamma" (gamma 5 == 24.0) |
633 | -- , besselTest | 564 | -- , besselTest |
634 | -- , exponentialTest | 565 | -- , exponentialTest |
635 | , utest "deriv" derivTest | ||
636 | , utest "integrate" (abs (volSphere 2.5 - 4/3*pi*2.5^3) < 1E-8) | ||
637 | , utest "polySolve" (polySolveProp [1,2,3,4]) | ||
638 | , minimizationTest | ||
639 | , rootFindingTest | ||
640 | , utest "randomGaussian" randomTestGaussian | 566 | , utest "randomGaussian" randomTestGaussian |
641 | , utest "randomUniform" randomTestUniform | 567 | , utest "randomUniform" randomTestUniform |
642 | , utest "buildVector/Matrix" $ | 568 | , utest "buildVector/Matrix" $ |
@@ -645,8 +571,6 @@ runTests n = do | |||
645 | , utest "rank" $ rank ((2><3)[1,0,0,1,5*eps,0]) == 1 | 571 | , utest "rank" $ rank ((2><3)[1,0,0,1,5*eps,0]) == 1 |
646 | && rank ((2><3)[1,0,0,1,7*eps,0]) == 2 | 572 | && rank ((2><3)[1,0,0,1,7*eps,0]) == 2 |
647 | , utest "block" $ fromBlocks [[ident 3,0],[0,ident 4]] == (ident 7 :: CM) | 573 | , utest "block" $ fromBlocks [[ident 3,0],[0,ident 4]] == (ident 7 :: CM) |
648 | , odeTest | ||
649 | , fittingTest | ||
650 | , mbCholTest | 574 | , mbCholTest |
651 | , utest "offset" offsetTest | 575 | , utest "offset" offsetTest |
652 | , normsVTest | 576 | , normsVTest |
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs index d6ec957..9bdf897 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs | |||
@@ -13,7 +13,7 @@ Testing properties. | |||
13 | -} | 13 | -} |
14 | 14 | ||
15 | module Numeric.LinearAlgebra.Tests.Properties ( | 15 | module Numeric.LinearAlgebra.Tests.Properties ( |
16 | dist, (|~|), (~:), Aprox((:~)), | 16 | dist, (|~|), (~~), (~:), Aprox((:~)), |
17 | zeros, ones, | 17 | zeros, ones, |
18 | square, | 18 | square, |
19 | unitary, | 19 | unitary, |
@@ -60,6 +60,8 @@ infixl 4 |~| | |||
60 | a |~| b = a :~10~: b | 60 | a |~| b = a :~10~: b |
61 | --a |~| b = dist a b < 10^^(-10) | 61 | --a |~| b = dist a b < 10^^(-10) |
62 | 62 | ||
63 | a ~~ b = fromList a |~| fromList b | ||
64 | |||
63 | data Aprox a = (:~) a Int | 65 | data Aprox a = (:~) a Int |
64 | -- (~:) :: (Normed a, Num a) => Aprox a -> a -> Bool | 66 | -- (~:) :: (Normed a, Num a) => Aprox a -> a -> Bool |
65 | a :~n~: b = dist a b < 10^^(-n) | 67 | a :~n~: b = dist a b < 10^^(-n) |