diff options
Diffstat (limited to 'lib/Numeric/GSL/Matrix.hs')
-rw-r--r-- | lib/Numeric/GSL/Matrix.hs | 36 |
1 files changed, 12 insertions, 24 deletions
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 |