diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/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/hmatrix-tests.cabal b/hmatrix-tests.cabal --- a/hmatrix-tests.cabal +++ b/hmatrix-tests.cabal @@ -1,6 +1,6 @@ Name: hmatrix-tests -Version: 0.3 -License: GPL +Version: 0.4.0.1 +License: BSD3 License-file: LICENSE Author: Alberto Ruiz Maintainer: Alberto Ruiz @@ -9,24 +9,34 @@ Synopsis: Tests for hmatrix Description: Tests for hmatrix Category: Math -tested-with: GHC==7.4 +tested-with: GHC==7.8 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.14.1, - 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 @@ 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/tests.hs + 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/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/src/Benchmark.hs b/src/Benchmark.hs new file mode 100644 --- /dev/null +++ b/src/Benchmark.hs @@ -0,0 +1,3 @@ +import Numeric.LinearAlgebra.Tests + +main = runBenchmarks diff --git a/src/Numeric/GSL/Tests.hs b/src/Numeric/GSL/Tests.hs new file mode 100644 --- /dev/null +++ b/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/src/Numeric/LinearAlgebra/Tests.hs b/src/Numeric/LinearAlgebra/Tests.hs --- a/src/Numeric/LinearAlgebra/Tests.hs +++ b/src/Numeric/LinearAlgebra/Tests.hs @@ -1,14 +1,14 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-incomplete-patterns #-} +{-# LANGUAGE DataKinds #-} + ----------------------------------------------------------------------------- {- | Module : Numeric.LinearAlgebra.Tests -Copyright : (c) Alberto Ruiz 2007-11 -License : GPL-style - -Maintainer : Alberto Ruiz (aruiz at um dot es) +Copyright : (c) Alberto Ruiz 2007-14 +License : BSD3 +Maintainer : Alberto Ruiz Stability : provisional -Portability : portable Some tests. @@ -17,22 +17,25 @@ module Numeric.LinearAlgebra.Tests( -- module Numeric.LinearAlgebra.Tests.Instances, -- module Numeric.LinearAlgebra.Tests.Properties, --- qCheck, + qCheck, + utest, runTests, runBenchmarks -- , findNaN --, runBigTests ) where ---import Data.Packed.Random import Numeric.LinearAlgebra +import Numeric.LinearAlgebra.HMatrix hiding ((<>),linearSolve) +import Numeric.LinearAlgebra.Static(L) +import Numeric.LinearAlgebra.Util(col,row) +import Data.Packed import Numeric.LinearAlgebra.LAPACK import Numeric.LinearAlgebra.Tests.Instances 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 @@ -43,6 +46,8 @@ import Debug.Trace import Control.Monad(when) import Numeric.LinearAlgebra.Util hiding (ones,row,col) +import Control.Applicative +import Control.Monad(ap) import Data.Packed.ST @@ -52,6 +57,9 @@ import Test.QuickCheck.Test(isSuccess) +--eps = peps :: Double +--i = 0:+1 :: Complex Double + qCheck n x = do r <- quickCheckWithResult stdArgs {maxSize = n} x when (not $ isSuccess r) (exitFailure) @@ -60,10 +68,9 @@ utest str b = TestCase $ assertBool str b -a ~~ b = fromList a |~| fromList b - feye n = flipud (ident n) :: Matrix Double + ----------------------------------------------------------- detTest1 = det m == 26 @@ -89,40 +96,8 @@ (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 , 0/1, 1/2, 1/4 , 1/2, 1/4, 1/2 :: Double] @@ -146,59 +121,6 @@ , 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 @@ -266,9 +188,9 @@ ] where v = fromList [1,-2,3:+4] :: Vector (Complex Double) x = fromList [1,2,-3] :: Vector Double #ifndef NONORMVTEST - norm2PropR a = norm2 a =~= sqrt (dot a a) + norm2PropR a = norm2 a =~= sqrt (udot a a) #endif - norm2PropC a = norm2 a =~= realPart (sqrt (dot a (conj a))) + norm2PropC a = norm2 a =~= realPart (sqrt (a <.> a)) a =~= b = fromList [a] |~| fromList [b] normsMTest = TestList [ @@ -330,6 +252,15 @@ newtype State s a = State { runState :: s -> (a,s) } +instance Functor (State s) + where + fmap f x = pure f <*> x + +instance Applicative (State s) + where + pure = return + (<*>) = ap + instance Monad (State s) where return a = State $ \s -> (a,s) m >>= f = State $ \s -> let (a,s') = runState m s @@ -347,6 +278,15 @@ newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } +instance Monad m => Functor (MaybeT m) + where + fmap f x = pure f <*> x + +instance Monad m => Applicative (MaybeT m) + where + pure = return + (<*>) = ap + instance Monad m => Monad (MaybeT m) where return a = MaybeT $ return $ Just a m >>= f = MaybeT $ do @@ -407,8 +347,6 @@ ,26,28,30 ,39,41,43 ,52,54,56] - row = asRow . fromList - col = asColumn . fromList :: [Double] -> Matrix Double --------------------------------------------------------------------- @@ -445,21 +383,26 @@ v2 = (trans b `kronecker` a) <> vec x s = trans b <> b v3 = vec s - v4 = dup 5 <> vech s + v4 = (dup 5 :: Matrix Double) <> vech s ok = v1 == v2 && v3 == v4 && vtrans 1 a == trans a && vtrans (rows a) a == asColumn (vec a) -------------------------------------------------------------------------------- +sparseTest = utest "sparse" (fst $ checkT (undefined :: GMatrix)) +-------------------------------------------------------------------------------- +staticTest = utest "static" (fst $ checkT (undefined :: L 3 5)) + +-------------------------------------------------------------------------------- + -- | 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 "------ mult Double" test (multProp1 10 . rConsist) @@ -564,8 +507,6 @@ 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 @@ -601,21 +542,14 @@ -- , 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" $ complex (10 |> [0::Double ..]) == buildVector 10 fromIntegral && ident 5 == buildMatrix 5 5 (\(r,c) -> if r==c then 1::Double else 0) - , utest "rank" $ rank ((2><3)[1,0,0,1,6*eps,0]) == 1 + , 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 @@ -629,6 +563,8 @@ , accumTest , convolutionTest , kroneckerTest + , sparseTest + , staticTest ] when (errors c + failures c > 0) exitFailure return () @@ -640,7 +576,7 @@ makeUnitary v | realPart n > 1 = v / scalar n | otherwise = v - where n = sqrt (conj v <.> v) + where n = sqrt (v <.> v) -- -- | Some additional tests on big matrices. They take a few minutes. -- runBigTests :: IO () @@ -734,7 +670,7 @@ subBench = do putStrLn "" let g = foldl1' (.) (replicate (10^5) (\v -> subVector 1 (dim v -1) v)) - time "0.1M subVector " (g (constant 1 (1+10^5) :: Vector Double) @> 0) + time "0.1M subVector " (g (konst 1 (1+10^5) :: Vector Double) @> 0) let f = foldl1' (.) (replicate (10^5) (fromRows.toRows)) time "subVector-join 3" (f (ident 3 :: Matrix Double) @@>(0,0)) time "subVector-join 10" (f (ident 10 :: Matrix Double) @@>(0,0)) diff --git a/src/Numeric/LinearAlgebra/Tests/Instances.hs b/src/Numeric/LinearAlgebra/Tests/Instances.hs --- a/src/Numeric/LinearAlgebra/Tests/Instances.hs +++ b/src/Numeric/LinearAlgebra/Tests/Instances.hs @@ -4,11 +4,9 @@ {- | Module : Numeric.LinearAlgebra.Tests.Instances Copyright : (c) Alberto Ruiz 2008 -License : GPL-style - -Maintainer : Alberto Ruiz (aruiz at um dot es) +License : BSD3 +Maintainer : Alberto Ruiz Stability : provisional -Portability : portable Arbitrary instances for vectors, matrices. @@ -29,6 +27,8 @@ import System.Random import Numeric.LinearAlgebra +import Numeric.LinearAlgebra.Devel +import Numeric.Container import Control.Monad(replicateM) import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector ,sized,classify,Testable,Property @@ -153,7 +153,7 @@ n = min r c sv' <- replicateM n (choose (1,100)) let s = diagRect 0 (fromList sv') r c - return $ WC (u <> real s <> trans v) + return $ WC (u `mXm` real s `mXm` trans v) #if MIN_VERSION_QuickCheck(2,0,0) #else @@ -170,7 +170,7 @@ n = rows m sv' <- replicateM n (choose (1,100)) let s = diag (fromList sv') - return $ SqWC (u <> real s <> trans v) + return $ SqWC (u `mXm` real s `mXm` trans v) #if MIN_VERSION_QuickCheck(2,0,0) #else @@ -188,7 +188,7 @@ n = rows m l <- replicateM n (choose (0,100)) let s = diag (fromList l) - p = v <> real s <> ctrans v + p = v `mXm` real s `mXm` ctrans v return $ PosDef (0.5 * p + 0.5 * ctrans p) #if MIN_VERSION_QuickCheck(2,0,0) diff --git a/src/Numeric/LinearAlgebra/Tests/Properties.hs b/src/Numeric/LinearAlgebra/Tests/Properties.hs --- a/src/Numeric/LinearAlgebra/Tests/Properties.hs +++ b/src/Numeric/LinearAlgebra/Tests/Properties.hs @@ -4,18 +4,16 @@ {- | Module : Numeric.LinearAlgebra.Tests.Properties Copyright : (c) Alberto Ruiz 2008 -License : GPL-style - -Maintainer : Alberto Ruiz (aruiz at um dot es) +License : BSD3 +Maintainer : Alberto Ruiz Stability : provisional -Portability : portable Testing properties. -} module Numeric.LinearAlgebra.Tests.Properties ( - dist, (|~|), (~:), Aprox((:~)), + dist, (|~|), (~~), (~:), Aprox((:~)), zeros, ones, square, unitary, @@ -43,6 +41,7 @@ linearSolveProp, linearSolveProp2 ) where +import Numeric.Container import Numeric.LinearAlgebra --hiding (real,complex) import Numeric.LinearAlgebra.LAPACK import Debug.Trace @@ -53,24 +52,16 @@ trivial :: Testable a => Bool -> a -> Property trivial = (`classify` "trivial") - -- relative error dist :: (Normed c t, Num (c t)) => c t -> c t -> Double -dist a b = realToFrac r - where norm = pnorm Infinity - na = norm a - nb = norm b - nab = norm (a-b) - mx = max na nb - mn = min na nb - r = if mn < peps - then mx - else nab/mx +dist = relativeError Infinity 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) @@ -93,13 +84,13 @@ upperTriang m = rows m == 1 || down == z where down = fromList $ concat $ zipWith drop [1..] (toLists (ctrans m)) - z = constant 0 (dim down) + z = konst 0 (dim down) upperHessenberg m = rows m < 3 || down == z where down = fromList $ concat $ zipWith drop [2..] (toLists (ctrans m)) - z = constant 0 (dim down) + z = konst 0 (dim down) -zeros (r,c) = reshape c (constant 0 (r*c)) +zeros (r,c) = reshape c (konst 0 (r*c)) ones (r,c) = zeros (r,c) + 1 diff --git a/src/TestBase.hs b/src/TestBase.hs new file mode 100644 --- /dev/null +++ b/src/TestBase.hs @@ -0,0 +1,3 @@ +import Numeric.LinearAlgebra.Tests + +main = runTests 20 diff --git a/src/TestGSL.hs b/src/TestGSL.hs new file mode 100644 --- /dev/null +++ b/src/TestGSL.hs @@ -0,0 +1,3 @@ +import Numeric.GSL.Tests + +main = runTests 20 diff --git a/src/tests.hs b/src/tests.hs deleted file mode 100644 --- a/src/tests.hs +++ /dev/null @@ -1,3 +0,0 @@ -import Numeric.LinearAlgebra.Tests - -main = runTests 20