From 8bdb87764762ef43b186bcc04caa404928df22fa Mon Sep 17 00:00:00 2001 From: Sidharth Kapur Date: Mon, 1 Feb 2016 17:40:40 -0600 Subject: some work (will probably undo this commit later) --- .../src/Numeric/LinearAlgebra/Tests/Instances.hs | 46 +++++++++++++++++++--- 1 file changed, 41 insertions(+), 5 deletions(-) (limited to 'packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs') diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs index 3d5441d..23d7e6f 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, UndecidableInstances, FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts, UndecidableInstances, FlexibleInstances, ScopedTypeVariables #-} ----------------------------------------------------------------------------- {- | Module : Numeric.LinearAlgebra.Tests.Instances @@ -29,6 +29,10 @@ import Numeric.LinearAlgebra.HMatrix hiding (vector) 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 [] = [] @@ -40,14 +44,27 @@ shrinkPair (a,b) = [ (a,x) | x <- shrink b ] ++ [ (x,b) | x <- shrink a ] 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 proxy :: Proxy n + proxy = proxy + + n :: Int + n = fromIntegral (natVal proxy) + + shrink v = [] + +instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where arbitrary = do m <- chooseDim n <- chooseDim @@ -57,9 +74,28 @@ instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where -- 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 proxyM :: Proxy m + proxyM = proxyM + + proxyN :: Proxy n + proxyN = proxyN + + m :: Int + m = fromIntegral (natVal proxyM) + + n :: Int + n = fromIntegral (natVal proxyN) + + shrink mat = [] + -- a square matrix newtype (Sq a) = Sq (Matrix a) deriving Show instance (Element a, Arbitrary a) => Arbitrary (Sq a) where @@ -121,7 +157,7 @@ instance (ArbitraryField a, Numeric a) => Arbitrary (SqWC a) where -- 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 -- cgit v1.2.3 From 7a861a58211a0fb020dca2db2767de24538648b7 Mon Sep 17 00:00:00 2001 From: Sidharth Kapur Date: Sun, 13 Mar 2016 17:28:08 -0500 Subject: Simplify test code --- .../tests/src/Numeric/LinearAlgebra/Tests/Instances.hs | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) (limited to 'packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs') diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs index 23d7e6f..3211877 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs @@ -30,7 +30,7 @@ import Control.Monad(replicateM) import Test.QuickCheck(Arbitrary,arbitrary,choose,vector,sized,shrink) import GHC.TypeLits -import Data.Proxy (Proxy) +import Data.Proxy (Proxy(..)) import qualified Numeric.LinearAlgebra.Static as Static @@ -82,17 +82,12 @@ instance (KnownNat n, KnownNat m) => Arbitrary (Static.L m n) where l <- vector (m * n) return (Static.fromList l) - where proxyM :: Proxy m - proxyM = proxyM + where + m :: Int + m = fromIntegral (natVal (Proxy :: Proxy m)) - proxyN :: Proxy n - proxyN = proxyN - - m :: Int - m = fromIntegral (natVal proxyM) - - n :: Int - n = fromIntegral (natVal proxyN) + n :: Int + n = fromIntegral (natVal (Proxy :: Proxy n)) shrink mat = [] -- cgit v1.2.3 From 80e88bbb1fef8b904e5e01d3ca6cc35a97339cda Mon Sep 17 00:00:00 2001 From: Sidharth Kapur Date: Sun, 13 Mar 2016 17:28:58 -0500 Subject: Small change to test code --- packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) (limited to 'packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs') diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs index 3211877..37f7da2 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs @@ -56,11 +56,9 @@ instance KnownNat n => Arbitrary (Static.R n) where l <- vector n return (Static.fromList l) - where proxy :: Proxy n - proxy = proxy - - n :: Int - n = fromIntegral (natVal proxy) + where + n :: Int + n = fromIntegral (natVal (Proxy :: Proxy n)) shrink v = [] -- cgit v1.2.3