diff options
Diffstat (limited to 'lib/Numeric')
-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 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/LAPACK.hs | 33 |
6 files changed, 31 insertions, 70 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 | --------------------------------------------------------------------- |
diff --git a/lib/Numeric/LinearAlgebra/LAPACK.hs b/lib/Numeric/LinearAlgebra/LAPACK.hs index 19516e3..936cb19 100644 --- a/lib/Numeric/LinearAlgebra/LAPACK.hs +++ b/lib/Numeric/LinearAlgebra/LAPACK.hs | |||
@@ -61,8 +61,7 @@ svdAux f st x = unsafePerformIO $ do | |||
61 | u <- createMatrix ColumnMajor r r | 61 | u <- createMatrix ColumnMajor r r |
62 | s <- createVector (min r c) | 62 | s <- createVector (min r c) |
63 | v <- createMatrix ColumnMajor c c | 63 | v <- createMatrix ColumnMajor c c |
64 | ww4 withMatrix x withMatrix u withVector s withMatrix v $ \x u s v -> | 64 | app4 f mat x mat u vec s mat v st |
65 | f // x // u // s // v // check st | ||
66 | return (u,s,trans v) | 65 | return (u,s,trans v) |
67 | where r = rows x | 66 | where r = rows x |
68 | c = cols x | 67 | c = cols x |
@@ -74,8 +73,7 @@ eigAux f st m | |||
74 | l <- createVector r | 73 | l <- createVector r |
75 | v <- createMatrix ColumnMajor r r | 74 | v <- createMatrix ColumnMajor r r |
76 | dummy <- createMatrix ColumnMajor 1 1 | 75 | dummy <- createMatrix ColumnMajor 1 1 |
77 | ww4 withMatrix m withMatrix dummy withVector l withMatrix v $ \m dummy l v -> | 76 | app4 f mat m mat dummy vec l mat v st |
78 | f // m // dummy // l // v // check st | ||
79 | return (l,v) | 77 | return (l,v) |
80 | where r = rows m | 78 | where r = rows m |
81 | 79 | ||
@@ -117,8 +115,7 @@ eigRaux m | |||
117 | l <- createVector r | 115 | l <- createVector r |
118 | v <- createMatrix ColumnMajor r r | 116 | v <- createMatrix ColumnMajor r r |
119 | dummy <- createMatrix ColumnMajor 1 1 | 117 | dummy <- createMatrix ColumnMajor 1 1 |
120 | ww4 withMatrix m withMatrix dummy withVector l withMatrix v $ \m dummy l v -> | 118 | app4 dgeev mat m mat dummy vec l mat v "eigR" |
121 | dgeev // m // dummy // l // v // check "eigR" | ||
122 | return (l,v) | 119 | return (l,v) |
123 | where r = rows m | 120 | where r = rows m |
124 | 121 | ||
@@ -147,8 +144,7 @@ eigS' m | |||
147 | | otherwise = unsafePerformIO $ do | 144 | | otherwise = unsafePerformIO $ do |
148 | l <- createVector r | 145 | l <- createVector r |
149 | v <- createMatrix ColumnMajor r r | 146 | v <- createMatrix ColumnMajor r r |
150 | ww3 withMatrix m withVector l withMatrix v $ \m l v -> | 147 | app3 dsyev mat m vec l mat v "eigS" |
151 | dsyev // m // l // v // check "eigS" | ||
152 | return (l,v) | 148 | return (l,v) |
153 | where r = rows m | 149 | where r = rows m |
154 | 150 | ||
@@ -170,8 +166,7 @@ eigH' m | |||
170 | | otherwise = unsafePerformIO $ do | 166 | | otherwise = unsafePerformIO $ do |
171 | l <- createVector r | 167 | l <- createVector r |
172 | v <- createMatrix ColumnMajor r r | 168 | v <- createMatrix ColumnMajor r r |
173 | ww3 withMatrix m withVector l withMatrix v $ \m l v -> | 169 | app3 zheev mat m vec l mat v "eigH" |
174 | zheev // m // l // v // check "eigH" | ||
175 | return (l,v) | 170 | return (l,v) |
176 | where r = rows m | 171 | where r = rows m |
177 | 172 | ||
@@ -182,8 +177,7 @@ foreign import ccall "LAPACK/lapack-aux.h linearSolveC_l" zgesv :: TCMCMCM | |||
182 | linearSolveSQAux f st a b | 177 | linearSolveSQAux f st a b |
183 | | n1==n2 && n1==r = unsafePerformIO $ do | 178 | | n1==n2 && n1==r = unsafePerformIO $ do |
184 | s <- createMatrix ColumnMajor r c | 179 | s <- createMatrix ColumnMajor r c |
185 | ww3 withMatrix a withMatrix b withMatrix s $ \a b s -> | 180 | app3 f mat a mat b mat s st |
186 | f // a // b // s // check st | ||
187 | return s | 181 | return s |
188 | | otherwise = error $ st ++ " of nonsquare matrix" | 182 | | otherwise = error $ st ++ " of nonsquare matrix" |
189 | where n1 = rows a | 183 | where n1 = rows a |
@@ -207,8 +201,7 @@ foreign import ccall "LAPACK/lapack-aux.h linearSolveSVDC_l" zgelss :: Double -> | |||
207 | 201 | ||
208 | linearSolveAux f st a b = unsafePerformIO $ do | 202 | linearSolveAux f st a b = unsafePerformIO $ do |
209 | r <- createMatrix ColumnMajor (max m n) nrhs | 203 | r <- createMatrix ColumnMajor (max m n) nrhs |
210 | ww3 withMatrix a withMatrix b withMatrix r $ \a b r -> | 204 | app3 f mat a mat b mat r st |
211 | f // a // b // r // check st | ||
212 | return r | 205 | return r |
213 | where m = rows a | 206 | where m = rows a |
214 | n = cols a | 207 | n = cols a |
@@ -258,8 +251,7 @@ cholS = cholAux dpotrf "cholS" . fmat | |||
258 | 251 | ||
259 | cholAux f st a = unsafePerformIO $ do | 252 | cholAux f st a = unsafePerformIO $ do |
260 | r <- createMatrix ColumnMajor n n | 253 | r <- createMatrix ColumnMajor n n |
261 | ww2 withMatrix a withMatrix r $ \a r -> | 254 | app2 f mat a mat r st |
262 | f // a // r // check st | ||
263 | return r | 255 | return r |
264 | where n = rows a | 256 | where n = rows a |
265 | 257 | ||
@@ -278,8 +270,7 @@ qrC = qrAux zgeqr2 "qrC" . fmat | |||
278 | qrAux f st a = unsafePerformIO $ do | 270 | qrAux f st a = unsafePerformIO $ do |
279 | r <- createMatrix ColumnMajor m n | 271 | r <- createMatrix ColumnMajor m n |
280 | tau <- createVector mn | 272 | tau <- createVector mn |
281 | ww3 withMatrix a withMatrix r withVector tau $ \ a r tau -> | 273 | app3 f mat a vec tau mat r st |
282 | f // a // tau // r // check st | ||
283 | return (r,tau) | 274 | return (r,tau) |
284 | where m = rows a | 275 | where m = rows a |
285 | n = cols a | 276 | n = cols a |
@@ -300,8 +291,7 @@ hessC = hessAux zgehrd "hessC" . fmat | |||
300 | hessAux f st a = unsafePerformIO $ do | 291 | hessAux f st a = unsafePerformIO $ do |
301 | r <- createMatrix ColumnMajor m n | 292 | r <- createMatrix ColumnMajor m n |
302 | tau <- createVector (mn-1) | 293 | tau <- createVector (mn-1) |
303 | ww3 withMatrix a withMatrix r withVector tau $ \ a r tau -> | 294 | app3 f mat a vec tau mat r st |
304 | f // a // tau // r // check st | ||
305 | return (r,tau) | 295 | return (r,tau) |
306 | where m = rows a | 296 | where m = rows a |
307 | n = cols a | 297 | n = cols a |
@@ -322,8 +312,7 @@ schurC = schurAux zgees "schurC" . fmat | |||
322 | schurAux f st a = unsafePerformIO $ do | 312 | schurAux f st a = unsafePerformIO $ do |
323 | u <- createMatrix ColumnMajor n n | 313 | u <- createMatrix ColumnMajor n n |
324 | s <- createMatrix ColumnMajor n n | 314 | s <- createMatrix ColumnMajor n n |
325 | ww3 withMatrix a withMatrix u withMatrix s $ \ a u s -> | 315 | app3 f mat a mat u mat s st |
326 | f // a // u // s // check st | ||
327 | return (u,s) | 316 | return (u,s) |
328 | where n = rows a | 317 | where n = rows a |
329 | 318 | ||