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