summaryrefslogtreecommitdiff
path: root/packages/tests/src/Numeric/GSL
diff options
context:
space:
mode:
Diffstat (limited to 'packages/tests/src/Numeric/GSL')
-rw-r--r--packages/tests/src/Numeric/GSL/Tests.hs130
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{- |
2Module : Numeric.GLS.Tests
3Copyright : (c) Alberto Ruiz 2014
4License : BSD3
5Maintainer : Alberto Ruiz
6Stability : provisional
7
8Tests for GSL bindings.
9
10-}
11
12module Numeric.GSL.Tests(
13 runTests
14) where
15
16import Control.Monad(when)
17import System.Exit (exitFailure)
18
19import Test.HUnit (runTestTT, failures, Test(..), errors)
20
21import Numeric.LinearAlgebra
22import Numeric.GSL
23import Numeric.LinearAlgebra.Tests (qCheck, utest)
24import Numeric.LinearAlgebra.Tests.Properties ((|~|), (~~))
25
26---------------------------------------------------------------------
27
28fittingTest = 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
48odeTest = 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
59rootFindingTest = 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
70minimizationTest = 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
81derivTest = 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
86quad f a b = fst $ integrateQAGS 1E-9 100 f a b
87
88-- A multiple integral can be easily defined using partial application
89quad2 f a b g1 g2 = quad h a b
90 where h x = quad (f x) (g1 x) (g2 x)
91
92volSphere 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
107polyEval cs x = foldr (\c ac->ac*x+c) 0 cs
108
109polySolveProp 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).
114runTests :: Int -- ^ maximum dimension
115 -> IO ()
116runTests 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 ()