arbitrary well-conditioned matrices

2 files changed, 29 insertions, 6 deletions

diff --git a/lib/Numeric/LinearAlgebra/Tests/Instances.hs b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
index fececdb..583143a 100644
--- a/lib/Numeric/LinearAlgebra/Tests/Instances.hs
+++ b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
@@ -16,11 +16,13 @@ Arbitrary instances for vectors, matrices.
 module Numeric.LinearAlgebra.Tests.Instances(
     Sq(..),
     Rot(..),
-    Her(..)
+    Her(..),
+    WC(..)
 ) where
 
 import Numeric.LinearAlgebra
 import Test.QuickCheck
+import Control.Monad(replicateM)
 
 instance (Arbitrary a, RealFloat a) => Arbitrary (Complex a) where
     arbitrary = do
@@ -45,6 +47,7 @@ instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where
         return $ (m><n) l
     coarbitrary = undefined
 
+-- a square matrix
 newtype (Sq a) = Sq (Matrix a) deriving Show
 instance (Element a, Arbitrary a) => Arbitrary (Sq a) where
     arbitrary = do
@@ -53,6 +56,7 @@ instance (Element a, Arbitrary a) => Arbitrary (Sq a) where
         return $ Sq $ (n><n) l
     coarbitrary = undefined
 
+-- a unitary matrix
 newtype (Rot a) = Rot (Matrix a) deriving Show
 instance (Field a, Arbitrary a) => Arbitrary (Rot a) where
     arbitrary = do
@@ -61,6 +65,7 @@ instance (Field a, Arbitrary a) => Arbitrary (Rot a) where
         return (Rot q)
     coarbitrary = undefined
 
+-- a complex hermitian or real symmetric matrix
 newtype (Her a) = Her (Matrix a) deriving Show
 instance (Field a, Arbitrary a) => Arbitrary (Her a) where
     arbitrary = do
@@ -68,3 +73,17 @@ instance (Field a, Arbitrary a) => Arbitrary (Her a) where
         let m' = m/2
         return $ Her (m' + ctrans m')
     coarbitrary = undefined
+
+-- a well-conditioned matrix (the singular values are between 1 and 100)
+newtype (WC a) = WC (Matrix a) deriving Show
+instance (Field a, Arbitrary a) => Arbitrary (WC a) where
+    arbitrary = do
+        m <- arbitrary
+        let (u,_,v) = svd m
+            r = rows m
+            c = cols m
+            n = min r c
+        sv <- replicateM n (choose (1,100))
+        let s = diagRect (fromList sv) r c
+        return $ WC (u <> real s <> trans v)
+    coarbitrary = undefined
diff --git a/lib/Numeric/LinearAlgebra/Tests/Properties.hs b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
index ad31454..6686b97 100644
--- a/lib/Numeric/LinearAlgebra/Tests/Properties.hs
+++ b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
@@ -34,12 +34,12 @@ dist a b = r
                 else nab/mx
 
 infixl 4 |~|
---a |~| b = a :~10~: b
-a |~| b = dist a b < 10^^(-10)
+a |~| b = a :~10~: b
+--a |~| b = dist a b < 10^^(-10)
 
---data Aprox a = (:~) a Int
---(~:) :: (Normed a, Num a) => Aprox a -> a -> Bool
---a :~n~: b = dist a b < 10^^(-n)
+data Aprox a = (:~) a Int
+(~:) :: (Normed a, Num a) => Aprox a -> a -> Bool
+a :~n~: b = dist a b < 10^^(-n)
 
 ------------------------------------------------------
 
@@ -48,3 +48,7 @@ square m = rows m == cols m
 unitary m = square m && m <> ctrans m |~| ident (rows m)
 
 hermitian m = square m && m |~| ctrans m
+
+degenerate m = rank m < min (rows m) (cols m)
+
+wellCond m = rcond m > 1/100