diff options
author | Denis Laxalde <denis@laxalde.org> | 2014-06-23 22:33:42 +0200 |
---|---|---|
committer | Denis Laxalde <denis@laxalde.org> | 2014-06-24 21:59:04 +0200 |
commit | 2f0a105e86a904afef5ba340aaa7aa2514a0da57 (patch) | |
tree | c5638962b1c21cec54a60e1c079f53d79674598e /packages/tests/src/Numeric/GSL/Tests.hs | |
parent | ea299f1e482cb65d4a7371f0a5b49df2e4e62890 (diff) |
Split out GSL tests from base ones
Move GSL tests into Numeric.GSL.Tests, separate the main into TestBase.hs and
TestGSL.hs.
In hmatrix-tests.cabal:
- Split the test suite into a -base and -gsl ones
- Add a `gsl` configuration flag to select GSL tests
- Add a benchmark section
One can now run hmatrix-base tests suite and benchmarks with:
cabal configure --flag=-gsl --enable-tests --enable-benchmarks
cabal tests
cabal bench
Diffstat (limited to 'packages/tests/src/Numeric/GSL/Tests.hs')
-rw-r--r-- | packages/tests/src/Numeric/GSL/Tests.hs | 130 |
1 files changed, 130 insertions, 0 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..2eacd30 --- /dev/null +++ b/packages/tests/src/Numeric/GSL/Tests.hs | |||
@@ -0,0 +1,130 @@ | |||
1 | {- | | ||
2 | Module : Numeric.GLS.Tests | ||
3 | Copyright : (c) Alberto Ruiz 2014 | ||
4 | License : BSD3 | ||
5 | Maintainer : Alberto Ruiz | ||
6 | Stability : provisional | ||
7 | |||
8 | Tests for GSL bindings. | ||
9 | |||
10 | -} | ||
11 | |||
12 | module Numeric.GSL.Tests( | ||
13 | runTests | ||
14 | ) where | ||
15 | |||
16 | import Control.Monad(when) | ||
17 | import System.Exit (exitFailure) | ||
18 | |||
19 | import Test.HUnit (runTestTT, failures, Test(..), errors) | ||
20 | |||
21 | import Numeric.LinearAlgebra | ||
22 | import Numeric.GSL | ||
23 | import Numeric.LinearAlgebra.Tests (qCheck, utest) | ||
24 | import Numeric.LinearAlgebra.Tests.Properties ((|~|), (~~)) | ||
25 | |||
26 | --------------------------------------------------------------------- | ||
27 | |||
28 | fittingTest = utest "levmar" (ok1 && ok2) | ||
29 | where | ||
30 | xs = map return [0 .. 39] | ||
31 | sigma = 0.1 | ||
32 | ys = map return $ toList $ fromList (map (head . expModel [5,0.1,1]) xs) | ||
33 | + scalar sigma * (randomVector 0 Gaussian 40) | ||
34 | dats = zip xs (zip ys (repeat sigma)) | ||
35 | dat = zip xs ys | ||
36 | |||
37 | expModel [a,lambda,b] [t] = [a * exp (-lambda * t) + b] | ||
38 | expModelDer [a,lambda,_b] [t] = [[exp (-lambda * t), -t * a * exp(-lambda*t) , 1]] | ||
39 | |||
40 | sols = fst $ fitModelScaled 1E-4 1E-4 20 (expModel, expModelDer) dats [1,0,0] | ||
41 | sol = fst $ fitModel 1E-4 1E-4 20 (expModel, expModelDer) dat [1,0,0] | ||
42 | |||
43 | ok1 = and (zipWith f sols [5,0.1,1]) where f (x,d) r = abs (x-r)<2*d | ||
44 | ok2 = norm2 (fromList (map fst sols) - fromList sol) < 1E-5 | ||
45 | |||
46 | --------------------------------------------------------------------- | ||
47 | |||
48 | odeTest = utest "ode" (last (toLists sol) ~~ newsol) | ||
49 | where | ||
50 | sol = odeSolveV RK8pd 1E-6 1E-6 0 (l2v $ vanderpol 10) (fromList [1,0]) ts | ||
51 | ts = linspace 101 (0,100) | ||
52 | l2v f = \t -> fromList . f t . toList | ||
53 | vanderpol mu _t [x,y] = [y, -x + mu * y * (1-x^2) ] | ||
54 | newsol = [-1.758888036617841, 8.364349410519058e-2] | ||
55 | -- oldsol = [-1.7588880332411019, 8.364348908711941e-2] | ||
56 | |||
57 | --------------------------------------------------------------------- | ||
58 | |||
59 | rootFindingTest = TestList [ utest "root Hybrids" (fst sol1 ~~ [1,1]) | ||
60 | , utest "root Newton" (rows (snd sol2) == 2) | ||
61 | ] | ||
62 | where sol1 = root Hybrids 1E-7 30 (rosenbrock 1 10) [-10,-5] | ||
63 | sol2 = rootJ Newton 1E-7 30 (rosenbrock 1 10) (jacobian 1 10) [-10,-5] | ||
64 | rosenbrock a b [x,y] = [ a*(1-x), b*(y-x^2) ] | ||
65 | jacobian a b [x,_y] = [ [-a , 0] | ||
66 | , [-2*b*x, b] ] | ||
67 | |||
68 | --------------------------------------------------------------------- | ||
69 | |||
70 | minimizationTest = TestList | ||
71 | [ utest "minimization conjugatefr" (minim1 f df [5,7] ~~ [1,2]) | ||
72 | , utest "minimization nmsimplex2" (minim2 f [5,7] `elem` [24,25]) | ||
73 | ] | ||
74 | where f [x,y] = 10*(x-1)^2 + 20*(y-2)^2 + 30 | ||
75 | df [x,y] = [20*(x-1), 40*(y-2)] | ||
76 | minim1 g dg ini = fst $ minimizeD ConjugateFR 1E-3 30 1E-2 1E-4 g dg ini | ||
77 | minim2 g ini = rows $ snd $ minimize NMSimplex2 1E-2 30 [1,1] g ini | ||
78 | |||
79 | --------------------------------------------------------------------- | ||
80 | |||
81 | derivTest = abs (d (\x-> x * d (\y-> x+y) 1) 1 - 1) < 1E-10 | ||
82 | where d f x = fst $ derivCentral 0.01 f x | ||
83 | |||
84 | --------------------------------------------------------------------- | ||
85 | |||
86 | quad f a b = fst $ integrateQAGS 1E-9 100 f a b | ||
87 | |||
88 | -- A multiple integral can be easily defined using partial application | ||
89 | quad2 f a b g1 g2 = quad h a b | ||
90 | where h x = quad (f x) (g1 x) (g2 x) | ||
91 | |||
92 | volSphere r = 8 * quad2 (\x y -> sqrt (r*r-x*x-y*y)) | ||
93 | 0 r (const 0) (\x->sqrt (r*r-x*x)) | ||
94 | |||
95 | --------------------------------------------------------------------- | ||
96 | |||
97 | -- besselTest = utest "bessel_J0_e" ( abs (r-expected) < e ) | ||
98 | -- where (r,e) = bessel_J0_e 5.0 | ||
99 | -- expected = -0.17759677131433830434739701 | ||
100 | |||
101 | -- exponentialTest = utest "exp_e10_e" ( abs (v*10^e - expected) < 4E-2 ) | ||
102 | -- where (v,e,_err) = exp_e10_e 30.0 | ||
103 | -- expected = exp 30.0 | ||
104 | |||
105 | -------------------------------------------------------------------- | ||
106 | |||
107 | polyEval cs x = foldr (\c ac->ac*x+c) 0 cs | ||
108 | |||
109 | polySolveProp p = length p <2 || last p == 0|| 1E-8 > maximum (map magnitude $ map (polyEval (map (:+0) p)) (polySolve p)) | ||
110 | |||
111 | |||
112 | -- | All tests must pass with a maximum dimension of about 20 | ||
113 | -- (some tests may fail with bigger sizes due to precision loss). | ||
114 | runTests :: Int -- ^ maximum dimension | ||
115 | -> IO () | ||
116 | runTests n = do | ||
117 | let test p = qCheck n p | ||
118 | putStrLn "------ fft" | ||
119 | test (\v -> ifft (fft v) |~| v) | ||
120 | c <- runTestTT $ TestList | ||
121 | [ fittingTest | ||
122 | , odeTest | ||
123 | , rootFindingTest | ||
124 | , minimizationTest | ||
125 | , utest "deriv" derivTest | ||
126 | , utest "integrate" (abs (volSphere 2.5 - 4/3*pi*2.5^3) < 1E-8) | ||
127 | , utest "polySolve" (polySolveProp [1,2,3,4]) | ||
128 | ] | ||
129 | when (errors c + failures c > 0) exitFailure | ||
130 | return () | ||