test modules reorganized

2 files changed, 58 insertions, 36 deletions

diff --git a/lib/Numeric/LinearAlgebra/Testing.hs b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
index dcf1d8e..fececdb 100644
--- a/lib/Numeric/LinearAlgebra/Testing.hs
+++ b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
@@ -1,32 +1,26 @@
-{-# OPTIONS_GHC -XPatternSignatures #-}
+{-# OPTIONS #-}
 -----------------------------------------------------------------------------
 {- |
-Module      :  Numeric.LinearAlgebra.Testing
-Copyright   :  (c) Alberto Ruiz 2007
+Module      :  Numeric.LinearAlgebra.Tests.Instances
+Copyright   :  (c) Alberto Ruiz 2008
 License     :  GPL-style
 
 Maintainer  :  Alberto Ruiz (aruiz at um dot es)
 Stability   :  provisional
 Portability :  portable
 
-Some consistency tests.
+Arbitrary instances for vectors, matrices.
 
 -}
 
-module Numeric.LinearAlgebra.Testing(
-    runTests, runBigTests
+module Numeric.LinearAlgebra.Tests.Instances(
+    Sq(..),
+    Rot(..),
+    Her(..)
 ) where
 
 import Numeric.LinearAlgebra
 import Test.QuickCheck
-import Debug.Trace
-
-qCheck n = check defaultConfig {configSize = const n}
-
-debug x = trace (show x) x
-
-type RM = Matrix Double
-type CM = Matrix (Complex Double)
 
 instance (Arbitrary a, RealFloat a) => Arbitrary (Complex a) where
     arbitrary = do
@@ -51,10 +45,7 @@ instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where
         return $ (m><n) l
     coarbitrary = undefined
 
-
 newtype (Sq a) = Sq (Matrix a) deriving Show
-sq (Sq m) = m
-
 instance (Element a, Arbitrary a) => Arbitrary (Sq a) where
     arbitrary = do
         n <- chooseDim
@@ -63,8 +54,6 @@ instance (Element a, Arbitrary a) => Arbitrary (Sq a) where
     coarbitrary = undefined
 
 newtype (Rot a) = Rot (Matrix a) deriving Show
-rot (Rot a) = a
-
 instance (Field a, Arbitrary a) => Arbitrary (Rot a) where
     arbitrary = do
         Sq m <- arbitrary
@@ -73,26 +62,9 @@ instance (Field a, Arbitrary a) => Arbitrary (Rot a) where
     coarbitrary = undefined
 
 newtype (Her a) = Her (Matrix a) deriving Show
-her (Her a) = a
-
 instance (Field a, Arbitrary a) => Arbitrary (Her a) where
     arbitrary = do
         Sq m <- arbitrary
         let m' = m/2
         return $ Her (m' + ctrans m')
     coarbitrary = undefined
-
--------------------------------------------------------------------
-
-herR x = her x :: RM
-
--- | It runs all the tests.
-runTests :: Int  -- ^ maximum dimension
-         -> IO ()
-runTests n = do
-    qCheck n (\(Her (m::CM))-> m == ctrans m)
-    qCheck n $ (\m->m==ctrans m) . herR
-
--- | Some additional tests on big matrices. They take a few minutes.
-runBigTests :: IO ()
-runBigTests = undefined
diff --git a/lib/Numeric/LinearAlgebra/Tests/Properties.hs b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
new file mode 100644
index 0000000..ad31454
--- /dev/null
+++ b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
@@ -0,0 +1,50 @@
+{-# OPTIONS #-}
+-----------------------------------------------------------------------------
+{- |
+Module      :  Numeric.LinearAlgebra.Tests.Properties
+Copyright   :  (c) Alberto Ruiz 2008
+License     :  GPL-style
+
+Maintainer  :  Alberto Ruiz (aruiz at um dot es)
+Stability   :  provisional
+Portability :  portable
+
+Arbitrary instances for vectors, matrices.
+
+-}
+
+module Numeric.LinearAlgebra.Tests.Properties
+
+where
+
+import Numeric.LinearAlgebra
+import Numeric.LinearAlgebra.Tests.Instances(Sq(..),Her(..),Rot(..))
+
+-- relative error
+dist :: (Normed t, Num t) => t -> t -> Double
+dist a b = r
+    where norm = pnorm Infinity
+          na = norm a
+          nb = norm b
+          nab = norm (a-b)
+          mx = max na nb
+          mn = min na nb
+          r = if mn < eps
+                then mx
+                else nab/mx
+
+infixl 4 |~|
+--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)
+
+------------------------------------------------------
+
+square m = rows m == cols m
+
+unitary m = square m && m <> ctrans m |~| ident (rows m)
+
+hermitian m = square m && m |~| ctrans m