diff options
Diffstat (limited to 'lib/Numeric/GSL')
-rw-r--r-- | lib/Numeric/GSL/Vector.hs | 70 | ||||
-rw-r--r-- | lib/Numeric/GSL/gsl-aux.c | 102 |
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 | ||
16 | module Numeric.GSL.Vector ( | 16 | module 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 | ||
82 | sumF :: Vector Float -> Float | ||
83 | sumF 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 | ||
89 | sumR :: Vector Double -> Double | ||
90 | sumR 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 | ||
96 | sumQ :: Vector (Complex Float) -> Complex Float | ||
97 | sumQ 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 | ||
103 | sumC :: Vector (Complex Double) -> Complex Double | ||
104 | sumC x = unsafePerformIO $ do | ||
105 | r <- createVector 1 | ||
106 | app2 c_sumC vec x vec r "sumC" | ||
107 | return $ r @> 0 | ||
108 | |||
109 | foreign import ccall safe "gsl-aux.h sumF" c_sumF :: TFF | ||
110 | foreign import ccall safe "gsl-aux.h sumR" c_sumR :: TVV | ||
111 | foreign import ccall safe "gsl-aux.h sumQ" c_sumQ :: TQVQV | ||
112 | foreign import ccall safe "gsl-aux.h sumC" c_sumC :: TCVCV | ||
113 | |||
114 | -- | dot product | ||
115 | dotF :: Vector Float -> Vector Float -> Float | ||
116 | dotF 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 | ||
122 | dotR :: Vector Double -> Vector Double -> Double | ||
123 | dotR 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 | ||
129 | dotQ :: Vector (Complex Float) -> Vector (Complex Float) -> Complex Float | ||
130 | dotQ 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 | ||
136 | dotC :: Vector (Complex Double) -> Vector (Complex Double) -> Complex Double | ||
137 | dotC x y = unsafePerformIO $ do | ||
138 | r <- createVector 1 | ||
139 | app3 c_dotC vec x vec y vec r "dotC" | ||
140 | return $ r @> 0 | ||
141 | |||
142 | foreign import ccall safe "gsl-aux.h dotF" c_dotF :: TFFF | ||
143 | foreign import ccall safe "gsl-aux.h dotR" c_dotR :: TVVV | ||
144 | foreign import ccall safe "gsl-aux.h dotQ" c_dotQ :: TQVQVQV | ||
145 | foreign import ccall safe "gsl-aux.h dotC" c_dotC :: TCVCVCV | ||
146 | |||
147 | ------------------------------------------------------------------ | ||
148 | |||
79 | toScalarAux fun code v = unsafePerformIO $ do | 149 | toScalarAux 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 | ||
106 | int 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 | |||
116 | int 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 | |||
126 | int 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 | |||
141 | int 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 | |||
156 | int 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 | |||
167 | int 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 | |||
178 | int 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 | |||
189 | int 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 | |||
106 | int toScalarR(int code, KRVEC(x), RVEC(r)) { | 200 | int 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"); |