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/LinearAlgebra | |
parent | 2f45fdd97f80c0ffd0e10cce68d1cd24a43696c0 (diff) |
app1, app2, ...
Diffstat (limited to 'lib/Numeric/LinearAlgebra')
-rw-r--r-- | lib/Numeric/LinearAlgebra/LAPACK.hs | 33 |
1 files changed, 11 insertions, 22 deletions
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 | ||