generalized diagRect

5 files changed, 21 insertions, 7 deletions

diff --git a/lib/Numeric/Container.hs b/lib/Numeric/Container.hs
index 83bf44e..1afc5a1 100644
--- a/lib/Numeric/Container.hs
+++ b/lib/Numeric/Container.hs
@@ -22,6 +22,7 @@
 module Numeric.Container (
     -- * Generic operations
     Container(..),
+    ctrans, diag, ident,
     -- * Matrix product and related functions
     Product(..),
     mXm,mXv,vXm,
@@ -221,6 +222,20 @@ instance (Container Vector a) => Container Matrix a where
 
 ----------------------------------------------------
 
+-- | conjugate transpose
+ctrans :: Element e => Matrix e -> Matrix e
+ctrans = liftMatrix conjugateD . trans
+
+-- | Creates a square matrix with a given diagonal.
+diag :: (Num a, Element a) => Vector a -> Matrix a
+diag v = diagRect 0 v n n where n = dim v
+
+-- | creates the identity matrix of given dimension
+ident :: (Num a, Element a) => Int -> Matrix a
+ident n = diag (constantD 1 n)
+
+----------------------------------------------------
+
 
 -- | Matrix product and related functions
 class Element e => Product e where
diff --git a/lib/Numeric/LinearAlgebra/Algorithms.hs b/lib/Numeric/LinearAlgebra/Algorithms.hs
index 4f6f54d..394a1d7 100644
--- a/lib/Numeric/LinearAlgebra/Algorithms.hs
+++ b/lib/Numeric/LinearAlgebra/Algorithms.hs
@@ -183,7 +183,7 @@ singularValues = {-# SCC "singularValues" #-} sv'
 fullSVD :: Field t => Matrix t -> (Matrix t, Matrix Double, Matrix t)
 fullSVD m = (u,d,v) where
     (u,s,v) = svd m
-    d = diagRect s r c
+    d = diagRect 0 s r c
     r = rows m
     c = cols m
 
@@ -210,7 +210,7 @@ leftSV m  | vertical m = let (u,s,_) = svd m     in (u,s)
 {-# DEPRECATED full "use fullSVD instead" #-}
 full svdFun m = (u, d ,v) where
     (u,s,v) = svdFun m
-    d = diagRect s r c
+    d = diagRect 0 s r c
     r = rows m
     c = cols m
 
@@ -624,10 +624,10 @@ luFact (l_u,perm) | r <= c    = (l ,u ,p, s)
     c = cols l_u
     tu = triang r c 0 1
     tl = triang r c 0 0
-    l = takeColumns r (l_u |*| tl) |+| diagRect (konst 1 r) r r
+    l = takeColumns r (l_u |*| tl) |+| diagRect 0 (konst 1 r) r r
     u = l_u |*| tu
     (p,s) = fixPerm r perm
-    l' = (l_u |*| tl) |+| diagRect (konst 1 c) r c
+    l' = (l_u |*| tl) |+| diagRect 0 (konst 1 c) r c
     u' = takeRows c (l_u |*| tu)
     (|+|) = add
     (|*|) = mul
diff --git a/lib/Numeric/LinearAlgebra/Tests/Instances.hs b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
index 804c481..771739a 100644
--- a/lib/Numeric/LinearAlgebra/Tests/Instances.hs
+++ b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
@@ -150,7 +150,7 @@ instance (ArbitraryField a) => Arbitrary (WC a) where
             c = cols m
             n = min r c
         sv' <- replicateM n (choose (1,100))
-        let s = diagRect (fromList sv') r c
+        let s = diagRect 0 (fromList sv') r c
         return $ WC (u <> real s <> trans v)
 
 #if MIN_VERSION_QuickCheck(2,0,0)
diff --git a/lib/Numeric/LinearAlgebra/Tests/Properties.hs b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
index 623b78c..a35f591 100644
--- a/lib/Numeric/LinearAlgebra/Tests/Properties.hs
+++ b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
@@ -138,7 +138,7 @@ svdProp1 m = m |~| u <> real d <> trans v && unitary u && unitary v
 
 svdProp1a svdfun m = m |~| u <> real d <> trans v && unitary u && unitary v where
     (u,s,v) = svdfun m
-    d = diagRect s (rows m) (cols m)
+    d = diagRect 0 s (rows m) (cols m)
 
 svdProp1b svdfun m = unitary u && unitary v where
     (u,_,v) = svdfun m
diff --git a/lib/Numeric/Matrix.hs b/lib/Numeric/Matrix.hs
index d5c6f44..9260bd5 100644
--- a/lib/Numeric/Matrix.hs
+++ b/lib/Numeric/Matrix.hs
@@ -28,7 +28,6 @@ module Numeric.Matrix (
     -- * Basic functions
     module Data.Packed.Matrix,
     module Numeric.Vector,
-    --module Numeric.Container,
     optimiseMult,
     -- * Operators
     (<>), (<\>)