summaryrefslogtreecommitdiff
path: root/lib/Numeric
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Numeric')
-rw-r--r--lib/Numeric/GSL/Fourier.hs3
-rw-r--r--lib/Numeric/GSL/Matrix.hs36
-rw-r--r--lib/Numeric/GSL/Minimization.hs14
-rw-r--r--lib/Numeric/GSL/Polynomials.hs3
-rw-r--r--lib/Numeric/GSL/Vector.hs12
-rw-r--r--lib/Numeric/LinearAlgebra/LAPACK.hs33
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
27genfft code v = unsafePerformIO $ do 27genfft 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
33foreign import ccall "gsl-aux.h fft" c_fft :: Int -> TCVCV 32foreign 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
58foreign import ccall "gsl-aux.h eigensystemR" c_eigS :: TMVM 57foreign 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
92foreign import ccall "gsl-aux.h eigensystemC" c_eigH :: TCMVCM 90foreign 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
152qr' x = unsafePerformIO $ do 149qr' 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
165qrPacked' x = unsafePerformIO $ do 161qrPacked' 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)
178unpackQR' (qr,tau) = unsafePerformIO $ do 173unpackQR' (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
204cholR' x = unsafePerformIO $ do 198cholR' 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
210foreign import ccall "gsl-aux.h cholR" c_cholR :: TMM 203foreign import ccall "gsl-aux.h cholR" c_cholR :: TMM
@@ -214,8 +207,7 @@ cholC = cholC' . cmat
214 207
215cholC' x = unsafePerformIO $ do 208cholC' 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
221foreign import ccall "gsl-aux.h cholC" c_cholC :: TCMCM 213foreign import ccall "gsl-aux.h cholC" c_cholC :: TCMCM
@@ -231,8 +223,7 @@ luSolveR a b = luSolveR' (cmat a) (cmat b)
231luSolveR' a b 223luSolveR' 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)
249luSolveC' a b 240luSolveC' 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
267luRaux' x = unsafePerformIO $ do 257luRaux' 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
281luCaux' x = unsafePerformIO $ do 270luCaux' 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
200createV n fun msg = unsafePerformIO $ do 199createV 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{-
207createM 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
213createMIO r c fun msg = do 204createMIO 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
47polySolve' :: Vector Double -> Vector (Complex Double) 47polySolve' :: Vector Double -> Vector (Complex Double)
48polySolve' v | dim v > 1 = unsafePerformIO $ do 48polySolve' 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
74toScalarAux fun code v = unsafePerformIO $ do 74toScalarAux 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
80vectorMapAux fun code v = unsafePerformIO $ do 79vectorMapAux 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
86vectorMapValAux fun code val v = unsafePerformIO $ do 84vectorMapValAux 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
94vectorZipAux fun code u v = unsafePerformIO $ do 91vectorZipAux 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
182linearSolveSQAux f st a b 177linearSolveSQAux 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
208linearSolveAux f st a b = unsafePerformIO $ do 202linearSolveAux 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
259cholAux f st a = unsafePerformIO $ do 252cholAux 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
278qrAux f st a = unsafePerformIO $ do 270qrAux 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
300hessAux f st a = unsafePerformIO $ do 291hessAux 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
322schurAux f st a = unsafePerformIO $ do 312schurAux 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