diff options
author | Alberto Ruiz <aruiz@um.es> | 2007-11-22 17:03:41 +0000 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2007-11-22 17:03:41 +0000 |
commit | 01a14ad32e0fd8586498ead61a426f20b724652b (patch) | |
tree | b894c4d09700c2cf1f6abf2c89e6df81eebddb71 /lib/Numeric/GSL | |
parent | 2f45fdd97f80c0ffd0e10cce68d1cd24a43696c0 (diff) |
app1, app2, ...
Diffstat (limited to 'lib/Numeric/GSL')
-rw-r--r-- | lib/Numeric/GSL/Fourier.hs | 3 | ||||
-rw-r--r-- | lib/Numeric/GSL/Matrix.hs | 36 | ||||
-rw-r--r-- | lib/Numeric/GSL/Minimization.hs | 14 | ||||
-rw-r--r-- | lib/Numeric/GSL/Polynomials.hs | 3 | ||||
-rw-r--r-- | lib/Numeric/GSL/Vector.hs | 12 |
5 files changed, 20 insertions, 48 deletions
diff --git a/lib/Numeric/GSL/Fourier.hs b/lib/Numeric/GSL/Fourier.hs index 4b08625..149c1e1 100644 --- a/lib/Numeric/GSL/Fourier.hs +++ b/lib/Numeric/GSL/Fourier.hs | |||
@@ -26,8 +26,7 @@ import Foreign | |||
26 | 26 | ||
27 | genfft code v = unsafePerformIO $ do | 27 | genfft code v = unsafePerformIO $ do |
28 | r <- createVector (dim v) | 28 | r <- createVector (dim v) |
29 | ww2 withVector v withVector r $ \ v r -> | 29 | app2 (c_fft code) vec v vec r "fft" |
30 | c_fft code // v // r // check "fft" | ||
31 | return r | 30 | return r |
32 | 31 | ||
33 | foreign import ccall "gsl-aux.h fft" c_fft :: Int -> TCVCV | 32 | foreign import ccall "gsl-aux.h fft" c_fft :: Int -> TCVCV |
diff --git a/lib/Numeric/GSL/Matrix.hs b/lib/Numeric/GSL/Matrix.hs index 09a0be4..07d4660 100644 --- a/lib/Numeric/GSL/Matrix.hs +++ b/lib/Numeric/GSL/Matrix.hs | |||
@@ -51,8 +51,7 @@ eigSg' m | |||
51 | | otherwise = unsafePerformIO $ do | 51 | | otherwise = unsafePerformIO $ do |
52 | l <- createVector r | 52 | l <- createVector r |
53 | v <- createMatrix RowMajor r r | 53 | v <- createMatrix RowMajor r r |
54 | ww3 withMatrix m withVector l withMatrix v $ \m l v -> | 54 | app3 c_eigS mat m vec l mat v "eigSg" |
55 | c_eigS // m // l // v // check "eigSg" | ||
56 | return (l,v) | 55 | return (l,v) |
57 | where r = rows m | 56 | where r = rows m |
58 | foreign import ccall "gsl-aux.h eigensystemR" c_eigS :: TMVM | 57 | foreign import ccall "gsl-aux.h eigensystemR" c_eigS :: TMVM |
@@ -85,8 +84,7 @@ eigHg' m | |||
85 | | otherwise = unsafePerformIO $ do | 84 | | otherwise = unsafePerformIO $ do |
86 | l <- createVector r | 85 | l <- createVector r |
87 | v <- createMatrix RowMajor r r | 86 | v <- createMatrix RowMajor r r |
88 | ww3 withMatrix m withVector l withMatrix v $ \m l v -> | 87 | app3 c_eigH mat m vec l mat v "eigHg" |
89 | c_eigH // m // l // v // check "eigHg" | ||
90 | return (l,v) | 88 | return (l,v) |
91 | where r = rows m | 89 | where r = rows m |
92 | foreign import ccall "gsl-aux.h eigensystemC" c_eigH :: TCMVCM | 90 | foreign import ccall "gsl-aux.h eigensystemC" c_eigH :: TCMVCM |
@@ -122,8 +120,7 @@ svd' x = unsafePerformIO $ do | |||
122 | u <- createMatrix RowMajor r c | 120 | u <- createMatrix RowMajor r c |
123 | s <- createVector c | 121 | s <- createVector c |
124 | v <- createMatrix RowMajor c c | 122 | v <- createMatrix RowMajor c c |
125 | ww4 withMatrix x withMatrix u withVector s withMatrix v $ \x u s v -> | 123 | app4 c_svd mat x mat u vec s mat v "svdg" |
126 | c_svd // x // u // s // v // check "svdg" | ||
127 | return (u,s,v) | 124 | return (u,s,v) |
128 | where r = rows x | 125 | where r = rows x |
129 | c = cols x | 126 | c = cols x |
@@ -152,8 +149,7 @@ qr = qr' . cmat | |||
152 | qr' x = unsafePerformIO $ do | 149 | qr' x = unsafePerformIO $ do |
153 | q <- createMatrix RowMajor r r | 150 | q <- createMatrix RowMajor r r |
154 | rot <- createMatrix RowMajor r c | 151 | rot <- createMatrix RowMajor r c |
155 | ww3 withMatrix x withMatrix q withMatrix rot $ \x q rot -> | 152 | app3 c_qr mat x mat q mat rot "qr" |
156 | c_qr // x // q // rot // check "qr" | ||
157 | return (q,rot) | 153 | return (q,rot) |
158 | where r = rows x | 154 | where r = rows x |
159 | c = cols x | 155 | c = cols x |
@@ -165,8 +161,7 @@ qrPacked = qrPacked' . cmat | |||
165 | qrPacked' x = unsafePerformIO $ do | 161 | qrPacked' x = unsafePerformIO $ do |
166 | qr <- createMatrix RowMajor r c | 162 | qr <- createMatrix RowMajor r c |
167 | tau <- createVector (min r c) | 163 | tau <- createVector (min r c) |
168 | ww3 withMatrix x withMatrix qr withVector tau $ \x qr tau -> | 164 | app3 c_qrPacked mat x mat qr vec tau "qrUnpacked" |
169 | c_qrPacked // x // qr // tau // check "qrUnpacked" | ||
170 | return (qr,tau) | 165 | return (qr,tau) |
171 | where r = rows x | 166 | where r = rows x |
172 | c = cols x | 167 | c = cols x |
@@ -178,8 +173,7 @@ unpackQR (qr,tau) = unpackQR' (cmat qr, tau) | |||
178 | unpackQR' (qr,tau) = unsafePerformIO $ do | 173 | unpackQR' (qr,tau) = unsafePerformIO $ do |
179 | q <- createMatrix RowMajor r r | 174 | q <- createMatrix RowMajor r r |
180 | res <- createMatrix RowMajor r c | 175 | res <- createMatrix RowMajor r c |
181 | ww4 withMatrix qr withVector tau withMatrix q withMatrix res $ \qr tau q res -> | 176 | app4 c_qrUnpack mat qr vec tau mat q mat res "qrUnpack" |
182 | c_qrUnpack // qr // tau // q // res // check "qrUnpack" | ||
183 | return (q,res) | 177 | return (q,res) |
184 | where r = rows qr | 178 | where r = rows qr |
185 | c = cols qr | 179 | c = cols qr |
@@ -203,8 +197,7 @@ cholR = cholR' . cmat | |||
203 | 197 | ||
204 | cholR' x = unsafePerformIO $ do | 198 | cholR' x = unsafePerformIO $ do |
205 | r <- createMatrix RowMajor n n | 199 | r <- createMatrix RowMajor n n |
206 | ww2 withMatrix x withMatrix r $ \x r -> | 200 | app2 c_cholR mat x mat r "cholR" |
207 | c_cholR // x // r // check "cholR" | ||
208 | return r | 201 | return r |
209 | where n = rows x | 202 | where n = rows x |
210 | foreign import ccall "gsl-aux.h cholR" c_cholR :: TMM | 203 | foreign import ccall "gsl-aux.h cholR" c_cholR :: TMM |
@@ -214,8 +207,7 @@ cholC = cholC' . cmat | |||
214 | 207 | ||
215 | cholC' x = unsafePerformIO $ do | 208 | cholC' x = unsafePerformIO $ do |
216 | r <- createMatrix RowMajor n n | 209 | r <- createMatrix RowMajor n n |
217 | ww2 withMatrix x withMatrix r $ \x r -> | 210 | app2 c_cholC mat x mat r "cholC" |
218 | c_cholC // x // r // check "cholC" | ||
219 | return r | 211 | return r |
220 | where n = rows x | 212 | where n = rows x |
221 | foreign import ccall "gsl-aux.h cholC" c_cholC :: TCMCM | 213 | foreign import ccall "gsl-aux.h cholC" c_cholC :: TCMCM |
@@ -231,8 +223,7 @@ luSolveR a b = luSolveR' (cmat a) (cmat b) | |||
231 | luSolveR' a b | 223 | luSolveR' a b |
232 | | n1==n2 && n1==r = unsafePerformIO $ do | 224 | | n1==n2 && n1==r = unsafePerformIO $ do |
233 | s <- createMatrix RowMajor r c | 225 | s <- createMatrix RowMajor r c |
234 | ww3 withMatrix a withMatrix b withMatrix s $ \ a b s -> | 226 | app3 c_luSolveR mat a mat b mat s "luSolveR" |
235 | c_luSolveR // a // b // s // check "luSolveR" | ||
236 | return s | 227 | return s |
237 | | otherwise = error "luSolveR of nonsquare matrix" | 228 | | otherwise = error "luSolveR of nonsquare matrix" |
238 | where n1 = rows a | 229 | where n1 = rows a |
@@ -249,8 +240,7 @@ luSolveC a b = luSolveC' (cmat a) (cmat b) | |||
249 | luSolveC' a b | 240 | luSolveC' a b |
250 | | n1==n2 && n1==r = unsafePerformIO $ do | 241 | | n1==n2 && n1==r = unsafePerformIO $ do |
251 | s <- createMatrix RowMajor r c | 242 | s <- createMatrix RowMajor r c |
252 | ww3 withMatrix a withMatrix b withMatrix s $ \ a b s -> | 243 | app3 c_luSolveC mat a mat b mat s "luSolveC" |
253 | c_luSolveC // a // b // s // check "luSolveC" | ||
254 | return s | 244 | return s |
255 | | otherwise = error "luSolveC of nonsquare matrix" | 245 | | otherwise = error "luSolveC of nonsquare matrix" |
256 | where n1 = rows a | 246 | where n1 = rows a |
@@ -266,8 +256,7 @@ luRaux = luRaux' . cmat | |||
266 | 256 | ||
267 | luRaux' x = unsafePerformIO $ do | 257 | luRaux' x = unsafePerformIO $ do |
268 | res <- createVector (r*r+r+1) | 258 | res <- createVector (r*r+r+1) |
269 | ww2 withMatrix x withVector res $ \x res -> | 259 | app2 c_luRaux mat x vec res "luRaux" |
270 | c_luRaux // x // res // check "luRaux" | ||
271 | return res | 260 | return res |
272 | where r = rows x | 261 | where r = rows x |
273 | c = cols x | 262 | c = cols x |
@@ -280,8 +269,7 @@ luCaux = luCaux' . cmat | |||
280 | 269 | ||
281 | luCaux' x = unsafePerformIO $ do | 270 | luCaux' x = unsafePerformIO $ do |
282 | res <- createVector (r*r+r+1) | 271 | res <- createVector (r*r+r+1) |
283 | ww2 withMatrix x withVector res $ \x res -> | 272 | app2 c_luCaux mat x vec res "luCaux" |
284 | c_luCaux // x // res // check "luCaux" | ||
285 | return res | 273 | return res |
286 | where r = rows x | 274 | where r = rows x |
287 | c = cols x | 275 | c = cols x |
diff --git a/lib/Numeric/GSL/Minimization.hs b/lib/Numeric/GSL/Minimization.hs index e44b2e5..235a88f 100644 --- a/lib/Numeric/GSL/Minimization.hs +++ b/lib/Numeric/GSL/Minimization.hs | |||
@@ -196,22 +196,12 @@ aux_vTov f n p r = g where | |||
196 | 196 | ||
197 | -------------------------------------------------------------------- | 197 | -------------------------------------------------------------------- |
198 | 198 | ||
199 | |||
200 | createV n fun msg = unsafePerformIO $ do | 199 | createV n fun msg = unsafePerformIO $ do |
201 | r <- createVector n | 200 | r <- createVector n |
202 | withVector r $ \ r -> | 201 | app1 fun vec r msg |
203 | fun // r // check msg | ||
204 | return r | 202 | return r |
205 | 203 | ||
206 | {- | ||
207 | createM r c fun msg ptrs = unsafePerformIO $ do | ||
208 | r <- createMatrix RowMajor r c | ||
209 | fun // matc r // check msg ptrs | ||
210 | return r | ||
211 | -} | ||
212 | |||
213 | createMIO r c fun msg = do | 204 | createMIO r c fun msg = do |
214 | r <- createMatrix RowMajor r c | 205 | r <- createMatrix RowMajor r c |
215 | withMatrix r $ \ r -> | 206 | app1 fun mat r msg |
216 | fun // r // check msg | ||
217 | return r | 207 | return r |
diff --git a/lib/Numeric/GSL/Polynomials.hs b/lib/Numeric/GSL/Polynomials.hs index e663711..3e0cf81 100644 --- a/lib/Numeric/GSL/Polynomials.hs +++ b/lib/Numeric/GSL/Polynomials.hs | |||
@@ -47,8 +47,7 @@ polySolve = toList . polySolve' . fromList | |||
47 | polySolve' :: Vector Double -> Vector (Complex Double) | 47 | polySolve' :: Vector Double -> Vector (Complex Double) |
48 | polySolve' v | dim v > 1 = unsafePerformIO $ do | 48 | polySolve' v | dim v > 1 = unsafePerformIO $ do |
49 | r <- createVector (dim v-1) | 49 | r <- createVector (dim v-1) |
50 | ww2 withVector v withVector r $ \ v r -> | 50 | app2 c_polySolve vec v vec r "polySolve" |
51 | c_polySolve // v // r // check "polySolve" | ||
52 | return r | 51 | return r |
53 | | otherwise = error "polySolve on a polynomial of degree zero" | 52 | | otherwise = error "polySolve on a polynomial of degree zero" |
54 | 53 | ||
diff --git a/lib/Numeric/GSL/Vector.hs b/lib/Numeric/GSL/Vector.hs index 65f3a2e..86d8f10 100644 --- a/lib/Numeric/GSL/Vector.hs +++ b/lib/Numeric/GSL/Vector.hs | |||
@@ -73,28 +73,24 @@ data FunCodeS = Norm2 | |||
73 | 73 | ||
74 | toScalarAux fun code v = unsafePerformIO $ do | 74 | toScalarAux fun code v = unsafePerformIO $ do |
75 | r <- createVector 1 | 75 | r <- createVector 1 |
76 | ww2 withVector v withVector r $ \v r -> | 76 | app2 (fun (fromEnum code)) vec v vec r "toScalarAux" |
77 | fun (fromEnum code) // v // r // check "toScalarAux" | ||
78 | return (r `at` 0) | 77 | return (r `at` 0) |
79 | 78 | ||
80 | vectorMapAux fun code v = unsafePerformIO $ do | 79 | vectorMapAux fun code v = unsafePerformIO $ do |
81 | r <- createVector (dim v) | 80 | r <- createVector (dim v) |
82 | ww2 withVector v withVector r $ \v r -> | 81 | app2 (fun (fromEnum code)) vec v vec r "vectorMapAux" |
83 | fun (fromEnum code) // v // r // check "vectorMapAux" | ||
84 | return r | 82 | return r |
85 | 83 | ||
86 | vectorMapValAux fun code val v = unsafePerformIO $ do | 84 | vectorMapValAux fun code val v = unsafePerformIO $ do |
87 | r <- createVector (dim v) | 85 | r <- createVector (dim v) |
88 | pval <- newArray [val] | 86 | pval <- newArray [val] |
89 | ww2 withVector v withVector r $ \v r -> | 87 | app2 (fun (fromEnum code) pval) vec v vec r "vectorMapValAux" |
90 | fun (fromEnum code) pval // v // r // check "vectorMapValAux" | ||
91 | free pval | 88 | free pval |
92 | return r | 89 | return r |
93 | 90 | ||
94 | vectorZipAux fun code u v = unsafePerformIO $ do | 91 | vectorZipAux fun code u v = unsafePerformIO $ do |
95 | r <- createVector (dim u) | 92 | r <- createVector (dim u) |
96 | ww3 withVector u withVector v withVector r $ \u v r -> | 93 | app3 (fun (fromEnum code)) vec u vec v vec r "vectorZipAux" |
97 | fun (fromEnum code) // u // v // r // check "vectorZipAux" | ||
98 | return r | 94 | return r |
99 | 95 | ||
100 | --------------------------------------------------------------------- | 96 | --------------------------------------------------------------------- |