8 files changed, 229 insertions, 110 deletions

diff --git a/packages/tests/LICENSE b/packages/tests/LICENSE
index f2125ec..c1cafe1 100644
--- a/packages/tests/LICENSE
+++ b/packages/tests/LICENSE
@@ -1,2 +1,26 @@
-Copyright Alberto Ruiz 2010
-GPL license
+Copyright (c) 2006-2014 Alberto Ruiz and other contributors
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Alberto Ruiz nor the names of other contributors may
+      be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
diff --git a/packages/tests/hmatrix-tests.cabal b/packages/tests/hmatrix-tests.cabal
index fec2f98..0514843 100644
--- a/packages/tests/hmatrix-tests.cabal
+++ b/packages/tests/hmatrix-tests.cabal
@@ -1,5 +1,5 @@
 Name:               hmatrix-tests
-Version:            0.4
+Version:            0.4.1.0
 License:            BSD3
 License-file:       LICENSE
 Author:             Alberto Ruiz
@@ -15,18 +15,28 @@ cabal-version:      >=1.8
 
 build-type:         Simple
 
-extra-source-files: CHANGES
-                    src/tests.hs
+extra-source-files: CHANGES,
+                    src/TestBase.hs,
+                    src/TestGSL.hs,
+                    src/Benchmark.hs
+
+flag gsl
+  description: Enable GSL tests
+  default: True
 
 library
 
     Build-Depends:      base >= 4 && < 5,
-                        hmatrix >= 0.16, hmatrix-gsl >= 0.16,
-                        QuickCheck >= 2, HUnit, random
+                        QuickCheck >= 2, HUnit, random,
+                        hmatrix >= 0.16
+    if flag(gsl)
+      Build-Depends:    hmatrix-gsl >= 0.16
 
     hs-source-dirs:     src
 
     exposed-modules:    Numeric.LinearAlgebra.Tests
+    if flag(gsl)
+      exposed-modules:  Numeric.GSL.Tests
 
     other-modules:      Numeric.LinearAlgebra.Tests.Instances,
                         Numeric.LinearAlgebra.Tests.Properties
@@ -38,8 +48,30 @@ source-repository head
     type:     git
     location: https://github.com/albertoruiz/hmatrix
 
-Test-Suite basic
-    Build-Depends: base, hmatrix-tests
+
+test-suite hmatrix-base-testsuite
+    type: exitcode-stdio-1.0
+    main-is: src/TestBase.hs
+    build-depends:      base >= 4 && < 5,
+                        hmatrix-tests,
+                        QuickCheck >= 2, HUnit, random
+
+
+test-suite hmatrix-gsl-testsuite
     type: exitcode-stdio-1.0
-    main-is: src/tests.hs
+    main-is: src/TestGSL.hs
+    build-depends:      base >= 4 && < 5,
+                        hmatrix-tests,
+                        QuickCheck >= 2, HUnit, random
+    if flag(gsl)
+      buildable:        True
+    else
+      buildable:        False
 
