summaryrefslogtreecommitdiff
path: root/packages/tests/src/Numeric
diff options
context:
space:
mode:
Diffstat (limited to 'packages/tests/src/Numeric')
-rw-r--r--packages/tests/src/Numeric/GSL/Tests.hs130
-rw-r--r--packages/tests/src/Numeric/LinearAlgebra/Tests.hs101
-rw-r--r--packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs4
3 files changed, 135 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..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 ()
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs
index c387b5c..841b0d8 100644
--- a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs
+++ b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs
@@ -17,7 +17,8 @@ Some tests.
17module Numeric.LinearAlgebra.Tests( 17module 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
35import Test.HUnit hiding ((~:),test,Testable,State) 36import Test.HUnit hiding ((~:),test,Testable,State)
36import System.Info 37import System.Info
37import Data.List(foldl1') 38import Data.List(foldl1')
38import Numeric.GSL
39import Prelude hiding ((^)) 39import Prelude hiding ((^))
40import qualified Prelude 40import qualified Prelude
41import System.CPUTime 41import System.CPUTime
@@ -68,8 +68,6 @@ a ^ b = a Prelude.^ (b :: Int)
68 68
69utest str b = TestCase $ assertBool str b 69utest str b = TestCase $ assertBool str b
70 70
71a ~~ b = fromList a |~| fromList b
72
73feye n = flipud (ident n) :: Matrix Double 71feye 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
103polyEval cs x = foldr (\c ac->ac*x+c) 0 cs
104
105polySolveProp p = length p <2 || last p == 0|| 1E-8 > maximum (map magnitude $ map (polyEval (map (:+0) p)) (polySolve p))
106
107---------------------------------------------------------------------
108
109quad f a b = fst $ integrateQAGS 1E-9 100 f a b
110
111-- A multiple integral can be easily defined using partial application
112quad2 f a b g1 g2 = quad h a b
113 where h x = quad (f x) (g1 x) (g2 x)
114
115volSphere 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
120derivTest = 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
135nd1 = (3><3) [ 1/2, 1/4, 1/4 101nd1 = (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
160minimizationTest = 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
171rootFindingTest = 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
182odeTest = 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
193fittingTest = 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
213mbCholTest = utest "mbCholTest" (ok1 && ok2) where 126mbCholTest = utest "mbCholTest" (ok1 && ok2) where
@@ -490,7 +403,6 @@ staticTest = utest "static" (fst $ checkT (undefined :: L 3 5))
490runTests :: Int -- ^ maximum dimension 403runTests :: Int -- ^ maximum dimension
491 -> IO () 404 -> IO ()
492runTests n = do 405runTests n = do
493 setErrorHandlerOff
494 let test p = qCheck n p 406 let test p = qCheck n p
495 putStrLn "------ mult Double" 407 putStrLn "------ mult Double"
496 test (multProp1 10 . rConsist) 408 test (multProp1 10 . rConsist)
@@ -595,8 +507,6 @@ runTests n = do
595 putStrLn "------ expm" 507 putStrLn "------ expm"
596 test (expmDiagProp . complex. rSqWC) 508 test (expmDiagProp . complex. rSqWC)
597 test (expmDiagProp . cSqWC) 509 test (expmDiagProp . cSqWC)
598 putStrLn "------ fft"
599 test (\v -> ifft (fft v) |~| v)
600 putStrLn "------ vector operations - Double" 510 putStrLn "------ vector operations - Double"
601 test (\u -> sin u ^ 2 + cos u ^ 2 |~| (1::RM)) 511 test (\u -> sin u ^ 2 + cos u ^ 2 |~| (1::RM))
602 test $ (\u -> sin u ^ 2 + cos u ^ 2 |~| (1::CM)) . liftMatrix makeUnitary 512 test $ (\u -> sin u ^ 2 + cos u ^ 2 |~| (1::CM)) . liftMatrix makeUnitary
@@ -632,11 +542,6 @@ runTests n = do
632-- , utest "gamma" (gamma 5 == 24.0) 542-- , utest "gamma" (gamma 5 == 24.0)
633-- , besselTest 543-- , besselTest
634-- , exponentialTest 544-- , 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 545 , utest "randomGaussian" randomTestGaussian
641 , utest "randomUniform" randomTestUniform 546 , utest "randomUniform" randomTestUniform
642 , utest "buildVector/Matrix" $ 547 , utest "buildVector/Matrix" $
@@ -645,8 +550,6 @@ runTests n = do
645 , utest "rank" $ rank ((2><3)[1,0,0,1,5*eps,0]) == 1 550 , 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 551 && rank ((2><3)[1,0,0,1,7*eps,0]) == 2
647 , utest "block" $ fromBlocks [[ident 3,0],[0,ident 4]] == (ident 7 :: CM) 552 , utest "block" $ fromBlocks [[ident 3,0],[0,ident 4]] == (ident 7 :: CM)
648 , odeTest
649 , fittingTest
650 , mbCholTest 553 , mbCholTest
651 , utest "offset" offsetTest 554 , utest "offset" offsetTest
652 , normsVTest 555 , 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
15module Numeric.LinearAlgebra.Tests.Properties ( 15module 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 |~|
60a |~| b = a :~10~: b 60a |~| b = a :~10~: b
61--a |~| b = dist a b < 10^^(-10) 61--a |~| b = dist a b < 10^^(-10)
62 62
63a ~~ b = fromList a |~| fromList b
64
63data Aprox a = (:~) a Int 65data Aprox a = (:~) a Int
64-- (~:) :: (Normed a, Num a) => Aprox a -> a -> Bool 66-- (~:) :: (Normed a, Num a) => Aprox a -> a -> Bool
65a :~n~: b = dist a b < 10^^(-n) 67a :~n~: b = dist a b < 10^^(-n)