From 861753b66e70b4071c5434cfe210e96dc4ab0f6d Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Sun, 24 May 2015 14:22:22 +0200 Subject: Container, Product and Num instances for CInt elements --- packages/base/src/C/vector-aux.c | 145 ++++++++++++++++++++-- packages/base/src/Data/Packed/Internal/Numeric.hs | 30 ++--- packages/base/src/Numeric/Vector.hs | 8 ++ packages/base/src/Numeric/Vectorized.hs | 105 ++++++++++------ 4 files changed, 221 insertions(+), 67 deletions(-) diff --git a/packages/base/src/C/vector-aux.c b/packages/base/src/C/vector-aux.c index 58afc49..b67275f 100644 --- a/packages/base/src/C/vector-aux.c +++ b/packages/base/src/C/vector-aux.c @@ -46,7 +46,7 @@ int sumF(KFVEC(x),FVEC(r)) { rp[0] = res; OK } - + int sumR(KDVEC(x),DVEC(r)) { DEBUGMSG("sumR"); REQUIRES(rn==1,BAD_SIZE); @@ -57,6 +57,15 @@ int sumR(KDVEC(x),DVEC(r)) { OK } +int sumI(KIVEC(x),IVEC(r)) { + REQUIRES(rn==1,BAD_SIZE); + int i; + int res = 0; + for (i = 0; i < xn; i++) res += xp[i]; + rp[0] = res; + OK +} + int sumQ(KQVEC(x),QVEC(r)) { DEBUGMSG("sumQ"); @@ -72,7 +81,7 @@ int sumQ(KQVEC(x),QVEC(r)) { rp[0] = res; OK } - + int sumC(KCVEC(x),CVEC(r)) { DEBUGMSG("sumC"); REQUIRES(rn==1,BAD_SIZE); @@ -98,7 +107,7 @@ int prodF(KFVEC(x),FVEC(r)) { rp[0] = res; OK } - + int prodR(KDVEC(x),DVEC(r)) { DEBUGMSG("prodR"); REQUIRES(rn==1,BAD_SIZE); @@ -109,6 +118,16 @@ int prodR(KDVEC(x),DVEC(r)) { OK } +int prodI(KIVEC(x),IVEC(r)) { + REQUIRES(rn==1,BAD_SIZE); + int i; + int res = 1; + for (i = 0; i < xn; i++) res *= xp[i]; + rp[0] = res; + OK +} + + int prodQ(KQVEC(x),QVEC(r)) { DEBUGMSG("prodQ"); @@ -126,7 +145,7 @@ int prodQ(KQVEC(x),QVEC(r)) { rp[0] = res; OK } - + int prodC(KCVEC(x),CVEC(r)) { DEBUGMSG("prodC"); REQUIRES(rn==1,BAD_SIZE); @@ -144,7 +163,7 @@ int prodC(KCVEC(x),CVEC(r)) { OK } - + double dnrm2_(integer*, const double*, integer*); double dasum_(integer*, const double*, integer*); @@ -189,8 +208,8 @@ double vector_min_index(KDVEC(x)) { } return r; } - -int toScalarR(int code, KDVEC(x), DVEC(r)) { + +int toScalarR(int code, KDVEC(x), DVEC(r)) { REQUIRES(rn==1,BAD_SIZE); DEBUGMSG("toScalarR"); double res; @@ -256,7 +275,7 @@ float vector_min_index_f(KFVEC(x)) { } -int toScalarF(int code, KFVEC(x), FVEC(r)) { +int toScalarF(int code, KFVEC(x), FVEC(r)) { REQUIRES(rn==1,BAD_SIZE); DEBUGMSG("toScalarF"); float res; @@ -275,10 +294,68 @@ int toScalarF(int code, KFVEC(x), FVEC(r)) { OK } +int vector_max_i(KIVEC(x)) { + int r = xp[0]; + int k; + for (k = 1; kr) { + r = xp[k]; + } + } + return r; +} + +int vector_min_i(KIVEC(x)) { + float r = xp[0]; + int k; + for (k = 1; kxp[r]) { + r = k; + } + } + return r; +} + +int vector_min_index_i(KIVEC(x)) { + int k, r = 0; + for (k = 1; k) --- minIndex' = emptyErrorV "minIndex" (round . toScalarF MinIdx) --- maxIndex' = emptyErrorV "maxIndex" (round . toScalarF MaxIdx) --- minElement' = emptyErrorV "minElement" (toScalarF Min) --- maxElement' = emptyErrorV "maxElement" (toScalarF Max) --- sumElements' = sumF --- prodElements' = prodF + minIndex' = emptyErrorV "minIndex" (fromIntegral . toScalarI MinIdx) + maxIndex' = emptyErrorV "maxIndex" (fromIntegral . toScalarI MaxIdx) + minElement' = emptyErrorV "minElement" (toScalarI Min) + maxElement' = emptyErrorV "maxElement" (toScalarI Max) + sumElements' = sumI + prodElements' = prodI step' = stepI find' = findV assoc' = assocV @@ -569,9 +569,9 @@ instance Product (Complex Double) where instance Product CInt where norm2 = undefined --- absSum = emptyVal (toScalarF AbsSum) --- norm1 = emptyVal (toScalarF AbsSum) --- normInf = emptyVal (maxElement . vectorMapF Abs) + absSum = emptyVal (sumElements . vectorMapI Abs) + norm1 = absSum + normInf = emptyVal (maxElement . vectorMapI Abs) multiply = emptyMul multiplyI diff --git a/packages/base/src/Numeric/Vector.hs b/packages/base/src/Numeric/Vector.hs index 1c16871..6cac5dc 100644 --- a/packages/base/src/Numeric/Vector.hs +++ b/packages/base/src/Numeric/Vector.hs @@ -32,6 +32,14 @@ adaptScalar f1 f2 f3 x y ------------------------------------------------------------------ +instance Num (Vector CInt) where + (+) = adaptScalar addConstant add (flip addConstant) + negate = scale (-1) + (*) = adaptScalar scale mul (flip scale) + signum = vectorMapI Sign + abs = vectorMapI Abs + fromInteger = fromList . return . fromInteger + instance Num (Vector Float) where (+) = adaptScalar addConstant add (flip addConstant) negate = scale (-1) diff --git a/packages/base/src/Numeric/Vectorized.hs b/packages/base/src/Numeric/Vectorized.hs index 405ae01..70bd48b 100644 --- a/packages/base/src/Numeric/Vectorized.hs +++ b/packages/base/src/Numeric/Vectorized.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Numeric.Vectorized --- Copyright : (c) Alberto Ruiz 2007-14 +-- Copyright : (c) Alberto Ruiz 2007-15 -- License : BSD3 -- Maintainer : Alberto Ruiz -- Stability : provisional @@ -11,12 +11,12 @@ ----------------------------------------------------------------------------- module Numeric.Vectorized ( - sumF, sumR, sumQ, sumC, - prodF, prodR, prodQ, prodC, - FunCodeS(..), toScalarR, toScalarF, toScalarC, toScalarQ, - FunCodeV(..), vectorMapR, vectorMapC, vectorMapF, vectorMapQ, - FunCodeSV(..), vectorMapValR, vectorMapValC, vectorMapValF, vectorMapValQ, - FunCodeVV(..), vectorZipR, vectorZipC, vectorZipF, vectorZipQ, + sumF, sumR, sumQ, sumC, sumI, + prodF, prodR, prodQ, prodC, prodI, + FunCodeS(..), toScalarR, toScalarF, toScalarC, toScalarQ, toScalarI, + FunCodeV(..), vectorMapR, vectorMapC, vectorMapF, vectorMapQ, vectorMapI, + FunCodeSV(..), vectorMapValR, vectorMapValC, vectorMapValF, vectorMapValQ, vectorMapValI, + FunCodeVV(..), vectorZipR, vectorZipC, vectorZipF, vectorZipQ, vectorZipI, vectorScan, saveMatrix, Seed, RandDist(..), randomVector, sortVector, roundVector @@ -67,6 +67,8 @@ data FunCodeSV = Scale | Negate | PowSV | PowVS + | ModSV + | ModVS deriving Enum data FunCodeVV = Add @@ -75,6 +77,7 @@ data FunCodeVV = Add | Div | Pow | ATan2 + | Mod deriving Enum data FunCodeS = Norm2 @@ -89,69 +92,67 @@ data FunCodeS = Norm2 -- | sum of elements sumF :: Vector Float -> Float -sumF x = unsafePerformIO $ do - r <- createVector 1 - app2 c_sumF vec x vec r "sumF" - return $ r @> 0 +sumF = sumg c_sumF -- | sum of elements sumR :: Vector Double -> Double -sumR x = unsafePerformIO $ do - r <- createVector 1 - app2 c_sumR vec x vec r "sumR" - return $ r @> 0 +sumR = sumg c_sumR -- | sum of elements sumQ :: Vector (Complex Float) -> Complex Float -sumQ x = unsafePerformIO $ do - r <- createVector 1 - app2 c_sumQ vec x vec r "sumQ" - return $ r @> 0 +sumQ = sumg c_sumQ -- | sum of elements sumC :: Vector (Complex Double) -> Complex Double -sumC x = unsafePerformIO $ do - r <- createVector 1 - app2 c_sumC vec x vec r "sumC" - return $ r @> 0 +sumC = sumg c_sumC + +-- | sum of elements +sumI :: Vector CInt -> CInt +sumI = sumg c_sumI + +sumg f x = unsafePerformIO $ do + r <- createVector 1 + app2 f vec x vec r "sum" + return $ r @> 0 foreign import ccall unsafe "sumF" c_sumF :: TFF foreign import ccall unsafe "sumR" c_sumR :: TVV foreign import ccall unsafe "sumQ" c_sumQ :: TQVQV foreign import ccall unsafe "sumC" c_sumC :: TCVCV +foreign import ccall unsafe "sumC" c_sumI :: CV CInt (CV CInt (IO CInt)) -- | product of elements prodF :: Vector Float -> Float -prodF x = unsafePerformIO $ do - r <- createVector 1 - app2 c_prodF vec x vec r "prodF" - return $ r @> 0 +prodF = prodg c_prodF -- | product of elements prodR :: Vector Double -> Double -prodR x = unsafePerformIO $ do - r <- createVector 1 - app2 c_prodR vec x vec r "prodR" - return $ r @> 0 +prodR = prodg c_prodR -- | product of elements prodQ :: Vector (Complex Float) -> Complex Float -prodQ x = unsafePerformIO $ do - r <- createVector 1 - app2 c_prodQ vec x vec r "prodQ" - return $ r @> 0 +prodQ = prodg c_prodQ -- | product of elements prodC :: Vector (Complex Double) -> Complex Double -prodC x = unsafePerformIO $ do - r <- createVector 1 - app2 c_prodC vec x vec r "prodC" - return $ r @> 0 +prodC = prodg c_prodC + +-- | product of elements +prodI :: Vector CInt -> CInt +prodI = prodg c_prodI + + +prodg f x = unsafePerformIO $ do + r <- createVector 1 + app2 f vec x vec r "prod" + return $ r @> 0 + foreign import ccall unsafe "prodF" c_prodF :: TFF foreign import ccall unsafe "prodR" c_prodR :: TVV foreign import ccall unsafe "prodQ" c_prodQ :: TQVQV foreign import ccall unsafe "prodC" c_prodC :: TCVCV +foreign import ccall unsafe "prodI" c_prodI :: CV CInt (CV CInt (IO CInt)) ------------------------------------------------------------------ @@ -203,6 +204,12 @@ toScalarQ oper = toScalarAux c_toScalarQ (fromei oper) foreign import ccall unsafe "toScalarQ" c_toScalarQ :: CInt -> TQVF +-- | obtains different functions of a vector: norm1, norm2, max, min, posmax, posmin, etc. +toScalarI :: FunCodeS -> Vector CInt -> CInt +toScalarI oper = toScalarAux c_toScalarI (fromei oper) + +foreign import ccall unsafe "toScalarI" c_toScalarI :: CInt -> CV CInt (CV CInt (IO CInt)) + ------------------------------------------------------------------ -- | map of real vectors with given function @@ -229,6 +236,12 @@ vectorMapQ = vectorMapAux c_vectorMapQ foreign import ccall unsafe "mapQ" c_vectorMapQ :: CInt -> TQVQV +-- | map of real vectors with given function +vectorMapI :: FunCodeV -> Vector CInt -> Vector CInt +vectorMapI = vectorMapAux c_vectorMapI + +foreign import ccall unsafe "mapI" c_vectorMapI :: CInt -> CV CInt (CV CInt (IO CInt)) + ------------------------------------------------------------------- -- | map of real vectors with given function @@ -255,6 +268,13 @@ vectorMapValQ oper = vectorMapValAux c_vectorMapValQ (fromei oper) foreign import ccall unsafe "mapValQ" c_vectorMapValQ :: CInt -> Ptr (Complex Float) -> TQVQV +-- | map of real vectors with given function +vectorMapValI :: FunCodeSV -> CInt -> Vector CInt -> Vector CInt +vectorMapValI oper = vectorMapValAux c_vectorMapValI (fromei oper) + +foreign import ccall unsafe "mapValI" c_vectorMapValI :: CInt -> Ptr CInt -> CV CInt (CV CInt (IO CInt)) + + ------------------------------------------------------------------- -- | elementwise operation on real vectors @@ -281,6 +301,13 @@ vectorZipQ = vectorZipAux c_vectorZipQ foreign import ccall unsafe "zipQ" c_vectorZipQ :: CInt -> TQVQVQV +-- | elementwise operation on CInt vectors +vectorZipI :: FunCodeVV -> Vector CInt -> Vector CInt -> Vector CInt +vectorZipI = vectorZipAux c_vectorZipI + +foreign import ccall unsafe "zipI" c_vectorZipI :: CInt -> CV CInt (CV CInt (CV CInt (IO CInt))) + + -------------------------------------------------------------------------------- foreign import ccall unsafe "vectorScan" c_vectorScan -- cgit v1.2.3