hmatrix-tests 0.5.0.0 → 0.6.0.0
raw patch · 4 files changed
+96/−14 lines, 4 filesdep +binarydep ~hmatrixdep ~hmatrix-gslPVP ok
version bump matches the API change (PVP)
Dependencies added: binary
Dependency ranges changed: hmatrix, hmatrix-gsl
API changes (from Hackage documentation)
+ Numeric.LinearAlgebra.Tests: binaryTests :: IO ()
Files
- hmatrix-tests.cabal +4/−3
- src/Numeric/LinearAlgebra/Tests.hs +15/−5
- src/Numeric/LinearAlgebra/Tests/Instances.hs +34/−5
- src/Numeric/LinearAlgebra/Tests/Properties.hs +43/−1
hmatrix-tests.cabal view
@@ -1,5 +1,5 @@ Name: hmatrix-tests-Version: 0.5.0.0+Version: 0.6.0.0 License: BSD3 License-file: LICENSE Author: Alberto Ruiz@@ -28,9 +28,10 @@ Build-Depends: base >= 4 && < 5, deepseq, QuickCheck >= 2, HUnit, random,- hmatrix >= 0.17+ hmatrix >= 0.18+ , binary if flag(gsl)- Build-Depends: hmatrix-gsl >= 0.17+ Build-Depends: hmatrix-gsl >= 0.18 hs-source-dirs: src
src/Numeric/LinearAlgebra/Tests.hs view
@@ -26,6 +26,7 @@ utest, runTests, runBenchmarks+ , binaryTests -- , findNaN --, runBigTests ) where@@ -132,15 +133,17 @@ --------------------------------------------------------------------- -randomTestGaussian = c :~1~: snd (meanCov dat) where+randomTestGaussian = (unSym c) :~3~: unSym (snd (meanCov dat))+ where a = (3><3) [1,2,3, 2,4,0, -2,2,1] m = 3 |> [1,2,3]- c = a <> tr a+ c = mTm a dat = gaussianSample 7 (10^6) m c -randomTestUniform = c :~1~: snd (meanCov dat) where+randomTestUniform = c :~2~: unSym (snd (meanCov dat))+ where c = diag $ 3 |> map ((/12).(^2)) [1,2,3] dat = uniformSample 7 (10^6) [(0,1),(1,3),(3,6)] @@ -741,6 +744,15 @@ | otherwise = v where n = sqrt (v `dot` v) +binaryTests :: IO ()+binaryTests = do+ let test :: forall t . T.Testable t => t -> IO ()+ test = qCheck 100+ test vectorBinaryRoundtripProp+ test staticVectorBinaryRoundtripProp+ qCheck 30 matrixBinaryRoundtripProp+ qCheck 30 staticMatrixBinaryRoundtripProp+ -- -- | Some additional tests on big matrices. They take a few minutes. -- runBigTests :: IO () -- runBigTests = undefined@@ -944,5 +956,3 @@ luBenchN_2 luSolve' luPacked' 500 (5::R) "luSolve'.luPacked' Double " luBenchN_2 luSolve' luPacked' 500 (5::Mod 9973 I) "luSolve'.luPacked' I mod 9973" luBenchN_2 luSolve' luPacked' 500 (5::Mod 9973 Z) "luSolve'.luPacked' Z mod 9973"--
src/Numeric/LinearAlgebra/Tests/Instances.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, UndecidableInstances, FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts, UndecidableInstances, FlexibleInstances, ScopedTypeVariables #-} ----------------------------------------------------------------------------- {- | Module : Numeric.LinearAlgebra.Tests.Instances@@ -29,7 +29,11 @@ import Control.Monad(replicateM) import Test.QuickCheck(Arbitrary,arbitrary,choose,vector,sized,shrink) +import GHC.TypeLits+import Data.Proxy (Proxy(..))+import qualified Numeric.LinearAlgebra.Static as Static + shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]] shrinkListElementwise [] = [] shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ]@@ -40,15 +44,26 @@ chooseDim = sized $ \m -> choose (1,max 1 m) -instance (Field a, Arbitrary a) => Arbitrary (Vector a) where +instance (Field a, Arbitrary a) => Arbitrary (Vector a) where arbitrary = do m <- chooseDim l <- vector m return $ fromList l -- shrink any one of the components shrink = map fromList . shrinkListElementwise . toList -instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where +instance KnownNat n => Arbitrary (Static.R n) where arbitrary = do+ l <- vector n+ return (Static.fromList l)++ where+ n :: Int+ n = fromIntegral (natVal (Proxy :: Proxy n))++ shrink v = []++instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where+ arbitrary = do m <- chooseDim n <- chooseDim l <- vector (m*n)@@ -57,9 +72,23 @@ -- shrink any one of the components shrink a = map (rows a >< cols a) . shrinkListElementwise- . concat . toLists + . concat . toLists $ a +instance (KnownNat n, KnownNat m) => Arbitrary (Static.L m n) where+ arbitrary = do+ l <- vector (m * n)+ return (Static.fromList l)++ where+ m :: Int+ m = fromIntegral (natVal (Proxy :: Proxy m))++ n :: Int+ n = fromIntegral (natVal (Proxy :: Proxy n))++ shrink mat = []+ -- a square matrix newtype (Sq a) = Sq (Matrix a) deriving Show instance (Element a, Arbitrary a) => Arbitrary (Sq a) where@@ -121,7 +150,7 @@ -- a positive definite square matrix (the eigenvalues are between 0 and 100) newtype (PosDef a) = PosDef (Matrix a) deriving Show-instance (Numeric a, ArbitraryField a, Num (Vector a)) +instance (Numeric a, ArbitraryField a, Num (Vector a)) => Arbitrary (PosDef a) where arbitrary = do m <- arbitrary
src/Numeric/LinearAlgebra/Tests/Properties.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- {- |@@ -39,12 +40,25 @@ expmDiagProp, multProp1, multProp2, subProp,- linearSolveProp, linearSolvePropH, linearSolveProp2+ linearSolveProp, linearSolvePropH, linearSolveProp2,++ -- Binary properties+ vectorBinaryRoundtripProp+ , staticVectorBinaryRoundtripProp+ , matrixBinaryRoundtripProp+ , staticMatrixBinaryRoundtripProp+ , staticVectorBinaryFailProp ) where import Numeric.LinearAlgebra.HMatrix hiding (Testable,unitary)+import qualified Numeric.LinearAlgebra.Static as Static import Test.QuickCheck +import Data.Binary+import Data.Binary.Get (runGet)+import Data.Either (isLeft)+import Debug.Trace (traceShowId)+ (~=) :: Double -> Double -> Bool a ~= b = abs (a - b) < 1e-10 @@ -275,3 +289,31 @@ subProp m = m == (conj . tr . fromColumns . toRows) m +------------------------------------------------------------------++vectorBinaryRoundtripProp :: Vector Double -> Bool+vectorBinaryRoundtripProp vec = decode (encode vec) == vec++staticVectorBinaryRoundtripProp :: Static.R 5 -> Bool+staticVectorBinaryRoundtripProp vec =+ let+ decoded = decode (encode vec) :: Static.R 500+ in+ Static.extract decoded == Static.extract vec++matrixBinaryRoundtripProp :: Matrix Double -> Bool+matrixBinaryRoundtripProp mat = decode (encode mat) == mat++staticMatrixBinaryRoundtripProp :: Static.L 100 200 -> Bool+staticMatrixBinaryRoundtripProp mat =+ let+ decoded = decode (encode mat) :: Static.L 100 200+ in+ (Static.extract decoded) == (Static.extract mat)++staticVectorBinaryFailProp :: Static.R 20 -> Bool+staticVectorBinaryFailProp vec =+ let+ decoded = runGet get (encode vec) :: Either String (Static.R 50)+ in+ isLeft decoded