complex implementations for Vectors typeclass

5 files changed, 68 insertions, 28 deletions

diff --git a/lib/Data/Packed/Internal/Signatures.hs b/lib/Data/Packed/Internal/Signatures.hs
index 1370dbc..78d00fa 100644
--- a/lib/Data/Packed/Internal/Signatures.hs
+++ b/lib/Data/Packed/Internal/Signatures.hs
@@ -54,9 +54,11 @@ type TCMCMCM = CInt -> CInt -> PC -> TCMCM      --
 type TCV = CInt -> PC -> IO CInt                --
 type TCVCV = CInt -> PC -> TCV                  --
 type TCVCVCV = CInt -> PC -> TCVCV              --
+type TCVV = CInt -> PC -> TV                    --
 type TQV = CInt -> PQ -> IO CInt                --
 type TQVQV = CInt -> PQ -> TQV                  --
 type TQVQVQV = CInt -> PQ -> TQVQV              --
+type TQVF = CInt -> PQ -> TF                    --
 type TCMCV = CInt -> CInt -> PC -> TCV          --
 type TVCV = CInt -> PD -> TCV                   --
 type TCVM = CInt -> PC -> TM                    --
diff --git a/lib/Numeric/GSL/Vector.hs b/lib/Numeric/GSL/Vector.hs
index 97a0f9c..0148c4f 100644
--- a/lib/Numeric/GSL/Vector.hs
+++ b/lib/Numeric/GSL/Vector.hs
@@ -16,7 +16,7 @@
 module Numeric.GSL.Vector (
     sumF, sumR, sumQ, sumC,
     dotF, dotR, dotQ, dotC,
-    FunCodeS(..), toScalarR, toScalarF,
+    FunCodeS(..), toScalarR, toScalarF, toScalarC, toScalarQ,
     FunCodeV(..), vectorMapR, vectorMapC, vectorMapF,
     FunCodeSV(..), vectorMapValR, vectorMapValC, vectorMapValF,
     FunCodeVV(..), vectorZipR, vectorZipC, vectorZipF,
@@ -182,6 +182,18 @@ toScalarF oper =  toScalarAux c_toScalarF (fromei oper)
 
 foreign import ccall safe "gsl-aux.h toScalarF" c_toScalarF :: CInt -> TFF
 
+-- | obtains different functions of a vector: only norm1, norm2
+toScalarC :: FunCodeS -> Vector (Complex Double) -> Double
+toScalarC oper =  toScalarAux c_toScalarC (fromei oper)
+
+foreign import ccall safe "gsl-aux.h toScalarC" c_toScalarC :: CInt -> TCVV
+
+-- | obtains different functions of a vector: only norm1, norm2
+toScalarQ :: FunCodeS -> Vector (Complex Float) -> Float
+toScalarQ oper =  toScalarAux c_toScalarQ (fromei oper)
+
+foreign import ccall safe "gsl-aux.h toScalarQ" c_toScalarQ :: CInt -> TQVF
+
 ------------------------------------------------------------------
 
 -- | map of real vectors with given function
diff --git a/lib/Numeric/GSL/gsl-aux.c b/lib/Numeric/GSL/gsl-aux.c
index fe33766..3f9eeba 100644
--- a/lib/Numeric/GSL/gsl-aux.c
+++ b/lib/Numeric/GSL/gsl-aux.c
@@ -234,6 +234,35 @@ int toScalarF(int code, KFVEC(x), FVEC(r)) {
 }
 
 
+int toScalarC(int code, KCVEC(x), RVEC(r)) { 
+    REQUIRES(rn==1,BAD_SIZE);
+    DEBUGMSG("toScalarC");
+    KCVVIEW(x);
+    double res;
+    switch(code) {
+        case 0: { res = gsl_blas_dznrm2(V(x)); break; } 
+        case 1: { res = gsl_blas_dzasum(V(x));  break; }
+        default: ERROR(BAD_CODE);
+    }
+    rp[0] = res;
+    OK
+}
+
+int toScalarQ(int code, KQVEC(x), FVEC(r)) { 
+    REQUIRES(rn==1,BAD_SIZE);
+    DEBUGMSG("toScalarQ");
+    KQVVIEW(x);
+    float res;
+    switch(code) {
+        case 0: { res = gsl_blas_scnrm2(V(x)); break; } 
+        case 1: { res = gsl_blas_scasum(V(x));  break; }
+        default: ERROR(BAD_CODE);
+    }
+    rp[0] = res;
+    OK
+}
+
+
 inline double sign(double x) {
     if(x>0) {
         return +1.0;
diff --git a/lib/Numeric/LinearAlgebra/Interface.hs b/lib/Numeric/LinearAlgebra/Interface.hs
index f8917a0..8d2b52a 100644
--- a/lib/Numeric/LinearAlgebra/Interface.hs
+++ b/lib/Numeric/LinearAlgebra/Interface.hs
@@ -28,7 +28,7 @@ import Numeric.LinearAlgebra.Instances()
 import Data.Packed.Vector
 import Data.Packed.Matrix
 import Numeric.LinearAlgebra.Algorithms
-import Numeric.LinearAlgebra.Linear
+import Numeric.LinearAlgebra.Linear()
 
 --import Numeric.GSL.Vector
 
diff --git a/lib/Numeric/LinearAlgebra/Linear.hs b/lib/Numeric/LinearAlgebra/Linear.hs
index 1651247..e718e83 100644
--- a/lib/Numeric/LinearAlgebra/Linear.hs
+++ b/lib/Numeric/LinearAlgebra/Linear.hs
@@ -16,7 +16,7 @@ Basic optimized operations on vectors and matrices.
 -----------------------------------------------------------------------------
 
 module Numeric.LinearAlgebra.Linear (
-    Vectors(..), normalise,                                    
+    Vectors(..),                                    
     Linear(..)
 ) where
 
@@ -25,21 +25,18 @@ import Data.Packed.Matrix
 import Data.Complex
 import Numeric.GSL.Vector
 
--- | normalise a vector to unit length
-normalise :: (Floating a, Vectors Vector a, 
-              Linear Vector a, Fractional (Vector a)) => Vector a -> Vector a
-normalise v = scaleRecip (vectorSum v) v 
+import Control.Monad(ap)
 
 -- | basic Vector functions
-class (Num b) => Vectors a b where
-    vectorSum :: a b -> b
-    euclidean :: a b -> b
-    absSum    :: a b -> b
-    vectorMin :: a b -> b
-    vectorMax :: a b -> b
-    minIdx    :: a b -> Int
-    maxIdx    :: a b -> Int
-    dot       :: a b -> a b -> b
+class Num e => Vectors a e where
+    vectorSum :: a e -> e
+    euclidean :: a e -> e
+    absSum    :: a e -> e
+    vectorMin :: a e -> e
+    vectorMax :: a e -> e
+    minIdx    :: a e -> Int
+    maxIdx    :: a e -> Int
+    dot       :: a e -> a e -> e
 
 instance Vectors Vector Float where
     vectorSum = sumF
@@ -63,22 +60,22 @@ instance Vectors Vector Double where
 
 instance Vectors Vector (Complex Float) where
     vectorSum = sumQ
-    euclidean = undefined
-    absSum    = undefined
-    vectorMin = undefined
-    vectorMax = undefined
-    minIdx    = undefined
-    maxIdx    = undefined
+    euclidean = (:+ 0) . toScalarQ Norm2
+    absSum    = (:+ 0) . toScalarQ AbsSum
+    vectorMin = ap (@>) minIdx
+    vectorMax = ap (@>) maxIdx
+    minIdx    = minIdx . (zipVector (*) `ap` mapVector conjugate)
+    maxIdx    = maxIdx . (zipVector (*) `ap` mapVector conjugate)
     dot       = dotQ
 
 instance Vectors Vector (Complex Double) where
     vectorSum  = sumC
-    euclidean = undefined
-    absSum    = undefined
-    vectorMin = undefined
-    vectorMax = undefined
-    minIdx    = undefined
-    maxIdx    = undefined
+    euclidean = (:+ 0) . toScalarC Norm2
+    absSum    = (:+ 0) . toScalarC AbsSum
+    vectorMin = ap (@>) minIdx
+    vectorMax = ap (@>) maxIdx
+    minIdx    = minIdx . (zipVector (*) `ap` mapVector conjugate)
+    maxIdx    = maxIdx . (zipVector (*) `ap` mapVector conjugate)
     dot       = dotC
 
 ----------------------------------------------------