summaryrefslogtreecommitdiff
path: root/packages/tests/src
diff options
context:
space:
mode:
Diffstat (limited to 'packages/tests/src')
-rw-r--r--packages/tests/src/Benchmark.hs3
-rw-r--r--packages/tests/src/Numeric/GSL/Tests.hs131
-rw-r--r--packages/tests/src/Numeric/LinearAlgebra/Tests.hs122
-rw-r--r--packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs4
-rw-r--r--packages/tests/src/TestBase.hs (renamed from packages/tests/src/tests.hs)0
-rw-r--r--packages/tests/src/TestGSL.hs3
6 files changed, 163 insertions, 100 deletions
diff --git a/packages/tests/src/Benchmark.hs b/packages/tests/src/Benchmark.hs
new file mode 100644
index 0000000..b37993a
--- /dev/null
+++ b/packages/tests/src/Benchmark.hs
@@ -0,0 +1,3 @@
1import Numeric.LinearAlgebra.Tests
2
3main = runBenchmarks
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{- |
3Module : Numeric.GLS.Tests
4Copyright : (c) Alberto Ruiz 2014
5License : BSD3
6Maintainer : Alberto Ruiz
7Stability : provisional
8
9Tests for GSL bindings.
10
11-}
12
13module Numeric.GSL.Tests(
14 runTests
15) where
16
17import Control.Monad(when)
18import System.Exit (exitFailure)
19
20import Test.HUnit (runTestTT, failures, Test(..), errors)
21
22import Numeric.LinearAlgebra
23import Numeric.GSL
24import Numeric.LinearAlgebra.Tests (qCheck, utest)
25import Numeric.LinearAlgebra.Tests.Properties ((|~|), (~~))
26
27---------------------------------------------------------------------
28
29fittingTest = 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
49odeTest = 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
60rootFindingTest = 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
71minimizationTest = 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
82derivTest = 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
87quad f a b = fst $ integrateQAGS 1E-9 100 f a b
88
89-- A multiple integral can be easily defined using partial application
90quad2 f a b g1 g2 = quad h a b
91 where h x = quad (f x) (g1 x) (g2 x)
92
93volSphere 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
108polyEval cs x = foldr (\c ac->ac*x+c) 0 cs
109
110polySolveProp 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).
115runTests :: Int -- ^ maximum dimension
116 -> IO ()
117runTests 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.
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
@@ -485,13 +398,33 @@ staticTest = utest "static" (fst $ checkT (undefined :: L 3 5))
485 398
486-------------------------------------------------------------------------------- 399--------------------------------------------------------------------------------
487 400
401indexProp 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).
490runTests :: Int -- ^ maximum dimension 415runTests :: Int -- ^ maximum dimension
491 -> IO () 416 -> IO ()
492runTests n = do 417runTests 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
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)
diff --git a/packages/tests/src/tests.hs b/packages/tests/src/TestBase.hs
index 23fd675..23fd675 100644
--- a/packages/tests/src/tests.hs
+++ b/packages/tests/src/TestBase.hs
diff --git a/packages/tests/src/TestGSL.hs b/packages/tests/src/TestGSL.hs
new file mode 100644
index 0000000..112422d
--- /dev/null
+++ b/packages/tests/src/TestGSL.hs
@@ -0,0 +1,3 @@
1import Numeric.GSL.Tests
2
3main = runTests 20
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-05 12:15:04 +0000