+
+benchmark hmatrix-base-benchmark
+    type:               exitcode-stdio-1.0
+    main-is:            src/Benchmark.hs
+    build-depends:      base >= 4 && < 5,
+                        hmatrix-tests,
+                        QuickCheck >= 2, HUnit, random
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 @@
+import Numeric.LinearAlgebra.Tests
+
+main = 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 @@
+{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-incomplete-patterns #-}
+{- |
+Module      :  Numeric.GLS.Tests
+Copyright   :  (c) Alberto Ruiz 2014
+License     :  BSD3
+Maintainer  :  Alberto Ruiz
+Stability   :  provisional
+
+Tests for GSL bindings.
+
+-}
+
+module Numeric.GSL.Tests(
+    runTests
+) where
+
+import Control.Monad(when)
+import System.Exit (exitFailure)
+
+import Test.HUnit (runTestTT, failures, Test(..), errors)
+
+import Numeric.LinearAlgebra
+import Numeric.GSL
+import Numeric.LinearAlgebra.Tests (qCheck, utest)
+import Numeric.LinearAlgebra.Tests.Properties ((|~|), (~~))
+
+---------------------------------------------------------------------
+
+fittingTest = utest "levmar" (ok1 && ok2)
+    where
+    xs = map return [0 .. 39]
+    sigma = 0.1
+    ys = map return $ toList $ fromList (map (head . expModel [5,0.1,1]) xs)
+                    + scalar sigma * (randomVector 0 Gaussian 40)
+    dats = zip xs (zip ys (repeat sigma))
+    dat = zip xs ys
+
+    expModel [a,lambda,b] [t] = [a * exp (-lambda * t) + b]
+    expModelDer [a,lambda,_b] [t] = [[exp (-lambda * t), -t * a * exp(-lambda*t) , 1]]
+
+    sols = fst $ fitModelScaled 1E-4 1E-4 20 (expModel, expModelDer) dats [1,0,0]
+    sol = fst $ fitModel 1E-4 1E-4 20 (expModel, expModelDer) dat [1,0,0]
+
+    ok1 = and (zipWith f sols [5,0.1,1]) where f (x,d) r = abs (x-r)<2*d
+    ok2 = norm2 (fromList (map fst sols) - fromList sol) < 1E-5
+
+---------------------------------------------------------------------
+
+odeTest = utest "ode" (last (toLists sol) ~~ newsol)
+  where
+    sol = odeSolveV RK8pd 1E-6 1E-6 0 (l2v $ vanderpol 10) (fromList [1,0]) ts
+    ts = linspace 101 (0,100)
+    l2v f = \t -> fromList  . f t . toList
+    vanderpol mu _t [x,y] = [y, -x + mu * y * (1-x**2) ]
+    newsol = [-1.758888036617841,  8.364349410519058e-2]
+    -- oldsol = [-1.7588880332411019, 8.364348908711941e-2]
+
+---------------------------------------------------------------------
+
+rootFindingTest = TestList [ utest "root Hybrids" (fst sol1 ~~ [1,1])
+                           , utest "root Newton"  (rows (snd sol2) == 2)
+                           ]
+    where sol1 = root Hybrids 1E-7 30 (rosenbrock 1 10) [-10,-5]
+          sol2 = rootJ Newton 1E-7 30 (rosenbrock 1 10) (jacobian 1 10) [-10,-5]
+          rosenbrock a b [x,y] = [ a*(1-x), b*(y-x**2) ]
+          jacobian a b [x,_y] = [ [-a    , 0]
+                                , [-2*b*x, b] ]
+
+---------------------------------------------------------------------
+
+minimizationTest = TestList
+    [ utest "minimization conjugatefr" (minim1 f df [5,7] ~~ [1,2])
+    , utest "minimization nmsimplex2"  (minim2 f [5,7] `elem` [24,25])
+    ]
+    where f [x,y] = 10*(x-1)**2 + 20*(y-2)**2 + 30
+          df [x,y] = [20*(x-1), 40*(y-2)]
+          minim1 g dg ini = fst $ minimizeD ConjugateFR 1E-3 30 1E-2 1E-4 g dg ini
+          minim2 g ini = rows $ snd $ minimize NMSimplex2 1E-2 30 [1,1] g ini
+
+---------------------------------------------------------------------
+
+derivTest = abs (d (\x-> x * d (\y-> x+y) 1) 1 - 1) < 1E-10
+    where d f x = fst $ derivCentral 0.01 f x
+
+---------------------------------------------------------------------
+
+quad f a b = fst $ integrateQAGS 1E-9 100 f a b
+
+-- A multiple integral can be easily defined using partial application
+quad2 f a b g1 g2 = quad h a b
+    where h x = quad (f x) (g1 x) (g2 x)
+
+volSphere r = 8 * quad2 (\x y -> sqrt (r*r-x*x-y*y)) 
+                        0 r (const 0) (\x->sqrt (r*r-x*x))
+
+---------------------------------------------------------------------
+
+-- besselTest = utest "bessel_J0_e" ( abs (r-expected) < e )
+--     where (r,e) = bessel_J0_e 5.0
+--           expected = -0.17759677131433830434739701
+
+-- exponentialTest = utest "exp_e10_e" ( abs (v*10^e - expected) < 4E-2 )
+--     where (v,e,_err) = exp_e10_e 30.0
+--           expected = exp 30.0
+
+--------------------------------------------------------------------
+
+polyEval cs x = foldr (\c ac->ac*x+c) 0 cs
+
+polySolveProp p = length p <2 || last p == 0|| 1E-8 > maximum (map magnitude $ map (polyEval (map (:+0) p)) (polySolve p))
+
+
+-- | All tests must pass with a maximum dimension of about 20
+--  (some tests may fail with bigger sizes due to precision loss).
+runTests :: Int  -- ^ maximum dimension
+         -> IO ()
+runTests n = do
+    let test p = qCheck n p
+    putStrLn "------ fft"
+    test (\v -> ifft (fft v) |~| v)
+    c <- runTestTT $ TestList
+        [ fittingTest
+        , odeTest
+        , rootFindingTest
+        , minimizationTest
+        , utest "deriv" derivTest
+        , utest "integrate" (abs (volSphere 2.5 - 4/3*pi*2.5**3) < 1E-8)
+        , utest "polySolve" (polySolveProp [1,2,3,4])
+        ]
+    when (errors c + failures c > 0) exitFailure
+    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.
 module Numeric.LinearAlgebra.Tests(
 --  module Numeric.LinearAlgebra.Tests.Instances,
 --  module Numeric.LinearAlgebra.Tests.Properties,
---  qCheck, 
+   qCheck,
+   utest,
    runTests,
    runBenchmarks
 -- , findNaN
@@ -35,7 +36,6 @@ import Numeric.LinearAlgebra.Tests.Properties
 import Test.HUnit hiding ((~:),test,Testable,State)
 import System.Info
 import Data.List(foldl1')
-import Numeric.GSL
 import Prelude hiding ((^))
 import qualified Prelude
 import System.CPUTime
@@ -68,8 +68,6 @@ a ^ b = a Prelude.^ (b :: Int)
 
 utest str b = TestCase $ assertBool str b
 
-a ~~ b = fromList a |~| fromList b
-
 feye n = flipud (ident n) :: Matrix Double
 
 
@@ -98,38 +96,6 @@ detTest2 = inv1 |~| inv2 && [det1] ~~ [det2]
     (inv2,(lda,sa)) = invlndet m
     det2 = sa * exp lda
 
---------------------------------------------------------------------
-
-polyEval cs x = foldr (\c ac->ac*x+c) 0 cs
-
-polySolveProp p = length p <2 || last p == 0|| 1E-8 > maximum (map magnitude $ map (polyEval (map (:+0) p)) (polySolve p))
-
----------------------------------------------------------------------
-
-quad f a b = fst $ integrateQAGS 1E-9 100 f a b
-
--- A multiple integral can be easily defined using partial application
-quad2 f a b g1 g2 = quad h a b
-    where h x = quad (f x) (g1 x) (g2 x)
-
-volSphere r = 8 * quad2 (\x y -> sqrt (r*r-x*x-y*y)) 
-                        0 r (const 0) (\x->sqrt (r*r-x*x))
-
----------------------------------------------------------------------
-
-derivTest = abs (d (\x-> x * d (\y-> x+y) 1) 1 - 1) < 1E-10
-    where d f x = fst $ derivCentral 0.01 f x
-
----------------------------------------------------------------------
-
--- besselTest = utest "bessel_J0_e" ( abs (r-expected) < e )
---     where (r,e) = bessel_J0_e 5.0
---           expected = -0.17759677131433830434739701
-
--- exponentialTest = utest "exp_e10_e" ( abs (v*10^e - expected) < 4E-2 )
---     where (v,e,_err) = exp_e10_e 30.0
---           expected = exp 30.0
-
 ---------------------------------------------------------------------
 
 nd1 = (3><3) [ 1/2, 1/4, 1/4
@@ -155,59 +121,6 @@ expmTest2 = expm nd2 :~15~: (2><2)
  , 2.718281828459045
  , 2.718281828459045 ]
 
----------------------------------------------------------------------
-
-minimizationTest = TestList
-    [ utest "minimization conjugatefr" (minim1 f df [5,7] ~~ [1,2])
-    , utest "minimization nmsimplex2"  (minim2 f [5,7] `elem` [24,25])
-    ]
-    where f [x,y] = 10*(x-1)^2 + 20*(y-2)^2 + 30
-          df [x,y] = [20*(x-1), 40*(y-2)]
-          minim1 g dg ini = fst $ minimizeD ConjugateFR 1E-3 30 1E-2 1E-4 g dg ini
-          minim2 g ini = rows $ snd $ minimize NMSimplex2 1E-2 30 [1,1] g ini
-
----------------------------------------------------------------------
-
-rootFindingTest = TestList [ utest "root Hybrids" (fst sol1 ~~ [1,1])
-                           , utest "root Newton"  (rows (snd sol2) == 2)
-                           ]
-    where sol1 = root Hybrids 1E-7 30 (rosenbrock 1 10) [-10,-5]
-          sol2 = rootJ Newton 1E-7 30 (rosenbrock 1 10) (jacobian 1 10) [-10,-5]
-          rosenbrock a b [x,y] = [ a*(1-x), b*(y-x^2) ]
-          jacobian a b [x,_y] = [ [-a    , 0]
-                                , [-2*b*x, b] ]
-
----------------------------------------------------------------------
-
-odeTest = utest "ode" (last (toLists sol) ~~ newsol)
-  where
-    sol = odeSolveV RK8pd 1E-6 1E-6 0 (l2v $ vanderpol 10) (fromList [1,0]) ts
-    ts = linspace 101 (0,100)
-    l2v f = \t -> fromList  . f t . toList
-    vanderpol mu _t [x,y] = [y, -x + mu * y * (1-x^2) ]
-    newsol = [-1.758888036617841,  8.364349410519058e-2]
-    -- oldsol = [-1.7588880332411019, 8.364348908711941e-2]
-
----------------------------------------------------------------------
-
-fittingTest = utest "levmar" (ok1 && ok2)
-    where
-    xs = map return [0 .. 39]
-    sigma = 0.1
-    ys = map return $ toList $ fromList (map (head . expModel [5,0.1,1]) xs)
-                    + scalar sigma * (randomVector 0 Gaussian 40)
-    dats = zip xs (zip ys (repeat sigma))
-    dat = zip xs ys
-
-    expModel [a,lambda,b] [t] = [a * exp (-lambda * t) + b]
-    expModelDer [a,lambda,_b] [t] = [[exp (-lambda * t), -t * a * exp(-lambda*t) , 1]]
-
-    sols = fst $ fitModelScaled 1E-4 1E-4 20 (expModel, expModelDer) dats [1,0,0]
-    sol = fst $ fitModel 1E-4 1E-4 20 (expModel, expModelDer) dat [1,0,0]
-
-    ok1 = and (zipWith f sols [5,0.1,1]) where f (x,d) r = abs (x-r)<2*d
-    ok2 = norm2 (fromList (map fst sols) - fromList sol) < 1E-5
-
 -----------------------------------------------------
 
 mbCholTest = utest "mbCholTest" (ok1 && ok2) where
@@ -485,13 +398,33 @@ staticTest = utest "static" (fst $ checkT (undefined :: L 3 5))
 
 --------------------------------------------------------------------------------
 
+indexProp g f x = a1 == g a2 && a2 == a3 && b1 == g b2 && b2 == b3
+  where
+    l = map g (toList (f x))
+    a1 = maximum l
+    b1 = minimum l
+    a2 = x `atIndex` maxIndex x
+    b2 = x `atIndex` minIndex x
+    a3 = maxElement x
+    b3 = minElement x
+
+--------------------------------------------------------------------------------
+
 -- | All tests must pass with a maximum dimension of about 20
 --  (some tests may fail with bigger sizes due to precision loss).
 runTests :: Int  -- ^ maximum dimension
          -> IO ()
 runTests n = do
-    setErrorHandlerOff
     let test p = qCheck n p
+    putStrLn "------ index"
+    test( \m -> indexProp id flatten (single (m :: RM)) )
+    test( \v -> indexProp id id (single (v :: Vector Double)) )
+    test( \m -> indexProp id flatten (m :: RM) )
+    test( \v -> indexProp id id (v :: Vector Double) )
+    test( \m -> indexProp magnitude flatten (single (m :: CM)) )
+    test( \v -> indexProp magnitude id (single (v :: Vector (Complex Double))) )
+    test( \m -> indexProp magnitude flatten (m :: CM) )
+    test( \v -> indexProp magnitude id (v :: Vector (Complex Double)) )
     putStrLn "------ mult Double"
     test (multProp1 10 . rConsist)
     test (multProp1 10 . cConsist)
@@ -595,8 +528,6 @@ runTests n = do
     putStrLn "------ expm"
     test (expmDiagProp . complex. rSqWC)
     test (expmDiagProp . cSqWC)
-    putStrLn "------ fft"
-    test (\v -> ifft (fft v) |~| v)
     putStrLn "------ vector operations - Double"
     test (\u -> sin u ^ 2 + cos u ^ 2 |~| (1::RM))
     test $ (\u -> sin u ^ 2 + cos u ^ 2 |~| (1::CM)) . liftMatrix makeUnitary
@@ -632,11 +563,6 @@ runTests n = do
 --        , utest "gamma" (gamma 5 == 24.0)
 --        , besselTest
 --        , exponentialTest
-        , utest "deriv" derivTest
-        , utest "integrate" (abs (volSphere 2.5 - 4/3*pi*2.5^3) < 1E-8)
-        , utest "polySolve" (polySolveProp [1,2,3,4])
-        , minimizationTest
-        , rootFindingTest
         , utest "randomGaussian" randomTestGaussian
         , utest "randomUniform" randomTestUniform
         , utest "buildVector/Matrix" $
@@ -645,8 +571,6 @@ runTests n = do
         , utest "rank" $  rank ((2><3)[1,0,0,1,5*eps,0]) == 1
                        && rank ((2><3)[1,0,0,1,7*eps,0]) == 2
         , utest "block" $ fromBlocks [[ident 3,0],[0,ident 4]] == (ident 7 :: CM)
-        , odeTest
-        , fittingTest
         , mbCholTest
         , utest "offset" offsetTest
         , 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.
 -}
 
 module Numeric.LinearAlgebra.Tests.Properties (
-    dist, (|~|), (~:), Aprox((:~)),
+    dist, (|~|), (~~), (~:), Aprox((:~)),
     zeros, ones,
     square,
     unitary,
@@ -60,6 +60,8 @@ infixl 4 |~|
 a |~| b = a :~10~: b
 --a |~| b = dist a b < 10^^(-10)
 
+a ~~ b = fromList a |~| fromList b
+
 data Aprox a = (:~) a Int
 -- (~:) :: (Normed a, Num a) => Aprox a -> a -> Bool
 a :~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 @@
+import Numeric.GSL.Tests
+
+main = runTests 20