2 files changed, 92 insertions, 152 deletions

diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs
index 53fc4d2..904ae05 100644
--- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs
+++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE FlexibleContexts, UndecidableInstances, CPP, FlexibleInstances #-}
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+{-# LANGUAGE FlexibleContexts, UndecidableInstances, FlexibleInstances #-}
 -----------------------------------------------------------------------------
 {- |
 Module      :  Numeric.LinearAlgebra.Tests.Instances
@@ -26,15 +25,11 @@ module Numeric.LinearAlgebra.Tests.Instances(
 
 import System.Random
 
-import Numeric.LinearAlgebra
-import Numeric.LinearAlgebra.Devel
-import Numeric.Container
+import Numeric.LinearAlgebra.HMatrix hiding (vector)
 import Control.Monad(replicateM)
-import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector
-                      ,sized,classify,Testable,Property
-                      ,quickCheckWith,maxSize,stdArgs,shrink)
+import Test.QuickCheck(Arbitrary,arbitrary,choose,vector,sized,shrink)
+
 
-#if MIN_VERSION_QuickCheck(2,0,0)
 shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]]
 shrinkListElementwise []     = []
 shrinkListElementwise (x:xs) = [ y:xs | y  <- shrink x                 ]
@@ -42,25 +37,6 @@ shrinkListElementwise (x:xs) = [ y:xs | y  <- shrink x                 ]
 
 shrinkPair :: (Arbitrary a, Arbitrary b) => (a,b) -> [(a,b)]
 shrinkPair (a,b) = [ (a,x) | x <- shrink b ] ++ [ (x,b) | x <- shrink a ]
-#endif
-
-#if MIN_VERSION_QuickCheck(2,1,1)
-#else
-instance (Arbitrary a, RealFloat a) => Arbitrary (Complex a) where
-    arbitrary = do
-        re <- arbitrary
-        im <- arbitrary
-        return (re :+ im)
-
-#if MIN_VERSION_QuickCheck(2,0,0)
-    shrink (re :+ im) = 
-        [ u :+ v | (u,v) <- shrinkPair (re,im) ]
-#else
-    -- this has been moved to the 'Coarbitrary' class in QuickCheck 2
-    coarbitrary = undefined 
-#endif
-
-#endif
 
 chooseDim = sized $ \m -> choose (1,max 1 m)
 
@@ -68,15 +44,9 @@ instance (Field a, Arbitrary a) => Arbitrary (Vector a) where
     arbitrary = do m <- chooseDim
                    l <- vector m
                    return $ fromList l
-
-#if MIN_VERSION_QuickCheck(2,0,0)
     -- shrink any one of the components
     shrink = map fromList . shrinkListElementwise . toList
 
-#else
-    coarbitrary = undefined
-#endif
-
 instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where 
     arbitrary = do
         m <- chooseDim
@@ -84,16 +54,11 @@ instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where
         l <- vector (m*n)
         return $ (m><n) l
 
-#if MIN_VERSION_QuickCheck(2,0,0)
     -- shrink any one of the components
     shrink a = map (rows a >< cols a)
                . shrinkListElementwise
                . concat . toLists 
                      $ a
-#else
-    coarbitrary = undefined
-#endif
-
 
 -- a square matrix
 newtype (Sq a) = Sq (Matrix a) deriving Show
@@ -103,11 +68,7 @@ instance (Element a, Arbitrary a) => Arbitrary (Sq a) where
         l <- vector (n*n)
         return $ Sq $ (n><n) l
 
-#if MIN_VERSION_QuickCheck(2,0,0)
     shrink (Sq a) = [ Sq b | b <- shrink a ]
-#else
-    coarbitrary = undefined
-#endif
 
 
 -- a unitary matrix
@@ -118,11 +79,6 @@ instance (Field a, Arbitrary a) => Arbitrary (Rot a) where
         let (q,_) = qr m
         return (Rot q)
 
-#if MIN_VERSION_QuickCheck(2,0,0)
-#else
-    coarbitrary = undefined
-#endif
-
 
 -- a complex hermitian or real symmetric matrix
 newtype (Her a) = Her (Matrix a) deriving Show
@@ -130,12 +86,8 @@ instance (Field a, Arbitrary a, Num (Vector a)) => Arbitrary (Her a) where
     arbitrary = do
         Sq m <- arbitrary
         let m' = m/2
-        return $ Her (m' + ctrans m')
+        return $ Her (m' + tr m')
 
-#if MIN_VERSION_QuickCheck(2,0,0)
-#else
-    coarbitrary = undefined
-#endif
 
 class (Field a, Arbitrary a, Element (RealOf a), Random (RealOf a)) => ArbitraryField a
 instance ArbitraryField Double
