simpler Container typeclass

4 files changed, 49 insertions, 9 deletions

diff --git a/lib/Numeric/LinearAlgebra/Algorithms.hs b/lib/Numeric/LinearAlgebra/Algorithms.hs
index 1109296..f4b7ee9 100644
--- a/lib/Numeric/LinearAlgebra/Algorithms.hs
+++ b/lib/Numeric/LinearAlgebra/Algorithms.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -XFlexibleContexts -XFlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
 {-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 {- |
@@ -85,7 +85,6 @@ import Numeric.LinearAlgebra.Linear
 import Data.List(foldl1')
 import Data.Array
 
-
 -- | Auxiliary typeclass used to define generic computations for both real and complex matrices.
 class (Normed (Matrix t), Linear Vector t, Linear Matrix t) => Field t where
     svd'         :: Matrix t -> (Matrix t, Vector Double, Matrix t)
@@ -397,6 +396,10 @@ ranksv teps maxdim s = k where
 eps :: Double
 eps =  2.22044604925031e-16
 
+peps :: RealFloat x => x -> x
+peps x = 2.0**(fromIntegral $ 1-floatDigits x)
+
+
 -- | The imaginary unit: @i = 0.0 :+ 1.0@
 i :: Complex Double
 i = 0:+1
@@ -467,6 +470,21 @@ instance Normed (Matrix (Complex Double)) where
     pnorm = pnormCM
 
 -----------------------------------------------------------------------
+-- to be optimized
+
+instance Normed (Vector Float) where
+    pnorm t = pnorm t . double
+
+instance Normed (Vector (Complex Float)) where
+    pnorm t = pnorm t . double
+
+instance Normed (Matrix Float) where
+    pnorm t = pnorm t . double
+
+instance Normed (Matrix (Complex Float)) where
+    pnorm t = pnorm t . double
+
+-----------------------------------------------------------------------
 
 -- | The nullspace of a matrix from its SVD decomposition.
 nullspaceSVD :: Field t
diff --git a/lib/Numeric/LinearAlgebra/Linear.hs b/lib/Numeric/LinearAlgebra/Linear.hs
index 9a7e65f..51e93fb 100644
--- a/lib/Numeric/LinearAlgebra/Linear.hs
+++ b/lib/Numeric/LinearAlgebra/Linear.hs
@@ -17,7 +17,7 @@ Basic optimized operations on vectors and matrices.
 
 module Numeric.LinearAlgebra.Linear (
     -- * Linear Algebra Typeclasses
-    Vectors(..),                                    
+    Vectors(..),
     Linear(..),
     -- * Creation of numeric vectors
     constant, linspace
@@ -86,7 +86,7 @@ instance Vectors Vector (Complex Double) where
 ----------------------------------------------------
 
 -- | Basic element-by-element functions.
-class (Container c e) => Linear c e where
+class (Element e, AutoReal e, Convert e, Container c) => Linear c e where
     -- | create a structure with a single element
     scalar      :: e -> c e
     scale       :: e -> c e -> c e
@@ -148,7 +148,7 @@ instance Linear Vector (Complex Float) where
     equal u v = dim u == dim v && vectorMax (mapVector magnitude (sub u v)) == 0.0
     scalar x = fromList [x]
 
-instance (Linear Vector a, Container Matrix a) => (Linear Matrix a) where
+instance (Linear Vector a, Container Matrix) => (Linear Matrix a) where
     scale x = liftMatrix (scale x)
     scaleRecip x = liftMatrix (scaleRecip x)
     addConstant x = liftMatrix (addConstant x)
diff --git a/lib/Numeric/LinearAlgebra/Tests.hs b/lib/Numeric/LinearAlgebra/Tests.hs
index 5c5135c..e3b6e1f 100644
--- a/lib/Numeric/LinearAlgebra/Tests.hs
+++ b/lib/Numeric/LinearAlgebra/Tests.hs
@@ -45,6 +45,8 @@ a ~~ b = fromList a |~| fromList b
 
 feye n = flipud (ident n) :: Matrix Double
 
+-----------------------------------------------------------
+
 detTest1 = det m == 26
         && det mc == 38 :+ (-3)
         && det (feye 2) == -1
@@ -314,17 +316,27 @@ runTests n = do
     test (expmDiagProp . cSqWC)
     putStrLn "------ fft"
     test (\v -> ifft (fft v) |~| v)
-    putStrLn "------ vector operations"
+    putStrLn "------ vector operations - Double"
     test (\u -> sin u ^ 2 + cos u ^ 2 |~| (1::RM))
     test $ (\u -> sin u ^ 2 + cos u ^ 2 |~| (1::CM)) . liftMatrix makeUnitary
     test (\u -> sin u ** 2 + cos u ** 2 |~| (1::RM))
     test (\u -> cos u * tan u |~| sin (u::RM))
     test $ (\u -> cos u * tan u |~| sin (u::CM)) . liftMatrix makeUnitary
+    putStrLn "------ vector operations - Float"
+    test (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::FM))
+    test $ (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::ZM)) . liftMatrix makeUnitary
+    test (\u -> sin u ** 2 + cos u ** 2 |~~| (1::FM))
+    test (\u -> cos u * tan u |~~| sin (u::FM))
+    test $ (\u -> cos u * tan u |~~| sin (u::ZM)) . liftMatrix makeUnitary
     putStrLn "------ read . show"
     test (\m -> (m::RM) == read (show m))
     test (\m -> (m::CM) == read (show m))
     test (\m -> toRows (m::RM) == read (show (toRows m)))
     test (\m -> toRows (m::CM) == read (show (toRows m)))
+    test (\m -> (m::FM) == read (show m))
+    test (\m -> (m::ZM) == read (show m))
+    test (\m -> toRows (m::FM) == read (show (toRows m)))
+    test (\m -> toRows (m::ZM) == read (show (toRows m)))
     putStrLn "------ some unit tests"
     _ <- runTestTT $ TestList
         [ utest "1E5 rots" rotTest
@@ -358,6 +370,11 @@ runTests n = do
         ]
     return ()
 
+
+-- single precision approximate equality
+infixl 4 |~~|
+a |~~| b = a :~6~: b
+
 makeUnitary v | realPart n > 1    = v / scalar n
               | otherwise = v
     where n = sqrt (conj v <.> v)
diff --git a/lib/Numeric/LinearAlgebra/Tests/Instances.hs b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
index bfe6871..ad59b25 100644
--- a/lib/Numeric/LinearAlgebra/Tests/Instances.hs
+++ b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
@@ -22,12 +22,11 @@ module Numeric.LinearAlgebra.Tests.Instances(
     SqWC(..),   rSqWC, cSqWC,
     PosDef(..), rPosDef, cPosDef,
     Consistent(..), rConsist, cConsist,
-    RM,CM, rM,cM
+    RM,CM, rM,cM,
+    FM,ZM, fM,zM
 ) where
 
 
-
-
 import Numeric.LinearAlgebra
 import Control.Monad(replicateM)
 #include "quickCheckCompat.h"
@@ -212,9 +211,15 @@ instance (Field a, Arbitrary a) => Arbitrary (Consistent a) where
 
 type RM = Matrix Double
 type CM = Matrix (Complex Double)
+type FM = Matrix Float
+type ZM = Matrix (Complex Float)
+
 
 rM m = m :: RM
 cM m = m :: CM
+fM m = m :: FM
+zM m = m :: ZM
+
 
 rHer (Her m) = m :: RM
 cHer (Her m) = m :: CM