summaryrefslogtreecommitdiff
path: root/packages/tests/src/Numeric/LinearAlgebra/Tests.hs
diff options
context:
space:
mode:
Diffstat (limited to 'packages/tests/src/Numeric/LinearAlgebra/Tests.hs')
-rw-r--r--packages/tests/src/Numeric/LinearAlgebra/Tests.hs101
1 files changed, 2 insertions, 99 deletions
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