summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--packages/base/src/C/vector-aux.c84
-rw-r--r--packages/hmatrix/src/Numeric/GSL/Vector.hs16
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
3typedef double complex TCD;
4typedef 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
423int mapC(int code, KCVEC(x), CVEC(r)) { 429int 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 }
497int mapQ(int code, KQVEC(x), QVEC(r)) { 500int 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
69vectorMapC :: FunCodeV -> Vector (Complex Double) -> Vector (Complex Double)
70vectorMapC oper = vectorMapAux c_vectorMapC (fromei oper)
71
72foreign import ccall unsafe "gsl-aux.h mapC" c_vectorMapC :: CInt -> TCVCV
73
74-- | map of real vectors with given function
75vectorMapQ :: FunCodeV -> Vector (Complex Float) -> Vector (Complex Float)
76vectorMapQ = vectorMapAux c_vectorMapQ
77
78foreign import ccall unsafe "gsl-aux.h mapQ" c_vectorMapQ :: CInt -> TQVQV
79
80-------------------------------------------------------------------
81
82-- | map of complex vectors with given function
83vectorMapValC :: FunCodeSV -> Complex Double -> Vector (Complex Double) -> Vector (Complex Double) 69vectorMapValC :: FunCodeSV -> Complex Double -> Vector (Complex Double) -> Vector (Complex Double)
84vectorMapValC = vectorMapValAux c_vectorMapValC 70vectorMapValC = vectorMapValAux c_vectorMapValC
85 71