@@ -144,7 +96,7 @@ instance ArbitraryField (Complex Double)
 
 -- a well-conditioned general matrix (the singular values are between 1 and 100)
 newtype (WC a) = WC (Matrix a) deriving Show
-instance (ArbitraryField a) => Arbitrary (WC a) where
+instance (Numeric a, ArbitraryField a) => Arbitrary (WC a) where
     arbitrary = do
         m <- arbitrary
         let (u,_,v) = svd m
@@ -153,34 +105,24 @@ instance (ArbitraryField a) => Arbitrary (WC a) where
             n = min r c
         sv' <- replicateM n (choose (1,100))
         let s = diagRect 0 (fromList sv') r c
-        return $ WC (u `mXm` real s `mXm` trans v)
-
-#if MIN_VERSION_QuickCheck(2,0,0)
-#else
-    coarbitrary = undefined
-#endif
+        return $ WC (u <> real s <> tr v)
 
 
 -- a well-conditioned square matrix (the singular values are between 1 and 100)
 newtype (SqWC a) = SqWC (Matrix a) deriving Show
-instance (ArbitraryField a) => Arbitrary (SqWC a) where
+instance (ArbitraryField a, Numeric a) => Arbitrary (SqWC a) where
     arbitrary = do
         Sq m <- arbitrary
         let (u,_,v) = svd m
             n = rows m
         sv' <- replicateM n (choose (1,100))
         let s = diag (fromList sv')
-        return $ SqWC (u `mXm` real s `mXm` trans v)
-
-#if MIN_VERSION_QuickCheck(2,0,0)
-#else
-    coarbitrary = undefined
-#endif
+        return $ SqWC (u <> real s <> tr v)
 
 
 -- a positive definite square matrix (the eigenvalues are between 0 and 100)
 newtype (PosDef a) = PosDef (Matrix a) deriving Show
-instance (ArbitraryField a, Num (Vector a)) 
+instance (Numeric a, ArbitraryField a, Num (Vector a)) 
     => Arbitrary (PosDef a) where
     arbitrary = do
         Her m <- arbitrary
@@ -188,13 +130,8 @@ instance (ArbitraryField a, Num (Vector a))
             n = rows m
         l <- replicateM n (choose (0,100))
         let s = diag (fromList l)
-            p = v `mXm` real s `mXm` ctrans v
-        return $ PosDef (0.5 * p + 0.5 * ctrans p)
-
-#if MIN_VERSION_QuickCheck(2,0,0)
-#else
-    coarbitrary = undefined
-#endif
+            p = v <> real s <> tr v
+        return $ PosDef (0.5 * p + 0.5 * tr p)
 
 
 -- a pair of matrices that can be multiplied
@@ -208,11 +145,7 @@ instance (Field a, Arbitrary a) => Arbitrary (Consistent a) where
         lb <- vector (k*m)
         return $ Consistent ((n><k) la, (k><m) lb)
 
-#if MIN_VERSION_QuickCheck(2,0,0)
     shrink (Consistent (x,y)) = [ Consistent (u,v) | (u,v) <- shrinkPair (x,y) ]
-#else
-    coarbitrary = undefined
-#endif
 
 
 
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs
index a5c37f4..207a303 100644
--- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs
+++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE CPP, FlexibleContexts #-}
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies #-}
 
 -----------------------------------------------------------------------------
@@ -29,7 +28,7 @@ module Numeric.LinearAlgebra.Tests.Properties (
     pinvProp,
     detProp,
     nullspaceProp,
-    bugProp,
+--    bugProp,
     svdProp1, svdProp1a, svdProp1b, svdProp2, svdProp3, svdProp4,
     svdProp5a, svdProp5b, svdProp6a, svdProp6b, svdProp7,
     eigProp, eigSHProp, eigProp2, eigSHProp2,
@@ -43,20 +42,15 @@ module Numeric.LinearAlgebra.Tests.Properties (
     linearSolveProp, linearSolveProp2
 ) where
 
-import Numeric.Container
-import Numeric.LinearAlgebra --hiding (real,complex)
-import Numeric.LinearAlgebra.LAPACK
-import Debug.Trace
-import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector
-                      ,sized,classify,Testable,Property
-                      ,quickCheckWith,maxSize,stdArgs,shrink)
+import Numeric.LinearAlgebra.HMatrix hiding (Testable,unitary)
+import Test.QuickCheck
 
 trivial :: Testable a => Bool -> a -> Property
 trivial = (`classify` "trivial")
 
 -- relative error
-dist :: (Normed c t, Num (c t)) => c t -> c t -> Double
-dist = relativeError Infinity
+dist :: (Num a, Normed a) => a -> a -> Double
+dist = relativeError norm_Inf
 
 infixl 4 |~|
 a |~| b = a :~10~: b
@@ -73,11 +67,11 @@ a :~n~: b = dist a b < 10^^(-n)
 square m = rows m == cols m
 
 -- orthonormal columns
-orthonormal m = ctrans m <> m |~| ident (cols m)
+orthonormal m = tr m <> m |~| ident (cols m)
 
 unitary m = square m && orthonormal m
 
-hermitian m = square m && m |~| ctrans m
+hermitian m = square m && m |~| tr m
 
 wellCond m = rcond m > 1/100
 
@@ -85,12 +79,12 @@ positiveDefinite m = minimum (toList e) > 0
     where (e,_v) = eigSH m
 
 upperTriang m = rows m == 1 || down == z
-    where down = fromList $ concat $ zipWith drop [1..] (toLists (ctrans m))
-          z = konst 0 (dim down)
+    where down = fromList $ concat $ zipWith drop [1..] (toLists (tr m))
+          z = konst 0 (size down)
 
 upperHessenberg m = rows m < 3 || down == z
-    where down = fromList $ concat $ zipWith drop [2..] (toLists (ctrans m))
-          z = konst 0 (dim down)
+    where down = fromList $ concat $ zipWith drop [2..] (toLists (tr m))
+          z = konst 0 (size down)
 
 zeros (r,c) = reshape c (konst 0 (r*c))
 
@@ -118,81 +112,94 @@ detProp m = s d1 |~| s d2
           s x = fromList [x]
 
 nullspaceProp m = null nl `trivial` (null nl || m <> n |~| zeros (r,c)
-                                     && orthonormal (fromColumns nl))
-    where nl = nullspacePrec 1 m
-          n = fromColumns nl
+                                     && orthonormal n)
+    where n = nullspaceSVD (Left (1*peps)) m (rightSV m)
+          nl = toColumns n
           r = rows m
           c = cols m - rank m
 
 ------------------------------------------------------------------
-
+{-
 -- testcase for nonempty fpu stack
 -- uncommenting unitary' signature eliminates the problem
-bugProp m = m |~| u <> real d <> trans v && unitary' u && unitary' v
-    where (u,d,v) = fullSVD m
+bugProp m = m |~| u <> real d <> tr v && unitary' u && unitary' v
+    where (u,d,v) = svd m
           -- unitary' :: (Num (Vector t), Field t) => Matrix t -> Bool
           unitary' a = unitary a
-
+-}
 ------------------------------------------------------------------
 
 -- fullSVD
-svdProp1 m = m |~| u <> real d <> trans v && unitary u && unitary v
-    where (u,d,v) = fullSVD m
+svdProp1 m = m |~| u <> real d <> tr v && unitary u && unitary v
+  where
+    (u,s,v) = svd m
+    d = diagRect 0 s (rows m) (cols m)
 
-svdProp1a svdfun m = m |~| u <> real d <> trans v && unitary u && unitary v where
+svdProp1a svdfun m = m |~| u <> real d <> tr v && unitary u && unitary v
+  where
     (u,s,v) = svdfun m
     d = diagRect 0 s (rows m) (cols m)
 
-svdProp1b svdfun m = unitary u && unitary v where
+svdProp1b svdfun m = unitary u && unitary v
+  where
     (u,_,v) = svdfun m
 
 -- thinSVD
-svdProp2 thinSVDfun m = m |~| u <> diag (real s) <> trans v && orthonormal u && orthonormal v && dim s == min (rows m) (cols m)
-    where (u,s,v) = thinSVDfun m
+svdProp2 thinSVDfun m
+    =  m |~| u <> diag (real s) <> tr v
+    && orthonormal u && orthonormal v
+    && size s == min (rows m) (cols m)
+  where
+    (u,s,v) = thinSVDfun m
 
 -- compactSVD
-svdProp3 m = (m |~| u <> real (diag s) <> trans v
+svdProp3 m = (m |~| u <> real (diag s) <> tr v
              && orthonormal u && orthonormal v)
-    where (u,s,v) = compactSVD m
+  where
+    (u,s,v) = compactSVD m
 
-svdProp4 m' = m |~| u <> real (diag s) <> trans v
+svdProp4 m' = m |~| u <> real (diag s) <> tr v
            && orthonormal u && orthonormal v
-           && (dim s == r || r == 0 && dim s == 1)
-    where (u,s,v) = compactSVD m
-          m = fromBlocks [[m'],[m']]
-          r = rank m'
-
-svdProp5a m = all (s1|~|) [s2,s3,s4,s5,s6] where
-    s1       = svR  m
-    s2       = svRd m
-    (_,s3,_) = svdR m
-    (_,s4,_) = svdRd m
-    (_,s5,_) = thinSVDR m
-    (_,s6,_) = thinSVDRd m
-
-svdProp5b m = all (s1|~|) [s2,s3,s4,s5,s6] where
-    s1       = svC  m
-    s2       = svCd m
-    (_,s3,_) = svdC m
-    (_,s4,_) = svdCd m
-    (_,s5,_) = thinSVDC m
-    (_,s6,_) = thinSVDCd m
+           && (size s == r || r == 0 && size s == 1)
+  where
+    (u,s,v) = compactSVD m
+    m = fromBlocks [[m'],[m']]
+    r = rank m'
+
+svdProp5a m = all (s1|~|) [s3,s5] where
+    s1       = singularValues (m :: Matrix Double)
+--  s2       = svRd m
+    (_,s3,_) = svd m
+--  (_,s4,_) = svdRd m
+    (_,s5,_) = thinSVD m
+--  (_,s6,_) = thinSVDRd m
+
+svdProp5b m = all (s1|~|) [s3,s5] where
+    s1       = singularValues (m :: Matrix (Complex Double))
+--  s2       = svCd m
+    (_,s3,_) = svd m
+--  (_,s4,_) = svdCd m
+    (_,s5,_) = thinSVD m
+--  (_,s6,_) = thinSVDCd m
 
 svdProp6a m = s |~| s' && v |~| v' && s |~| s'' && u |~| u'
-    where (u,s,v) = svdR m
-          (s',v') = rightSVR m
-          (u',s'') = leftSVR m
+  where
+    (u,s,v) = svd (m :: Matrix Double)
+    (s',v') = rightSV m
+    (u',s'') = leftSV m
 
 svdProp6b m = s |~| s' && v |~| v' && s |~| s'' && u |~| u'
-    where (u,s,v) = svdC m
-          (s',v') = rightSVC m
-          (u',s'') = leftSVC m
+  where
+    (u,s,v) = svd (m :: Matrix (Complex Double))
+    (s',v') = rightSV m
+    (u',s'') = leftSV m
 
 svdProp7 m = s |~| s' && u |~| u' && v |~| v' && s |~| s'''
-    where (u,s,v) = svd m
-          (s',v') = rightSV m
-          (u',_s'') = leftSV m
-          s''' = singularValues m
+  where
+    (u,s,v) = svd m
+    (s',v') = rightSV m
+    (u',_s'') = leftSV m
+    s''' = singularValues m
 
 ------------------------------------------------------------------
 
@@ -201,7 +208,7 @@ eigProp m = complex m <> v |~| v <> diag s
 
 eigSHProp m = m <> v |~| v <> real (diag s)
               && unitary v
-              && m |~| v <> real (diag s) <> ctrans v
+              && m |~| v <> real (diag s) <> tr v
     where (s, v) = eigSH m
 
 eigProp2 m = fst (eig m) |~| eigenvalues m
@@ -226,19 +233,19 @@ rqProp3 m = upperTriang' r
     where (r,_q) = rq m
 
 upperTriang' r = upptr (rows r) (cols r) * r |~| r
-    where upptr f c = buildMatrix f c $ \(r',c') -> if r'-t > c' then 0 else 1
-              where t = f-c
+    where upptr f c = build (f,c) $ \r' c' -> if r'-t > c' then 0 else 1
+              where t = fromIntegral (f-c)
 
-hessProp m = m |~| p <> h <> ctrans p && unitary p && upperHessenberg h
+hessProp m = m |~| p <> h <> tr p && unitary p && upperHessenberg h
     where (p,h) = hess m
 
-schurProp1 m = m |~| u <> s <> ctrans u && unitary u && upperTriang s
+schurProp1 m = m |~| u <> s <> tr u && unitary u && upperTriang s
     where (u,s) = schur m
 
-schurProp2 m = m |~| u <> s <> ctrans u && unitary u && upperHessenberg s -- fixme
+schurProp2 m = m |~| u <> s <> tr u && unitary u && upperHessenberg s -- fixme
     where (u,s) = schur m
 
-cholProp m = m |~| ctrans c <> c && upperTriang c
+cholProp m = m |~| tr c <> c && upperTriang c
     where c = chol m
 
 exactProp m = chol m == chol (m+0)
@@ -252,7 +259,7 @@ mulH a b = fromLists [[ doth ai bj | bj <- toColumns b] | ai <- toRows a ]
 
 multProp1 p (a,b) = (a <> b) :~p~: (mulH a b)
 
-multProp2 p (a,b) = (ctrans (a <> b)) :~p~: (ctrans b <> ctrans a)
+multProp2 p (a,b) = (tr (a <> b)) :~p~: (tr b <> tr a)
 
 linearSolveProp f m = f m m |~| ident (rows m)
 
@@ -261,5 +268,5 @@ linearSolveProp2 f (a,x) = not wc `trivial` (not wc || a <> f a b |~| b)
           b = a <> x
           wc = rank a == q
 
-subProp m = m == (trans . fromColumns . toRows) m
+subProp m = m == (conj . tr . fromColumns . toRows) m