Container, Product and Num instances for CInt elements

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; k<xn; k++) {
+        if(xp[k]>r) {
+            r = xp[k];
+        }
+    }
+    return r;
+}
+
+int vector_min_i(KIVEC(x)) {
+    float r = xp[0];
+    int k;
+    for (k = 1; k<xn; k++) {
+        if(xp[k]<r) {
+            r = xp[k];
+        }
+    }
+    return r;
+}
+
+int vector_max_index_i(KIVEC(x)) {
+    int k, r = 0;
+    for (k = 1; k<xn; k++) {
+        if(xp[k]>xp[r]) {
+            r = k;
+        }
+    }
+    return r;
+}
+
+int vector_min_index_i(KIVEC(x)) {
+    int k, r = 0;
+    for (k = 1; k<xn; k++) {
+        if(xp[k]<xp[r]) {
+            r = k;
+        }
+    }
+    return r;
+}
+
+
+int toScalarI(int code, KIVEC(x), IVEC(r)) {
+    REQUIRES(rn==1,BAD_SIZE);
+    int res;
+    switch(code) {
+        case 2: { res = vector_max_index_i(V(x));  break; }
+        case 3: { res = vector_max_i(V(x));  break; }
+        case 4: { res = vector_min_index_i(V(x)); break; }
+        case 5: { res = vector_min_i(V(x)); break; }
+        default: ERROR(BAD_CODE);
+    }
+    rp[0] = res;
+    OK
+}
+
+
 double dznrm2_(integer*, const doublecomplex*, integer*);
 double dzasum_(integer*, const doublecomplex*, integer*);
 
-int toScalarC(int code, KCVEC(x), DVEC(r)) { 
+int toScalarC(int code, KCVEC(x), DVEC(r)) {
     REQUIRES(rn==1,BAD_SIZE);
     DEBUGMSG("toScalarC");
     double res;
@@ -297,7 +374,7 @@ int toScalarC(int code, KCVEC(x), DVEC(r)) {
 double scnrm2_(integer*, const complex*, integer*);
 double scasum_(integer*, const complex*, integer*);
 
-int toScalarQ(int code, KQVEC(x), FVEC(r)) { 
+int toScalarQ(int code, KQVEC(x), FVEC(r)) {
     REQUIRES(rn==1,BAD_SIZE);
     DEBUGMSG("toScalarQ");
     float res;
@@ -389,6 +466,18 @@ int mapF(int code, KFVEC(x), FVEC(r)) {
 }
 
 
+int mapI(int code, KIVEC(x), IVEC(r)) {
+    int k;
+    REQUIRES(xn == rn,BAD_SIZE);
+    switch (code) {
+        OP(3,abs)
+        OP(15,sign)
+        default: ERROR(BAD_CODE);
+    }
+}
+
+
+
 inline double abs_complex(doublecomplex z) {
     return sqrt(z.r*z.r + z.i*z.i);
 }
@@ -526,6 +615,22 @@ int mapValF(int code, float* pval, KFVEC(x), FVEC(r)) {
     }
 }
 
+int mapValI(int code, int* pval, KIVEC(x), IVEC(r)) {
+    int k;
+    int val = *pval;
+    REQUIRES(xn == rn,BAD_SIZE);
+    DEBUGMSG("mapValI");
+    switch (code) {
+        OPV(0,val*xp[k])
+        OPV(1,val/xp[k])
+        OPV(2,val+xp[k])
+        OPV(3,val-xp[k])
+        OPV(6,val%xp[k])
+        OPV(7,xp[k]%val)
+        default: ERROR(BAD_CODE);
+    }
+}
+
 
 
 inline doublecomplex complex_add(doublecomplex a, doublecomplex b) {
@@ -608,6 +713,20 @@ REQUIRES(an == bn && an == rn, BAD_SIZE);
 }
 
 
+int zipI(int code, KIVEC(a), KIVEC(b), IVEC(r)) {
+REQUIRES(an == bn && an == rn, BAD_SIZE);
+    int k;
+    switch(code) {
+        OPZO(0,"zipI Add",+)
+        OPZO(1,"zipI Sub",-)
+        OPZO(2,"zipI Mul",*)
+        OPZO(3,"zipI Div",/)
+        OPZO(6,"zipI Mod",%)
+        default: ERROR(BAD_CODE);
+    }
+}
+
+
 
 #define OPZOb(C,msg,O) case C: {DEBUGMSG(msg) for(k=0;k<an;k++) r2p[k] = a2p[k] O b2p[k]; OK }
 #define OPZEb(C,msg,E) case C: {DEBUGMSG(msg) for(k=0;k<an;k++) r2p[k] = E(a2p[k],b2p[k]); OK }
@@ -679,7 +798,7 @@ int vectorScan(char * file, int* n, double**pp){
     *pp = p;
     fclose(fp);
     OK
-}    
+}
 
 int saveMatrix(char * file, char * format, KDMAT(a)){
     FILE * fp;
@@ -754,7 +873,7 @@ int random_vector(unsigned int seed, int code, DVEC(r)) {
     double V1,V2,S;
 
     srandom(seed);
-    
+
     int k;
     switch (code) {
       case 0: { // uniform
@@ -816,7 +935,7 @@ int random_vector(unsigned int seed, int code, DVEC(r)) {
     char   random_state[128];
     memset(&buffer, 0, sizeof(struct random_data));
     memset(random_state, 0, sizeof(random_state));
-    
+
     initstate_r(seed,random_state,sizeof(random_state),&buffer);
     // setstate_r(random_state,&buffer);
     // srandom_r(seed,&buffer);
diff --git a/packages/base/src/Data/Packed/Internal/Numeric.hs b/packages/base/src/Data/Packed/Internal/Numeric.hs
index e6fcd31..6c30a72 100644
--- a/packages/base/src/Data/Packed/Internal/Numeric.hs
+++ b/packages/base/src/Data/Packed/Internal/Numeric.hs
@@ -186,23 +186,23 @@ instance Container Vector CInt
   where
     conj' = id
     size' = dim
---    scale' = vectorMapValF Scale
---    addConstant = vectorMapValF AddConstant
---    add = vectorZipF Add
---    sub = vectorZipF Sub
---    mul = vectorZipF Mul
---    equal u v = dim u == dim v && maxElement (vectorMapF Abs (sub u v)) == 0.0
+    scale' = vectorMapValI Scale
+    addConstant = vectorMapValI AddConstant
+    add = vectorZipI Add
+    sub = vectorZipI Sub
+    mul = vectorZipI Mul
+    equal u v = dim u == dim v && maxElement' (vectorMapI Abs (sub u v)) == 0
     scalar' x = fromList [x]
     konst' = constantD
     build' = buildV
     cmap' = mapVector
     atIndex' = (@>)
---    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