summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--packages/Makefile19
-rw-r--r--packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs72
-rw-r--r--packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs8
3 files changed, 19 insertions, 80 deletions
diff --git a/packages/Makefile b/packages/Makefile
index 547cf51..b00d71f 100644
--- a/packages/Makefile
+++ b/packages/Makefile
@@ -1,17 +1,26 @@
1pkgs=base gsl special glpk tests ../../hTensor ../../easyVision/packages/tools ../../easyVision/packages/base 1pkgs=base gsl special glpk tests ../../hTensor ../../easyVision/packages/tools ../../easyVision/packages/base
2 2
3mkl=--extra-include-dirs=$(MKL) --extra-lib-dirs=$(MKL)
4
3cabalcmd = \ 5cabalcmd = \
4 for p in $(1); do \ 6 for p in $(1); do \
5 if [ -e $$p ]; then \ 7 if [ -e $$p ]; then \
6 cd $$p; cabal $(2) ; cd -; \ 8 cd $$p; cabal $(2) ; cd -; \
7 fi; \ 9 fi; \
8 done \ 10 done; \
9 cd sparse; \ 11 cd sparse; \
10 cabal install --extra-include-dirs=$(MKL) --extra-lib-dirs=$(MKL) $(2); cd -; 12 cabal $(3) $(2); cd -;
13
11 14
12all: 15all:
13 $(call cabalcmd, $(pkgs), install --force-reinstall --enable-documentation) 16 $(call cabalcmd, $(pkgs), install --force-reinstall --enable-documentation, $(mkl))
14 17
15fast: 18fast:
16 $(call cabalcmd, $(pkgs), install --force-reinstall) 19 $(call cabalcmd, $(pkgs), install --force-reinstall, $(mkl))
20
21clean:
22 $(call cabalcmd, $(pkgs), clean)
23
24prof:
25 $(call cabalcmd, $(pkgs), install --force-reinstall --enable-library-profiling, $(mkl))
17 26
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs
index e2c3840..904ae05 100644
--- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs
+++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs
@@ -1,5 +1,4 @@
1{-# LANGUAGE FlexibleContexts, UndecidableInstances, CPP, FlexibleInstances #-} 1{-# LANGUAGE FlexibleContexts, UndecidableInstances, FlexibleInstances #-}
2{-# OPTIONS_GHC -fno-warn-unused-imports #-}
3----------------------------------------------------------------------------- 2-----------------------------------------------------------------------------
4{- | 3{- |
5Module : Numeric.LinearAlgebra.Tests.Instances 4Module : Numeric.LinearAlgebra.Tests.Instances
@@ -27,13 +26,10 @@ module Numeric.LinearAlgebra.Tests.Instances(
27import System.Random 26import System.Random
28 27
29import Numeric.LinearAlgebra.HMatrix hiding (vector) 28import Numeric.LinearAlgebra.HMatrix hiding (vector)
30import Numeric.LinearAlgebra.Devel
31import Control.Monad(replicateM) 29import Control.Monad(replicateM)
32import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector 30import Test.QuickCheck(Arbitrary,arbitrary,choose,vector,sized,shrink)
33 ,sized,classify,Testable,Property 31
34 ,quickCheckWith,maxSize,stdArgs,shrink)
35 32
36#if MIN_VERSION_QuickCheck(2,0,0)
37shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]] 33shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]]
38shrinkListElementwise [] = [] 34shrinkListElementwise [] = []
39shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ] 35shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ]
@@ -41,25 +37,6 @@ shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ]
41 37
42shrinkPair :: (Arbitrary a, Arbitrary b) => (a,b) -> [(a,b)] 38shrinkPair :: (Arbitrary a, Arbitrary b) => (a,b) -> [(a,b)]
43shrinkPair (a,b) = [ (a,x) | x <- shrink b ] ++ [ (x,b) | x <- shrink a ] 39shrinkPair (a,b) = [ (a,x) | x <- shrink b ] ++ [ (x,b) | x <- shrink a ]
44#endif
45
46#if MIN_VERSION_QuickCheck(2,1,1)
47#else
48instance (Arbitrary a, RealFloat a) => Arbitrary (Complex a) where
49 arbitrary = do
50 re <- arbitrary
51 im <- arbitrary
52 return (re :+ im)
53
54#if MIN_VERSION_QuickCheck(2,0,0)
55 shrink (re :+ im) =
56 [ u :+ v | (u,v) <- shrinkPair (re,im) ]
57#else
58 -- this has been moved to the 'Coarbitrary' class in QuickCheck 2
59 coarbitrary = undefined
60#endif
61
62#endif
63 40
64chooseDim = sized $ \m -> choose (1,max 1 m) 41chooseDim = sized $ \m -> choose (1,max 1 m)
65 42
@@ -67,15 +44,9 @@ instance (Field a, Arbitrary a) => Arbitrary (Vector a) where
67 arbitrary = do m <- chooseDim 44 arbitrary = do m <- chooseDim
68 l <- vector m 45 l <- vector m
69 return $ fromList l 46 return $ fromList l
70
71#if MIN_VERSION_QuickCheck(2,0,0)
72 -- shrink any one of the components 47 -- shrink any one of the components
73 shrink = map fromList . shrinkListElementwise . toList 48 shrink = map fromList . shrinkListElementwise . toList
74 49
75#else
76 coarbitrary = undefined
77#endif
78
79instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where 50instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where
80 arbitrary = do 51 arbitrary = do
81 m <- chooseDim 52 m <- chooseDim
@@ -83,16 +54,11 @@ instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where
83 l <- vector (m*n) 54 l <- vector (m*n)
84 return $ (m><n) l 55 return $ (m><n) l
85 56
86#if MIN_VERSION_QuickCheck(2,0,0)
87 -- shrink any one of the components 57 -- shrink any one of the components
88 shrink a = map (rows a >< cols a) 58 shrink a = map (rows a >< cols a)
89 . shrinkListElementwise 59 . shrinkListElementwise
90 . concat . toLists 60 . concat . toLists
91 $ a 61 $ a
92#else
93 coarbitrary = undefined
94#endif
95
96 62
97-- a square matrix 63-- a square matrix
98newtype (Sq a) = Sq (Matrix a) deriving Show 64newtype (Sq a) = Sq (Matrix a) deriving Show
@@ -102,11 +68,7 @@ instance (Element a, Arbitrary a) => Arbitrary (Sq a) where
102 l <- vector (n*n) 68 l <- vector (n*n)
103 return $ Sq $ (n><n) l 69 return $ Sq $ (n><n) l
104 70
105#if MIN_VERSION_QuickCheck(2,0,0)
106 shrink (Sq a) = [ Sq b | b <- shrink a ] 71 shrink (Sq a) = [ Sq b | b <- shrink a ]
107#else
108 coarbitrary = undefined
109#endif
110 72
111 73
112-- a unitary matrix 74-- a unitary matrix
@@ -117,11 +79,6 @@ instance (Field a, Arbitrary a) => Arbitrary (Rot a) where
117 let (q,_) = qr m 79 let (q,_) = qr m
118 return (Rot q) 80 return (Rot q)
119 81
120#if MIN_VERSION_QuickCheck(2,0,0)
121#else
122 coarbitrary = undefined
123#endif
124
125 82
126-- a complex hermitian or real symmetric matrix 83-- a complex hermitian or real symmetric matrix
127newtype (Her a) = Her (Matrix a) deriving Show 84newtype (Her a) = Her (Matrix a) deriving Show
@@ -131,10 +88,6 @@ instance (Field a, Arbitrary a, Num (Vector a)) => Arbitrary (Her a) where
131 let m' = m/2 88 let m' = m/2
132 return $ Her (m' + tr m') 89 return $ Her (m' + tr m')
133 90
134#if MIN_VERSION_QuickCheck(2,0,0)
135#else
136 coarbitrary = undefined
137#endif
138 91
139class (Field a, Arbitrary a, Element (RealOf a), Random (RealOf a)) => ArbitraryField a 92class (Field a, Arbitrary a, Element (RealOf a), Random (RealOf a)) => ArbitraryField a
140instance ArbitraryField Double 93instance ArbitraryField Double
@@ -154,11 +107,6 @@ instance (Numeric a, ArbitraryField a) => Arbitrary (WC a) where
154 let s = diagRect 0 (fromList sv') r c 107 let s = diagRect 0 (fromList sv') r c
155 return $ WC (u <> real s <> tr v) 108 return $ WC (u <> real s <> tr v)
156 109
157#if MIN_VERSION_QuickCheck(2,0,0)
158#else
159 coarbitrary = undefined
160#endif
161
162 110
163-- a well-conditioned square matrix (the singular values are between 1 and 100) 111-- a well-conditioned square matrix (the singular values are between 1 and 100)
164newtype (SqWC a) = SqWC (Matrix a) deriving Show 112newtype (SqWC a) = SqWC (Matrix a) deriving Show
@@ -171,11 +119,6 @@ instance (ArbitraryField a, Numeric a) => Arbitrary (SqWC a) where
171 let s = diag (fromList sv') 119 let s = diag (fromList sv')
172 return $ SqWC (u <> real s <> tr v) 120 return $ SqWC (u <> real s <> tr v)
173 121
174#if MIN_VERSION_QuickCheck(2,0,0)
175#else
176 coarbitrary = undefined
177#endif
178
179 122
180-- a positive definite square matrix (the eigenvalues are between 0 and 100) 123-- a positive definite square matrix (the eigenvalues are between 0 and 100)
181newtype (PosDef a) = PosDef (Matrix a) deriving Show 124newtype (PosDef a) = PosDef (Matrix a) deriving Show
@@ -190,11 +133,6 @@ instance (Numeric a, ArbitraryField a, Num (Vector a))
190 p = v <> real s <> tr v 133 p = v <> real s <> tr v
191 return $ PosDef (0.5 * p + 0.5 * tr p) 134 return $ PosDef (0.5 * p + 0.5 * tr p)
192 135
193#if MIN_VERSION_QuickCheck(2,0,0)
194#else
195 coarbitrary = undefined
196#endif
197
198 136
199-- a pair of matrices that can be multiplied 137-- a pair of matrices that can be multiplied
200newtype (Consistent a) = Consistent (Matrix a, Matrix a) deriving Show 138newtype (Consistent a) = Consistent (Matrix a, Matrix a) deriving Show
@@ -207,11 +145,7 @@ instance (Field a, Arbitrary a) => Arbitrary (Consistent a) where
207 lb <- vector (k*m) 145 lb <- vector (k*m)
208 return $ Consistent ((n><k) la, (k><m) lb) 146 return $ Consistent ((n><k) la, (k><m) lb)
209 147
210#if MIN_VERSION_QuickCheck(2,0,0)
211 shrink (Consistent (x,y)) = [ Consistent (u,v) | (u,v) <- shrinkPair (x,y) ] 148 shrink (Consistent (x,y)) = [ Consistent (u,v) | (u,v) <- shrinkPair (x,y) ]
212#else
213 coarbitrary = undefined
214#endif
215 149
216 150
217 151
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs
index 941f747..e2492dd 100644
--- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs
+++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs
@@ -1,5 +1,4 @@
1{-# LANGUAGE CPP, FlexibleContexts #-} 1{-# LANGUAGE FlexibleContexts #-}
2{-# OPTIONS_GHC -fno-warn-unused-imports #-}
3{-# LANGUAGE TypeFamilies #-} 2{-# LANGUAGE TypeFamilies #-}
4 3
5----------------------------------------------------------------------------- 4-----------------------------------------------------------------------------
@@ -44,10 +43,7 @@ module Numeric.LinearAlgebra.Tests.Properties (
44) where 43) where
45 44
46import Numeric.LinearAlgebra.HMatrix hiding (Testable)--hiding (real,complex) 45import Numeric.LinearAlgebra.HMatrix hiding (Testable)--hiding (real,complex)
47import Debug.Trace 46import Test.QuickCheck
48import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector
49 ,sized,classify,Testable,Property
50 ,quickCheckWith,maxSize,stdArgs,shrink)
51 47
52trivial :: Testable a => Bool -> a -> Property 48trivial :: Testable a => Bool -> a -> Property
53trivial = (`classify` "trivial") 49trivial = (`classify` "trivial")