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/hmatrix/src/Numeric/GSL/Vector.hs | 58 +---- packages/hmatrix/src/Numeric/GSL/gsl-vector.c | 349 -------------------------- 2 files changed, 1 insertion(+), 406 deletions(-) delete mode 100644 packages/hmatrix/src/Numeric/GSL/gsl-vector.c (limited to 'packages/hmatrix/src/Numeric') diff --git a/packages/hmatrix/src/Numeric/GSL/Vector.hs b/packages/hmatrix/src/Numeric/GSL/Vector.hs index 5c34f70..e133c2c 100644 --- a/packages/hmatrix/src/Numeric/GSL/Vector.hs +++ b/packages/hmatrix/src/Numeric/GSL/Vector.hs @@ -24,73 +24,17 @@ module Numeric.GSL.Vector ( import Data.Packed import Numeric.GSL.Internal hiding (TV,TM,TCV,TCM) -import Numeric.Vectorized( - sumF, sumR, sumQ, sumC, - prodF, prodR, prodQ, prodC, - FunCodeS(..), toScalarR, toScalarF, toScalarC, toScalarQ, - FunCodeV(..), vectorMapR, vectorMapF, vectorMapC, vectorMapQ, - FunCodeSV(..), vectorMapValR, vectorMapValF, - FunCodeVV(..), vectorZipR, vectorZipF - ) +import Numeric.Vectorized import Data.Complex import Foreign.Marshal.Alloc(free) -import Foreign.Marshal.Array(newArray) import Foreign.Ptr(Ptr) import Foreign.C.Types import Foreign.C.String(newCString) import System.IO.Unsafe(unsafePerformIO) -import Control.Monad(when) fromei x = fromIntegral (fromEnum x) :: CInt ------------------------------------------------------------------- - -vectorMapAux fun code v = unsafePerformIO $ do - r <- createVector (dim v) - app2 (fun (fromei code)) vec v vec r "vectorMapAux" - return r - -vectorMapValAux fun code val v = unsafePerformIO $ do - r <- createVector (dim v) - pval <- newArray [val] - app2 (fun (fromei code) pval) vec v vec r "vectorMapValAux" - free pval - return r - -vectorZipAux fun code u v = unsafePerformIO $ do - r <- createVector (dim u) - when (dim u > 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