add-vector-float

4 files changed, 68 insertions, 0 deletions

diff --git a/lib/Numeric/LinearAlgebra/Instances.hs b/lib/Numeric/LinearAlgebra/Instances.hs
index 1992db0..bba89c8 100644
--- a/lib/Numeric/LinearAlgebra/Instances.hs
+++ b/lib/Numeric/LinearAlgebra/Instances.hs
@@ -94,6 +94,14 @@ instance Linear Vector a => Eq (Vector a) where
 
 #endif
 
+instance Num (Vector Float) where
+    (+) = adaptScalar addConstant add (flip addConstant)
+    negate = scale (-1)
+    (*) = adaptScalar scale mul (flip scale)
+    signum = vectorMapF Sign
+    abs = vectorMapF Abs
+    fromInteger = fromList . return . fromInteger
+
 instance Num (Vector Double) where
     (+) = adaptScalar addConstant add (flip addConstant)
     negate = scale (-1)
@@ -138,6 +146,27 @@ instance (Linear Vector a, Fractional (Vector a), Num (Matrix a)) => Fractional
 
 ---------------------------------------------------------
 
+instance Floating (Vector Float) where
+    sin   = vectorMapF Sin
+    cos   = vectorMapF Cos
+    tan   = vectorMapF Tan
+    asin  = vectorMapF ASin
+    acos  = vectorMapF ACos
+    atan  = vectorMapF ATan
+    sinh  = vectorMapF Sinh
+    cosh  = vectorMapF Cosh
+    tanh  = vectorMapF Tanh
+    asinh = vectorMapF ASinh
+    acosh = vectorMapF ACosh
+    atanh = vectorMapF ATanh
+    exp   = vectorMapF Exp
+    log   = vectorMapF Log
+    sqrt  = vectorMapF Sqrt
+    (**)  = adaptScalar (vectorMapValF PowSV) (vectorZipF Pow) (flip (vectorMapValF PowVS))
+    pi    = fromList [pi]
+
+-------------------------------------------------------------
+
 instance Floating (Vector Double) where
     sin   = vectorMapR Sin
     cos   = vectorMapR Cos
diff --git a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c
index fd840e3..b9c2572 100644
--- a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c
+++ b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c
@@ -1039,6 +1039,18 @@ int multiplyC(int ta, int tb, KCMAT(a),KCMAT(b),CMAT(r)) {
 
 //////////////////// transpose /////////////////////////
 
+int transF(KFMAT(x),FMAT(t)) {
+    REQUIRES(xr==tc && xc==tr,BAD_SIZE);
+    DEBUGMSG("transF");
+    int i,j;
+    for (i=0; i<tr; i++) {
+        for (j=0; j<tc; j++) {
+        tp[i*tc+j] = xp[j*xc+i];
+        }
+    }
+    OK
+}
+
 int transR(KDMAT(x),DMAT(t)) {
     REQUIRES(xr==tc && xc==tr,BAD_SIZE);
     DEBUGMSG("transR");
@@ -1065,6 +1077,16 @@ int transC(KCMAT(x),CMAT(t)) {
 
 //////////////////// constant /////////////////////////
 
+int constantF(float * pval, FVEC(r)) {
+    DEBUGMSG("constantF")
+    int k;
+    double val = *pval;
+    for(k=0;k<rn;k++) {
+        rp[k]=val;
+    }
+    OK
+}
+
 int constantR(double * pval, DVEC(r)) {
     DEBUGMSG("constantR")
     int k;
diff --git a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h
index adf096e..415a6ab 100644
--- a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h
+++ b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h
@@ -40,13 +40,17 @@ typedef short ftnlen;
 
 /********************************************************/
 
+#define FVEC(A) int A##n, float*A##p
 #define DVEC(A) int A##n, double*A##p
 #define CVEC(A) int A##n, double*A##p
+#define FMAT(A) int A##r, int A##c, float* A##p
 #define DMAT(A) int A##r, int A##c, double* A##p
 #define CMAT(A) int A##r, int A##c, double* A##p
 
+#define KFVEC(A) int A##n, const float*A##p
 #define KDVEC(A) int A##n, const double*A##p
 #define KCVEC(A) int A##n, const double*A##p
+#define KFMAT(A) int A##r, int A##c, const float* A##p
 #define KDMAT(A) int A##r, int A##c, const double* A##p
 #define KCMAT(A) int A##r, int A##c, const double* A##p
 
@@ -55,9 +59,11 @@ typedef short ftnlen;
 int multiplyR(int ta, int tb, KDMAT(a),KDMAT(b),DMAT(r));
 int multiplyC(int ta, int tb, KCMAT(a),KCMAT(b),CMAT(r));
 
+int transF(KFMAT(x),FMAT(t));
 int transR(KDMAT(x),DMAT(t));
 int transC(KCMAT(x),CMAT(t));
 
+int constantF(float * pval, FVEC(r));
 int constantR(double * pval, DVEC(r));
 int constantC(doublecomplex* pval, CVEC(r));
 
diff --git a/lib/Numeric/LinearAlgebra/Linear.hs b/lib/Numeric/LinearAlgebra/Linear.hs
index c802712..481d72a 100644
--- a/lib/Numeric/LinearAlgebra/Linear.hs
+++ b/lib/Numeric/LinearAlgebra/Linear.hs
@@ -42,6 +42,17 @@ class (Container c e) => Linear c e where
     equal       :: c e -> c e -> Bool
 
 
+instance Linear Vector Float where
+    scale = vectorMapValF Scale
+    scaleRecip = vectorMapValF Recip
+    addConstant = vectorMapValF AddConstant
+    add = vectorZipF Add
+    sub = vectorZipF Sub
+    mul = vectorZipF Mul
+    divide = vectorZipF Div
+    equal u v = dim u == dim v && vectorFMax (vectorMapF Abs (sub u v)) == 0.0
+    scalar x = fromList [x]
+
 instance Linear Vector Double where
     scale = vectorMapValR Scale
     scaleRecip = vectorMapValR Recip