From 69d1fc1588532b48a946c1501f92ed56600baf4d Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Thu, 15 May 2014 18:51:03 +0200 Subject: moved complex mapVal and zip --- packages/base/src/C/vector-aux.c | 104 +++----- packages/hmatrix/hmatrix.cabal | 3 +- packages/hmatrix/src/Numeric/GSL/Vector.hs | 58 +---- packages/hmatrix/src/Numeric/GSL/gsl-vector.c | 349 -------------------------- 4 files changed, 42 insertions(+), 472 deletions(-) delete mode 100644 packages/hmatrix/src/Numeric/GSL/gsl-vector.c (limited to 'packages') diff --git a/packages/base/src/C/vector-aux.c b/packages/base/src/C/vector-aux.c index be2dc3a..7cdc750 100644 --- a/packages/base/src/C/vector-aux.c +++ b/packages/base/src/C/vector-aux.c @@ -29,19 +29,6 @@ typedef float complex TCF; #define CHECK(RES,CODE) MACRO(if(RES) return CODE;) -#ifdef DBG -#define DEBUGMAT(MSG,X) printf(MSG" = \n"); gsl_matrix_fprintf(stdout,X,"%f"); printf("\n"); -#else -#define DEBUGMAT(MSG,X) -#endif - -#ifdef DBG -#define DEBUGVEC(MSG,X) printf(MSG" = \n"); gsl_vector_fprintf(stdout,X,"%f"); printf("\n"); -#else -#define DEBUGVEC(MSG,X) -#endif - - #define BAD_SIZE 2000 #define BAD_CODE 2001 #define MEM 2002 @@ -358,7 +345,7 @@ int mapR(int code, KDVEC(x), DVEC(r)) { OP(3,fabs) OP(4,asin) OP(5,acos) - OP(6,atan) /* atan2 using vectorZip */ + OP(6,atan) OP(7,sinh) OP(8,cosh) OP(9,tanh) @@ -384,7 +371,7 @@ int mapF(int code, KFVEC(x), FVEC(r)) { OP(3,fabs) OP(4,asin) OP(5,acos) - OP(6,atan) /* atan2 using vectorZip */ + OP(6,atan) OP(7,sinh) OP(8,cosh) OP(9,tanh) @@ -474,29 +461,8 @@ inline complex complex_f_math_fun(doublecomplex (*cf)(doublecomplex), complex a) return float_r; } -inline complex complex_f_math_op(doublecomplex (*cf)(doublecomplex,doublecomplex), - complex a,complex b) -{ - doublecomplex c1,c2,r; - - complex float_r; - - c1.r = a.r; - c1.i = a.i; - - c2.r = b.r; - c2.i = b.i; - - r = (*cf)(c1,c2); - - float_r.r = r.r; - float_r.i = r.i; - - return float_r; -} #define OPC(C,F) case C: { for(k=0;k 0) $ app3 (fun (fromei code)) vec u vec v vec r "vectorZipAux" - return r - ---------------------------------------------------------------------- - --- | map of complex vectors with given function -vectorMapValC :: FunCodeSV -> Complex Double -> Vector (Complex Double) -> Vector (Complex Double) -vectorMapValC = vectorMapValAux c_vectorMapValC - -foreign import ccall unsafe "gsl-aux.h mapValC" c_vectorMapValC :: CInt -> Ptr (Complex Double) -> TCVCV - --- | map of complex vectors with given function -vectorMapValQ :: FunCodeSV -> Complex Float -> Vector (Complex Float) -> Vector (Complex Float) -vectorMapValQ oper = vectorMapValAux c_vectorMapValQ (fromei oper) - -foreign import ccall unsafe "gsl-aux.h mapValQ" c_vectorMapValQ :: CInt -> Ptr (Complex Float) -> TQVQV - -------------------------------------------------------------------- - --- | elementwise operation on complex vectors -vectorZipC :: FunCodeVV -> Vector (Complex Double) -> Vector (Complex Double) -> Vector (Complex Double) -vectorZipC = vectorZipAux c_vectorZipC - -foreign import ccall unsafe "gsl-aux.h zipC" c_vectorZipC :: CInt -> TCVCVCV - --- | elementwise operation on complex vectors -vectorZipQ :: FunCodeVV -> Vector (Complex Float) -> Vector (Complex Float) -> Vector (Complex Float) -vectorZipQ = vectorZipAux c_vectorZipQ - -foreign import ccall unsafe "gsl-aux.h zipQ" c_vectorZipQ :: CInt -> TQVQVQV - ----------------------------------------------------------------------- data RandDist = Uniform -- ^ uniform distribution in [0,1) diff --git a/packages/hmatrix/src/Numeric/GSL/gsl-vector.c b/packages/hmatrix/src/Numeric/GSL/gsl-vector.c deleted file mode 100644 index f00424a..0000000 --- a/packages/hmatrix/src/Numeric/GSL/gsl-vector.c +++ /dev/null @@ -1,349 +0,0 @@ -#include - -#define RVEC(A) int A##n, double*A##p -#define RMAT(A) int A##r, int A##c, double* A##p -#define KRVEC(A) int A##n, const double*A##p -#define KRMAT(A) int A##r, int A##c, const double* A##p - -#define CVEC(A) int A##n, gsl_complex*A##p -#define CMAT(A) int A##r, int A##c, gsl_complex* A##p -#define KCVEC(A) int A##n, const gsl_complex*A##p -#define KCMAT(A) int A##r, int A##c, const gsl_complex* A##p - -#define FVEC(A) int A##n, float*A##p -#define FMAT(A) int A##r, int A##c, float* A##p -#define KFVEC(A) int A##n, const float*A##p -#define KFMAT(A) int A##r, int A##c, const float* A##p - -#define QVEC(A) int A##n, gsl_complex_float*A##p -#define QMAT(A) int A##r, int A##c, gsl_complex_float* A##p -#define KQVEC(A) int A##n, const gsl_complex_float*A##p -#define KQMAT(A) int A##r, int A##c, const gsl_complex_float* A##p - -#include -#include -#include -#include -#include -#include - -#define MACRO(B) do {B} while (0) -#define ERROR(CODE) MACRO(return CODE;) -#define REQUIRES(COND, CODE) MACRO(if(!(COND)) {ERROR(CODE);}) -#define OK return 0; - -#define MIN(A,B) ((A)<(B)?(A):(B)) -#define MAX(A,B) ((A)>(B)?(A):(B)) - -#ifdef DBG -#define DEBUGMSG(M) printf("*** calling aux C function: %s\n",M); -#else -#define DEBUGMSG(M) -#endif - -#define CHECK(RES,CODE) MACRO(if(RES) return CODE;) - -#ifdef DBG -#define DEBUGMAT(MSG,X) printf(MSG" = \n"); gsl_matrix_fprintf(stdout,X,"%f"); printf("\n"); -#else -#define DEBUGMAT(MSG,X) -#endif - -#ifdef DBG -#define DEBUGVEC(MSG,X) printf(MSG" = \n"); gsl_vector_fprintf(stdout,X,"%f"); printf("\n"); -#else -#define DEBUGVEC(MSG,X) -#endif - -#define DVVIEW(A) gsl_vector_view A = gsl_vector_view_array(A##p,A##n) -#define DMVIEW(A) gsl_matrix_view A = gsl_matrix_view_array(A##p,A##r,A##c) -#define CVVIEW(A) gsl_vector_complex_view A = gsl_vector_complex_view_array((double*)A##p,A##n) -#define CMVIEW(A) gsl_matrix_complex_view A = gsl_matrix_complex_view_array((double*)A##p,A##r,A##c) -#define KDVVIEW(A) gsl_vector_const_view A = gsl_vector_const_view_array(A##p,A##n) -#define KDMVIEW(A) gsl_matrix_const_view A = gsl_matrix_const_view_array(A##p,A##r,A##c) -#define KCVVIEW(A) gsl_vector_complex_const_view A = gsl_vector_complex_const_view_array((double*)A##p,A##n) -#define KCMVIEW(A) gsl_matrix_complex_const_view A = gsl_matrix_complex_const_view_array((double*)A##p,A##r,A##c) - -#define FVVIEW(A) gsl_vector_float_view A = gsl_vector_float_view_array(A##p,A##n) -#define FMVIEW(A) gsl_matrix_float_view A = gsl_matrix_float_view_array(A##p,A##r,A##c) -#define QVVIEW(A) gsl_vector_complex_float_view A = gsl_vector_float_complex_view_array((float*)A##p,A##n) -#define QMVIEW(A) gsl_matrix_complex_float_view A = gsl_matrix_float_complex_view_array((float*)A##p,A##r,A##c) -#define KFVVIEW(A) gsl_vector_float_const_view A = gsl_vector_float_const_view_array(A##p,A##n) -#define KFMVIEW(A) gsl_matrix_float_const_view A = gsl_matrix_float_const_view_array(A##p,A##r,A##c) -#define KQVVIEW(A) gsl_vector_complex_float_const_view A = gsl_vector_complex_float_const_view_array((float*)A##p,A##n) -#define KQMVIEW(A) gsl_matrix_complex_float_const_view A = gsl_matrix_complex_float_const_view_array((float*)A##p,A##r,A##c) - -#define V(a) (&a.vector) -#define M(a) (&a.matrix) - -#define GCVEC(A) int A##n, gsl_complex*A##p -#define KGCVEC(A) int A##n, const gsl_complex*A##p - -#define GQVEC(A) int A##n, gsl_complex_float*A##p -#define KGQVEC(A) int A##n, const gsl_complex_float*A##p - -#define BAD_SIZE 2000 -#define BAD_CODE 2001 -#define MEM 2002 -#define BAD_FILE 2003 - - - -inline double sign(double x) { - if(x>0) { - return +1.0; - } else if (x<0) { - return -1.0; - } else { - return 0.0; - } -} - -inline float float_sign(float x) { - if(x>0) { - return +1.0; - } else if (x<0) { - return -1.0; - } else { - return 0.0; - } -} - -inline gsl_complex complex_abs(gsl_complex z) { - gsl_complex r; - r.dat[0] = gsl_complex_abs(z); - r.dat[1] = 0; - return r; -} - -inline gsl_complex complex_signum(gsl_complex z) { - gsl_complex r; - double mag; - if (z.dat[0] == 0 && z.dat[1] == 0) { - r.dat[0] = 0; - r.dat[1] = 0; - } else { - mag = gsl_complex_abs(z); - r.dat[0] = z.dat[0]/mag; - r.dat[1] = z.dat[1]/mag; - } - return r; -} - -#define OP(C,F) case C: { for(k=0;k