refactoring norms

1 files changed, 52 insertions, 3 deletions

diff --git a/lib/Numeric/LinearAlgebra/Interface.hs b/lib/Numeric/LinearAlgebra/Interface.hs
index 542d76e..ec08694 100644
--- a/lib/Numeric/LinearAlgebra/Interface.hs
+++ b/lib/Numeric/LinearAlgebra/Interface.hs
@@ -1,4 +1,5 @@
 {-# OPTIONS_GHC -fglasgow-exts #-}
+{-# LANGUAGE UndecidableInstances #-}
 -----------------------------------------------------------------------------
 {- |
 Module      :  Numeric.LinearAlgebra.Interface
@@ -18,7 +19,7 @@ In the context of the standard numeric operators, one-component vectors and matr
 -----------------------------------------------------------------------------
 
 module Numeric.LinearAlgebra.Interface(
-    (<>),(<.>),
+    (<>),(<.>),mulG, Adapt, adaptElements,
     (<\>),
     (.*),(*/),
     (<|>),(<->),
@@ -28,22 +29,28 @@ import Data.Packed.Vector
 import Data.Packed.Matrix
 import Numeric.LinearAlgebra.Algorithms
 import Numeric.LinearAlgebra.Linear
+import Data.Complex
+import Control.Arrow((***))
 
 --import Numeric.GSL.Vector
 
 class Mul a b c | a b -> c where
  infixl 7 <>
  -- | Matrix-matrix, matrix-vector, and vector-matrix products.
- (<>) :: Prod t => a t -> b t -> c t
+ (<>)  :: Product t => a t -> b t -> c t
+ mulG :: (Element r, Element s, Adapt r s t t, Product t) => a r -> b s -> c t
 
 instance Mul Matrix Matrix Matrix where
-    (<>) = multiply
+    (<>) = mXm
+    mulG a b = uncurry mXm (curry adapt a b)
 
 instance Mul Matrix Vector Vector where
     (<>) m v = flatten $ m <> (asColumn v)
+    mulG m v = flatten $ m `mulG` (asColumn v)
 
 instance Mul Vector Matrix Vector where
     (<>) v m = flatten $ (asRow v) <> m
+    mulG v m = flatten $ (asRow v) `mulG` m
 
 ---------------------------------------------------
 
@@ -120,3 +127,45 @@ a <-> b = joinV a b
 
 ----------------------------------------------------
 
+class Adapt a b c d | a b -> c, a b -> d where
+    adapt :: Container k => (k a, k b) -> (k c, k d) 
+
+--instance Adapt a a a a where
+--    adapt = id *** id
+
+instance Adapt Float Float Float Float where
+    adapt = id *** id
+
+instance Adapt Double Double Double Double where
+    adapt = id *** id
+
+instance Adapt (Complex Float) (Complex Float) (Complex Float) (Complex Float) where
+    adapt = id *** id
+
+instance Adapt Float Double Double Double where
+    adapt = double *** id
+
+instance Adapt Double Float Double Double where
+    adapt = id *** double
+
+instance Adapt Float (Complex Float) (Complex Float) (Complex Float) where
+    adapt = complex *** id
+
+instance Adapt (Complex Float) Float (Complex Float) (Complex Float) where
+    adapt = id *** complex
+
+instance (Convert a, Convert (DoubleOf a), ComplexOf (DoubleOf a) ~ Complex Double) => Adapt a (Complex Double) (Complex Double) (Complex Double) where
+    adapt = complex.double *** id
+
+instance (Convert a, Convert (DoubleOf a), ComplexOf (DoubleOf a) ~ Complex Double) => Adapt (Complex Double) a (Complex Double) (Complex Double) where
+    adapt = id *** complex.double
+
+instance Adapt Double (Complex Float) (Complex Double) (Complex Double) where
+    adapt = complex *** double
+
+instance Adapt (Complex Float) Double (Complex Double) (Complex Double) where
+    adapt = double *** complex
+
+adaptElements:: (Adapt a b c d, Container k) => (k a, k b) -> (k c, k d)
+adaptElements p = adapt p
+