From 7ddccab219ab64f066d8913c9f3c60afe2831d4b Mon Sep 17 00:00:00 2001 From: Vivian McPhail Date: Tue, 6 Jul 2010 06:20:04 +0000 Subject: complex implementations for Vectors typeclass --- lib/Data/Packed/Internal/Signatures.hs | 2 ++ lib/Numeric/GSL/Vector.hs | 14 +++++++++- lib/Numeric/GSL/gsl-aux.c | 29 ++++++++++++++++++++ lib/Numeric/LinearAlgebra/Interface.hs | 2 +- lib/Numeric/LinearAlgebra/Linear.hs | 49 ++++++++++++++++------------------ 5 files changed, 68 insertions(+), 28 deletions(-) (limited to 'lib') 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 ---------------------------------------------------- -- cgit v1.2.3