Linear and Floating (Complex Float)

4 files changed, 68 insertions, 0 deletions

diff --git a/lib/Numeric/LinearAlgebra/Instances.hs b/lib/Numeric/LinearAlgebra/Instances.hs
index bba89c8..04a9d88 100644
--- a/lib/Numeric/LinearAlgebra/Instances.hs
+++ b/lib/Numeric/LinearAlgebra/Instances.hs
@@ -118,6 +118,14 @@ instance Num (Vector (Complex Double)) where
     abs = vectorMapC Abs
     fromInteger = fromList . return . fromInteger
 
+instance Num (Vector (Complex Float)) where
+    (+) = adaptScalar addConstant add (flip addConstant)
+    negate = scale (-1)
+    (*) = adaptScalar scale mul (flip scale)
+    signum = vectorMapQ Sign
+    abs = vectorMapQ Abs
+    fromInteger = fromList . return . fromInteger
+
 instance Linear Matrix a => Eq (Matrix a) where
     (==) = equal
 
@@ -209,6 +217,27 @@ instance Floating (Vector (Complex Double)) where
 
 -----------------------------------------------------------
 
+instance Floating (Vector (Complex Float)) where
+    sin   = vectorMapQ Sin
+    cos   = vectorMapQ Cos
+    tan   = vectorMapQ Tan
+    asin  = vectorMapQ ASin
+    acos  = vectorMapQ ACos
+    atan  = vectorMapQ ATan
+    sinh  = vectorMapQ Sinh
+    cosh  = vectorMapQ Cosh
+    tanh  = vectorMapQ Tanh
+    asinh = vectorMapQ ASinh
+    acosh = vectorMapQ ACosh
+    atanh = vectorMapQ ATanh
+    exp   = vectorMapQ Exp
+    log   = vectorMapQ Log
+    sqrt  = vectorMapQ Sqrt
+    (**)  = adaptScalar (vectorMapValQ PowSV) (vectorZipQ Pow) (flip (vectorMapValQ PowVS))
+    pi    = fromList [pi]
+
+-----------------------------------------------------------
+
 instance (Linear Vector a, Floating (Vector a), Fractional (Matrix a)) => Floating (Matrix a) where
     sin   = liftMatrix sin
     cos   = liftMatrix cos
diff --git a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c
index b9c2572..7a40991 100644
--- a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c
+++ b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c
@@ -1063,6 +1063,18 @@ int transR(KDMAT(x),DMAT(t)) {
     OK
 }
 
+int transQ(KQMAT(x),QMAT(t)) {
+    REQUIRES(xr==tc && xc==tr,BAD_SIZE);
+    DEBUGMSG("transQ");
+    int i,j;
+    for (i=0; i<tr; i++) {
+        for (j=0; j<tc; j++) {
+        ((complex*)tp)[i*tc+j] = ((complex*)xp)[j*xc+i];
+        }
+    }
+    OK
+}
+
 int transC(KCMAT(x),CMAT(t)) {
     REQUIRES(xr==tc && xc==tr,BAD_SIZE);
     DEBUGMSG("transC");
@@ -1097,6 +1109,16 @@ int constantR(double * pval, DVEC(r)) {
     OK
 }
 
+int constantQ(complex* pval, QVEC(r)) {
+    DEBUGMSG("constantQ")
+    int k;
+    complex val = *pval;
+    for(k=0;k<rn;k++) {
+        ((complex*)rp)[k]=val;
+    }
+    OK
+}
+
 int constantC(doublecomplex* pval, CVEC(r)) {
     DEBUGMSG("constantC")
     int k;
diff --git a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h
index 415a6ab..d01d9e5 100644
--- a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h
+++ b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h
@@ -42,16 +42,20 @@ typedef short ftnlen;
 
 #define FVEC(A) int A##n, float*A##p
 #define DVEC(A) int A##n, double*A##p
+#define QVEC(A) int A##n, float*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 QMAT(A) int A##r, int A##c, float* 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 KQVEC(A) int A##n, const float*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 KQMAT(A) int A##r, int A##c, const float* A##p
 #define KCMAT(A) int A##r, int A##c, const double* A##p
 
 /********************************************************/
@@ -61,10 +65,12 @@ 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 transQ(KQMAT(x),QMAT(t));
 int transC(KCMAT(x),CMAT(t));
 
 int constantF(float * pval, FVEC(r));
 int constantR(double * pval, DVEC(r));
+int constantQ(complex* pval, QVEC(r));
 int constantC(doublecomplex* pval, CVEC(r));
 
 int svd_l_R(KDMAT(x),DMAT(u),DVEC(s),DMAT(v));
diff --git a/lib/Numeric/LinearAlgebra/Linear.hs b/lib/Numeric/LinearAlgebra/Linear.hs
index aed6a2b..2351ff1 100644
--- a/lib/Numeric/LinearAlgebra/Linear.hs
+++ b/lib/Numeric/LinearAlgebra/Linear.hs
@@ -132,6 +132,17 @@ instance Linear Vector (Complex Double) where
     equal u v = dim u == dim v && vectorMax (mapVector magnitude (sub u v)) == 0.0
     scalar x = fromList [x]
 
+instance Linear Vector (Complex Float) where
+    scale = vectorMapValQ Scale
+    scaleRecip = vectorMapValQ Recip
+    addConstant = vectorMapValQ AddConstant
+    add = vectorZipQ Add
+    sub = vectorZipQ Sub
+    mul = vectorZipQ Mul
+    divide = vectorZipQ Div
+    equal u v = dim u == dim v && vectorMax (mapVector magnitude (sub u v)) == 0.0
+    scalar x = fromList [x]
+
 instance (Linear Vector a, Container Matrix a) => (Linear Matrix a) where
     scale x = liftMatrix (scale x)
     scaleRecip x = liftMatrix (scaleRecip x)