diff options
-rw-r--r-- | packages/base/src/C/vector-aux.c | 84 | ||||
-rw-r--r-- | packages/hmatrix/src/Numeric/GSL/Vector.hs | 16 |
2 files changed, 43 insertions, 57 deletions
diff --git a/packages/base/src/C/vector-aux.c b/packages/base/src/C/vector-aux.c index 034fa6a..be2dc3a 100644 --- a/packages/base/src/C/vector-aux.c +++ b/packages/base/src/C/vector-aux.c | |||
@@ -1,3 +1,10 @@ | |||
1 | #include <complex.h> | ||
2 | |||
3 | typedef double complex TCD; | ||
4 | typedef float complex TCF; | ||
5 | |||
6 | #undef complex | ||
7 | |||
1 | #include "lapack-aux.h" | 8 | #include "lapack-aux.h" |
2 | 9 | ||
3 | #define V(x) x##n,x##p | 10 | #define V(x) x##n,x##p |
@@ -418,35 +425,31 @@ inline doublecomplex complex_signum_complex(doublecomplex z) { | |||
418 | return r; | 425 | return r; |
419 | } | 426 | } |
420 | 427 | ||
421 | 428 | #define OPb(C,F) case C: { for(k=0;k<xn;k++) r2p[k] = F(x2p[k]); OK } | |
422 | |||
423 | int mapC(int code, KCVEC(x), CVEC(r)) { | 429 | int mapC(int code, KCVEC(x), CVEC(r)) { |
430 | TCD* x2p = (TCD*)xp; | ||
431 | TCD* r2p = (TCD*)rp; | ||
424 | int k; | 432 | int k; |
425 | REQUIRES(xn == rn,BAD_SIZE); | 433 | REQUIRES(xn == rn,BAD_SIZE); |
426 | DEBUGMSG("mapC"); | 434 | DEBUGMSG("mapC"); |
427 | switch (code) { | 435 | switch (code) { |
428 | /* | 436 | OPb(0,csin) |
429 | OP(0,gsl_complex_sin) | 437 | OPb(1,ccos) |
430 | OP(1,gsl_complex_cos) | 438 | OPb(2,ctan) |
431 | OP(2,gsl_complex_tan) | ||
432 | */ | ||
433 | OP(3,complex_abs_complex) | 439 | OP(3,complex_abs_complex) |
434 | /* | 440 | OPb(4,casin) |
435 | OP(4,gsl_complex_arcsin) | 441 | OPb(5,cacos) |
436 | OP(5,gsl_complex_arccos) | 442 | OPb(6,catan) |
437 | OP(6,gsl_complex_arctan) | 443 | OPb(7,csinh) |
438 | OP(7,gsl_complex_sinh) | 444 | OPb(8,ccosh) |
439 | OP(8,gsl_complex_cosh) | 445 | OPb(9,ctanh) |
440 | OP(9,gsl_complex_tanh) | 446 | OPb(10,casinh) |
441 | OP(10,gsl_complex_arcsinh) | 447 | OPb(11,cacosh) |
442 | OP(11,gsl_complex_arccosh) | 448 | OPb(12,catanh) |
443 | OP(12,gsl_complex_arctanh) | 449 | OPb(13,cexp) |
444 | OP(13,gsl_complex_exp) | 450 | OPb(14,clog) |
445 | OP(14,gsl_complex_log) | ||
446 | */ | ||
447 | OP(15,complex_signum_complex) | 451 | OP(15,complex_signum_complex) |
448 | 452 | OPb(16,csqrt) | |
449 | // OP(16,gsl_complex_sqrt) | ||
450 | default: ERROR(BAD_CODE); | 453 | default: ERROR(BAD_CODE); |
451 | } | 454 | } |
452 | } | 455 | } |
@@ -495,32 +498,29 @@ inline complex complex_f_math_op(doublecomplex (*cf)(doublecomplex,doublecomplex | |||
495 | #define OPC(C,F) case C: { for(k=0;k<xn;k++) rp[k] = complex_f_math_fun(&F,xp[k]); OK } | 498 | #define OPC(C,F) case C: { for(k=0;k<xn;k++) rp[k] = complex_f_math_fun(&F,xp[k]); OK } |
496 | #define OPCA(C,F,A,B) case C: { for(k=0;k<xn;k++) rp[k] = complex_f_math_op(&F,A,B); OK } | 499 | #define OPCA(C,F,A,B) case C: { for(k=0;k<xn;k++) rp[k] = complex_f_math_op(&F,A,B); OK } |
497 | int mapQ(int code, KQVEC(x), QVEC(r)) { | 500 | int mapQ(int code, KQVEC(x), QVEC(r)) { |
501 | TCF* x2p = (TCF*)xp; | ||
502 | TCF* r2p = (TCF*)rp; | ||
498 | int k; | 503 | int k; |
499 | REQUIRES(xn == rn,BAD_SIZE); | 504 | REQUIRES(xn == rn,BAD_SIZE); |
500 | DEBUGMSG("mapQ"); | 505 | DEBUGMSG("mapQ"); |
501 | switch (code) { | 506 | switch (code) { |
502 | /* | 507 | OPb(0,csinf) |
503 | OPC(0,gsl_complex_sin) | 508 | OPb(1,ccosf) |
504 | OPC(1,gsl_complex_cos) | 509 | OPb(2,ctanf) |
505 | OPC(2,gsl_complex_tan) | ||
506 | */ | ||
507 | OPC(3,complex_abs_complex) | 510 | OPC(3,complex_abs_complex) |
508 | /* | 511 | OPb(4,casinf) |
509 | OPC(4,gsl_complex_arcsin) | 512 | OPb(5,cacosf) |
510 | OPC(5,gsl_complex_arccos) | 513 | OPb(6,catanf) |
511 | OPC(6,gsl_complex_arctan) | 514 | OPb(7,csinhf) |
512 | OPC(7,gsl_complex_sinh) | 515 | OPb(8,ccoshf) |
513 | OPC(8,gsl_complex_cosh) | 516 | OPb(9,ctanhf) |
514 | OPC(9,gsl_complex_tanh) | 517 | OPb(10,casinhf) |
515 | OPC(10,gsl_complex_arcsinh) | 518 | OPb(11,cacoshf) |
516 | OPC(11,gsl_complex_arccosh) | 519 | OPb(12,catanhf) |
517 | OPC(12,gsl_complex_arctanh) | 520 | OPb(13,cexpf) |
518 | OPC(13,gsl_complex_exp) | 521 | OPb(14,clogf) |
519 | OPC(14,gsl_complex_log) | ||
520 | */ | ||
521 | OPC(15,complex_signum_complex) | 522 | OPC(15,complex_signum_complex) |
522 | 523 | OPb(16,csqrtf) | |
523 | // OPC(16,gsl_complex_sqrt) | ||
524 | default: ERROR(BAD_CODE); | 524 | default: ERROR(BAD_CODE); |
525 | } | 525 | } |
526 | } | 526 | } |
diff --git a/packages/hmatrix/src/Numeric/GSL/Vector.hs b/packages/hmatrix/src/Numeric/GSL/Vector.hs index 7b5a617..5c34f70 100644 --- a/packages/hmatrix/src/Numeric/GSL/Vector.hs +++ b/packages/hmatrix/src/Numeric/GSL/Vector.hs | |||
@@ -28,7 +28,7 @@ import Numeric.Vectorized( | |||
28 | sumF, sumR, sumQ, sumC, | 28 | sumF, sumR, sumQ, sumC, |
29 | prodF, prodR, prodQ, prodC, | 29 | prodF, prodR, prodQ, prodC, |
30 | FunCodeS(..), toScalarR, toScalarF, toScalarC, toScalarQ, | 30 | FunCodeS(..), toScalarR, toScalarF, toScalarC, toScalarQ, |
31 | FunCodeV(..), vectorMapR, vectorMapF, | 31 | FunCodeV(..), vectorMapR, vectorMapF, vectorMapC, vectorMapQ, |
32 | FunCodeSV(..), vectorMapValR, vectorMapValF, | 32 | FunCodeSV(..), vectorMapValR, vectorMapValF, |
33 | FunCodeVV(..), vectorZipR, vectorZipF | 33 | FunCodeVV(..), vectorZipR, vectorZipF |
34 | ) | 34 | ) |
@@ -66,20 +66,6 @@ vectorZipAux fun code u v = unsafePerformIO $ do | |||
66 | --------------------------------------------------------------------- | 66 | --------------------------------------------------------------------- |
67 | 67 | ||
68 | -- | map of complex vectors with given function | 68 | -- | map of complex vectors with given function |
69 | vectorMapC :: FunCodeV -> Vector (Complex Double) -> Vector (Complex Double) | ||
70 | vectorMapC oper = vectorMapAux c_vectorMapC (fromei oper) | ||
71 | |||
72 | foreign import ccall unsafe "gsl-aux.h mapC" c_vectorMapC :: CInt -> TCVCV | ||
73 | |||
74 | -- | map of real vectors with given function | ||
75 | vectorMapQ :: FunCodeV -> Vector (Complex Float) -> Vector (Complex Float) | ||
76 | vectorMapQ = vectorMapAux c_vectorMapQ | ||
77 | |||
78 | foreign import ccall unsafe "gsl-aux.h mapQ" c_vectorMapQ :: CInt -> TQVQV | ||
79 | |||
80 | ------------------------------------------------------------------- | ||
81 | |||
82 | -- | map of complex vectors with given function | ||
83 | vectorMapValC :: FunCodeSV -> Complex Double -> Vector (Complex Double) -> Vector (Complex Double) | 69 | vectorMapValC :: FunCodeSV -> Complex Double -> Vector (Complex Double) -> Vector (Complex Double) |
84 | vectorMapValC = vectorMapValAux c_vectorMapValC | 70 | vectorMapValC = vectorMapValAux c_vectorMapValC |
85 | 71 | ||