summaryrefslogtreecommitdiff
path: root/lib/Numeric/GSL
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Numeric/GSL')
-rw-r--r--lib/Numeric/GSL/Vector.hs70
-rw-r--r--lib/Numeric/GSL/gsl-aux.c102
2 files changed, 168 insertions, 4 deletions
diff --git a/lib/Numeric/GSL/Vector.hs b/lib/Numeric/GSL/Vector.hs
index d09323b..97a0f9c 100644
--- a/lib/Numeric/GSL/Vector.hs
+++ b/lib/Numeric/GSL/Vector.hs
@@ -14,6 +14,8 @@
14----------------------------------------------------------------------------- 14-----------------------------------------------------------------------------
15 15
16module Numeric.GSL.Vector ( 16module Numeric.GSL.Vector (
17 sumF, sumR, sumQ, sumC,
18 dotF, dotR, dotQ, dotC,
17 FunCodeS(..), toScalarR, toScalarF, 19 FunCodeS(..), toScalarR, toScalarF,
18 FunCodeV(..), vectorMapR, vectorMapC, vectorMapF, 20 FunCodeV(..), vectorMapR, vectorMapC, vectorMapF,
19 FunCodeSV(..), vectorMapValR, vectorMapValC, vectorMapValF, 21 FunCodeSV(..), vectorMapValR, vectorMapValC, vectorMapValF,
@@ -76,6 +78,74 @@ data FunCodeS = Norm2
76 78
77------------------------------------------------------------------ 79------------------------------------------------------------------
78 80
81-- | sum of elements
82sumF :: Vector Float -> Float
83sumF x = unsafePerformIO $ do
84 r <- createVector 1
85 app2 c_sumF vec x vec r "sumF"
86 return $ r @> 0
87
88-- | sum of elements
89sumR :: Vector Double -> Double
90sumR x = unsafePerformIO $ do
91 r <- createVector 1
92 app2 c_sumR vec x vec r "sumR"
93 return $ r @> 0
94
95-- | sum of elements
96sumQ :: Vector (Complex Float) -> Complex Float
97sumQ x = unsafePerformIO $ do
98 r <- createVector 1
99 app2 c_sumQ vec x vec r "sumQ"
100 return $ r @> 0
101
102-- | sum of elements
103sumC :: Vector (Complex Double) -> Complex Double
104sumC x = unsafePerformIO $ do
105 r <- createVector 1
106 app2 c_sumC vec x vec r "sumC"
107 return $ r @> 0
108
109foreign import ccall safe "gsl-aux.h sumF" c_sumF :: TFF
110foreign import ccall safe "gsl-aux.h sumR" c_sumR :: TVV
111foreign import ccall safe "gsl-aux.h sumQ" c_sumQ :: TQVQV
112foreign import ccall safe "gsl-aux.h sumC" c_sumC :: TCVCV
113
114-- | dot product
115dotF :: Vector Float -> Vector Float -> Float
116dotF x y = unsafePerformIO $ do
117 r <- createVector 1
118 app3 c_dotF vec x vec y vec r "dotF"
119 return $ r @> 0
120
121-- | dot product
122dotR :: Vector Double -> Vector Double -> Double
123dotR x y = unsafePerformIO $ do
124 r <- createVector 1
125 app3 c_dotR vec x vec y vec r "dotR"
126 return $ r @> 0
127
128-- | dot product
129dotQ :: Vector (Complex Float) -> Vector (Complex Float) -> Complex Float
130dotQ x y = unsafePerformIO $ do
131 r <- createVector 1
132 app3 c_dotQ vec x vec y vec r "dotQ"
133 return $ r @> 0
134
135-- | dot product
136dotC :: Vector (Complex Double) -> Vector (Complex Double) -> Complex Double
137dotC x y = unsafePerformIO $ do
138 r <- createVector 1
139 app3 c_dotC vec x vec y vec r "dotC"
140 return $ r @> 0
141
142foreign import ccall safe "gsl-aux.h dotF" c_dotF :: TFFF
143foreign import ccall safe "gsl-aux.h dotR" c_dotR :: TVVV
144foreign import ccall safe "gsl-aux.h dotQ" c_dotQ :: TQVQVQV
145foreign import ccall safe "gsl-aux.h dotC" c_dotC :: TCVCVCV
146
147------------------------------------------------------------------
148
79toScalarAux fun code v = unsafePerformIO $ do 149toScalarAux fun code v = unsafePerformIO $ do
80 r <- createVector 1 150 r <- createVector 1
81 app2 (fun (fromei code)) vec v vec r "toScalarAux" 151 app2 (fun (fromei code)) vec v vec r "toScalarAux"
diff --git a/lib/Numeric/GSL/gsl-aux.c b/lib/Numeric/GSL/gsl-aux.c
index 6bb16f0..fe33766 100644
--- a/lib/Numeric/GSL/gsl-aux.c
+++ b/lib/Numeric/GSL/gsl-aux.c
@@ -76,12 +76,12 @@
76 76
77#define FVVIEW(A) gsl_vector_float_view A = gsl_vector_float_view_array(A##p,A##n) 77#define FVVIEW(A) gsl_vector_float_view A = gsl_vector_float_view_array(A##p,A##n)
78#define FMVIEW(A) gsl_matrix_float_view A = gsl_matrix_float_view_array(A##p,A##r,A##c) 78#define FMVIEW(A) gsl_matrix_float_view A = gsl_matrix_float_view_array(A##p,A##r,A##c)
79#define QVVIEW(A) gsl_vector_float_complex_view A = gsl_vector_float_complex_view_array((float*)A##p,A##n) 79#define QVVIEW(A) gsl_vector_complex_float_view A = gsl_vector_float_complex_view_array((float*)A##p,A##n)
80#define QMVIEW(A) gsl_matrix_float_complex_view A = gsl_matrix_float_complex_view_array((float*)A##p,A##r,A##c) 80#define QMVIEW(A) gsl_matrix_complex_float_view A = gsl_matrix_float_complex_view_array((float*)A##p,A##r,A##c)
81#define KFVVIEW(A) gsl_vector_float_const_view A = gsl_vector_float_const_view_array(A##p,A##n) 81#define KFVVIEW(A) gsl_vector_float_const_view A = gsl_vector_float_const_view_array(A##p,A##n)
82#define KFMVIEW(A) gsl_matrix_float_const_view A = gsl_matrix_float_const_view_array(A##p,A##r,A##c) 82#define KFMVIEW(A) gsl_matrix_float_const_view A = gsl_matrix_float_const_view_array(A##p,A##r,A##c)
83#define KQVVIEW(A) gsl_vector_float_complex_const_view A = gsl_vector_float_complex_const_view_array((float*)A##p,A##n) 83#define KQVVIEW(A) gsl_vector_complex_float_const_view A = gsl_vector_complex_float_const_view_array((float*)A##p,A##n)
84#define KQMVIEW(A) gsl_matrix_float_complex_const_view A = gsl_matrix_float_complex_const_view_array((float*)A##p,A##r,A##c) 84#define KQMVIEW(A) gsl_matrix_complex_float_const_view A = gsl_matrix_complex_float_const_view_array((float*)A##p,A##r,A##c)
85 85
86#define V(a) (&a.vector) 86#define V(a) (&a.vector)
87#define M(a) (&a.matrix) 87#define M(a) (&a.matrix)
@@ -103,6 +103,100 @@ void no_abort_on_error() {
103} 103}
104 104
105 105
106int sumF(KFVEC(x),FVEC(r)) {
107 DEBUGMSG("sumF");
108 REQUIRES(rn==1,BAD_SIZE);
109 int i;
110 float res = 0;
111 for (i = 0; i < xn; i++) res += xp[i];
112 rp[0] = res;
113 OK
114}
115
116int sumR(KRVEC(x),RVEC(r)) {
117 DEBUGMSG("sumR");
118 REQUIRES(rn==1,BAD_SIZE);
119 int i;
120 double res = 0;
121 for (i = 0; i < xn; i++) res += xp[i];
122 rp[0] = res;
123 OK
124}
125
126int sumQ(KQVEC(x),QVEC(r)) {
127 DEBUGMSG("sumQ");
128 REQUIRES(rn==1,BAD_SIZE);
129 int i;
130 gsl_complex_float res;
131 res.dat[0] = 0;
132 res.dat[1] = 0;
133 for (i = 0; i < xn; i++) {
134 res.dat[0] += xp[i].dat[0];
135 res.dat[1] += xp[i].dat[1];
136 }
137 rp[0] = res;
138 OK
139}
140
141int sumC(KCVEC(x),CVEC(r)) {
142 DEBUGMSG("sumC");
143 REQUIRES(rn==1,BAD_SIZE);
144 int i;
145 gsl_complex res;
146 res.dat[0] = 0;
147 res.dat[1] = 0;
148 for (i = 0; i < xn; i++) {
149 res.dat[0] += xp[i].dat[0];
150 res.dat[1] += xp[i].dat[1];
151 }
152 rp[0] = res;
153 OK
154}
155
156int dotF(KFVEC(x), KFVEC(y), FVEC(r)) {
157 DEBUGMSG("dotF");
158 REQUIRES(xn==yn,BAD_SIZE);
159 REQUIRES(rn==1,BAD_SIZE);
160 DEBUGMSG("dotF");
161 KFVVIEW(x);
162 KFVVIEW(y);
163 gsl_blas_sdot(V(x),V(y),rp);
164 OK
165}
166
167int dotR(KRVEC(x), KRVEC(y), RVEC(r)) {
168 DEBUGMSG("dotR");
169 REQUIRES(xn==yn,BAD_SIZE);
170 REQUIRES(rn==1,BAD_SIZE);
171 DEBUGMSG("dotR");
172 KDVVIEW(x);
173 KDVVIEW(y);
174 gsl_blas_ddot(V(x),V(y),rp);
175 OK
176}
177
178int dotQ(KQVEC(x), KQVEC(y), QVEC(r)) {
179 DEBUGMSG("dotQ");
180 REQUIRES(xn==yn,BAD_SIZE);
181 REQUIRES(rn==1,BAD_SIZE);
182 DEBUGMSG("dotQ");
183 KQVVIEW(x);
184 KQVVIEW(y);
185 gsl_blas_cdotu(V(x),V(y),rp);
186 OK
187}
188
189int dotC(KCVEC(x), KCVEC(y), CVEC(r)) {
190 DEBUGMSG("dotC");
191 REQUIRES(xn==yn,BAD_SIZE);
192 REQUIRES(rn==1,BAD_SIZE);
193 DEBUGMSG("dotC");
194 KCVVIEW(x);
195 KCVVIEW(y);
196 gsl_blas_zdotu(V(x),V(y),rp);
197 OK
198}
199
106int toScalarR(int code, KRVEC(x), RVEC(r)) { 200int toScalarR(int code, KRVEC(x), RVEC(r)) {
107 REQUIRES(rn==1,BAD_SIZE); 201 REQUIRES(rn==1,BAD_SIZE);
108 DEBUGMSG("toScalarR"); 202 DEBUGMSG("toScalarR");