diff options
Diffstat (limited to 'packages/base/src/Internal/LAPACK.hs')
-rw-r--r-- | packages/base/src/Internal/LAPACK.hs | 47 |
1 files changed, 26 insertions, 21 deletions
diff --git a/packages/base/src/Internal/LAPACK.hs b/packages/base/src/Internal/LAPACK.hs index 124e353..c91cddd 100644 --- a/packages/base/src/Internal/LAPACK.hs +++ b/packages/base/src/Internal/LAPACK.hs | |||
@@ -102,25 +102,26 @@ foreign import ccall unsafe "svd_l_Cdd" zgesdd :: TSVD C | |||
102 | 102 | ||
103 | -- | Full SVD of a real matrix using LAPACK's /dgesvd/. | 103 | -- | Full SVD of a real matrix using LAPACK's /dgesvd/. |
104 | svdR :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double) | 104 | svdR :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double) |
105 | svdR = svdAux dgesvd "svdR" . fmat | 105 | svdR = svdAux dgesvd "svdR" |
106 | 106 | ||
107 | -- | Full SVD of a real matrix using LAPACK's /dgesdd/. | 107 | -- | Full SVD of a real matrix using LAPACK's /dgesdd/. |
108 | svdRd :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double) | 108 | svdRd :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double) |
109 | svdRd = svdAux dgesdd "svdRdd" . fmat | 109 | svdRd = svdAux dgesdd "svdRdd" |
110 | 110 | ||
111 | -- | Full SVD of a complex matrix using LAPACK's /zgesvd/. | 111 | -- | Full SVD of a complex matrix using LAPACK's /zgesvd/. |
112 | svdC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double)) | 112 | svdC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double)) |
113 | svdC = svdAux zgesvd "svdC" . fmat | 113 | svdC = svdAux zgesvd "svdC" |
114 | 114 | ||
115 | -- | Full SVD of a complex matrix using LAPACK's /zgesdd/. | 115 | -- | Full SVD of a complex matrix using LAPACK's /zgesdd/. |
116 | svdCd :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double)) | 116 | svdCd :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double)) |
117 | svdCd = svdAux zgesdd "svdCdd" . fmat | 117 | svdCd = svdAux zgesdd "svdCdd" |
118 | 118 | ||
119 | svdAux f st x = unsafePerformIO $ do | 119 | svdAux f st x = unsafePerformIO $ do |
120 | a <- copy ColumnMajor x | ||
120 | u <- createMatrix ColumnMajor r r | 121 | u <- createMatrix ColumnMajor r r |
121 | s <- createVector (min r c) | 122 | s <- createVector (min r c) |
122 | v <- createMatrix ColumnMajor c c | 123 | v <- createMatrix ColumnMajor c c |
123 | f # x # u # s # v #| st | 124 | f # a # u # s # v #| st |
124 | return (u,s,v) | 125 | return (u,s,v) |
125 | where | 126 | where |
126 | r = rows x | 127 | r = rows x |
@@ -129,25 +130,26 @@ svdAux f st x = unsafePerformIO $ do | |||
129 | 130 | ||
130 | -- | Thin SVD of a real matrix, using LAPACK's /dgesvd/ with jobu == jobvt == \'S\'. | 131 | -- | Thin SVD of a real matrix, using LAPACK's /dgesvd/ with jobu == jobvt == \'S\'. |
131 | thinSVDR :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double) | 132 | thinSVDR :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double) |
132 | thinSVDR = thinSVDAux dgesvd "thinSVDR" . fmat | 133 | thinSVDR = thinSVDAux dgesvd "thinSVDR" |
133 | 134 | ||
134 | -- | Thin SVD of a complex matrix, using LAPACK's /zgesvd/ with jobu == jobvt == \'S\'. | 135 | -- | Thin SVD of a complex matrix, using LAPACK's /zgesvd/ with jobu == jobvt == \'S\'. |
135 | thinSVDC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double)) | 136 | thinSVDC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double)) |
136 | thinSVDC = thinSVDAux zgesvd "thinSVDC" . fmat | 137 | thinSVDC = thinSVDAux zgesvd "thinSVDC" |
137 | 138 | ||
138 | -- | Thin SVD of a real matrix, using LAPACK's /dgesdd/ with jobz == \'S\'. | 139 | -- | Thin SVD of a real matrix, using LAPACK's /dgesdd/ with jobz == \'S\'. |
139 | thinSVDRd :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double) | 140 | thinSVDRd :: Matrix Double -> (Matrix Double, Vector Double, Matrix Double) |
140 | thinSVDRd = thinSVDAux dgesdd "thinSVDRdd" . fmat | 141 | thinSVDRd = thinSVDAux dgesdd "thinSVDRdd" |
141 | 142 | ||
142 | -- | Thin SVD of a complex matrix, using LAPACK's /zgesdd/ with jobz == \'S\'. | 143 | -- | Thin SVD of a complex matrix, using LAPACK's /zgesdd/ with jobz == \'S\'. |
143 | thinSVDCd :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double)) | 144 | thinSVDCd :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double, Matrix (Complex Double)) |
144 | thinSVDCd = thinSVDAux zgesdd "thinSVDCdd" . fmat | 145 | thinSVDCd = thinSVDAux zgesdd "thinSVDCdd" |
145 | 146 | ||
146 | thinSVDAux f st x = unsafePerformIO $ do | 147 | thinSVDAux f st x = unsafePerformIO $ do |
148 | a <- copy ColumnMajor x | ||
147 | u <- createMatrix ColumnMajor r q | 149 | u <- createMatrix ColumnMajor r q |
148 | s <- createVector q | 150 | s <- createVector q |
149 | v <- createMatrix ColumnMajor q c | 151 | v <- createMatrix ColumnMajor q c |
150 | f # x # u # s # v #| st | 152 | f # a # u # s # v #| st |
151 | return (u,s,v) | 153 | return (u,s,v) |
152 | where | 154 | where |
153 | r = rows x | 155 | r = rows x |
@@ -157,23 +159,24 @@ thinSVDAux f st x = unsafePerformIO $ do | |||
157 | 159 | ||
158 | -- | Singular values of a real matrix, using LAPACK's /dgesvd/ with jobu == jobvt == \'N\'. | 160 | -- | Singular values of a real matrix, using LAPACK's /dgesvd/ with jobu == jobvt == \'N\'. |
159 | svR :: Matrix Double -> Vector Double | 161 | svR :: Matrix Double -> Vector Double |
160 | svR = svAux dgesvd "svR" . fmat | 162 | svR = svAux dgesvd "svR" |
161 | 163 | ||
162 | -- | Singular values of a complex matrix, using LAPACK's /zgesvd/ with jobu == jobvt == \'N\'. | 164 | -- | Singular values of a complex matrix, using LAPACK's /zgesvd/ with jobu == jobvt == \'N\'. |
163 | svC :: Matrix (Complex Double) -> Vector Double | 165 | svC :: Matrix (Complex Double) -> Vector Double |
164 | svC = svAux zgesvd "svC" . fmat | 166 | svC = svAux zgesvd "svC" |
165 | 167 | ||
166 | -- | Singular values of a real matrix, using LAPACK's /dgesdd/ with jobz == \'N\'. | 168 | -- | Singular values of a real matrix, using LAPACK's /dgesdd/ with jobz == \'N\'. |
167 | svRd :: Matrix Double -> Vector Double | 169 | svRd :: Matrix Double -> Vector Double |
168 | svRd = svAux dgesdd "svRd" . fmat | 170 | svRd = svAux dgesdd "svRd" |
169 | 171 | ||
170 | -- | Singular values of a complex matrix, using LAPACK's /zgesdd/ with jobz == \'N\'. | 172 | -- | Singular values of a complex matrix, using LAPACK's /zgesdd/ with jobz == \'N\'. |
171 | svCd :: Matrix (Complex Double) -> Vector Double | 173 | svCd :: Matrix (Complex Double) -> Vector Double |
172 | svCd = svAux zgesdd "svCd" . fmat | 174 | svCd = svAux zgesdd "svCd" |
173 | 175 | ||
174 | svAux f st x = unsafePerformIO $ do | 176 | svAux f st x = unsafePerformIO $ do |
177 | a <- copy ColumnMajor x | ||
175 | s <- createVector q | 178 | s <- createVector q |
176 | g # x # s #| st | 179 | g # a # s #| st |
177 | return s | 180 | return s |
178 | where | 181 | where |
179 | r = rows x | 182 | r = rows x |
@@ -184,16 +187,17 @@ svAux f st x = unsafePerformIO $ do | |||
184 | 187 | ||
185 | -- | Singular values and all right singular vectors of a real matrix, using LAPACK's /dgesvd/ with jobu == \'N\' and jobvt == \'A\'. | 188 | -- | Singular values and all right singular vectors of a real matrix, using LAPACK's /dgesvd/ with jobu == \'N\' and jobvt == \'A\'. |
186 | rightSVR :: Matrix Double -> (Vector Double, Matrix Double) | 189 | rightSVR :: Matrix Double -> (Vector Double, Matrix Double) |
187 | rightSVR = rightSVAux dgesvd "rightSVR" . fmat | 190 | rightSVR = rightSVAux dgesvd "rightSVR" |
188 | 191 | ||
189 | -- | Singular values and all right singular vectors of a complex matrix, using LAPACK's /zgesvd/ with jobu == \'N\' and jobvt == \'A\'. | 192 | -- | Singular values and all right singular vectors of a complex matrix, using LAPACK's /zgesvd/ with jobu == \'N\' and jobvt == \'A\'. |
190 | rightSVC :: Matrix (Complex Double) -> (Vector Double, Matrix (Complex Double)) | 193 | rightSVC :: Matrix (Complex Double) -> (Vector Double, Matrix (Complex Double)) |
191 | rightSVC = rightSVAux zgesvd "rightSVC" . fmat | 194 | rightSVC = rightSVAux zgesvd "rightSVC" |
192 | 195 | ||
193 | rightSVAux f st x = unsafePerformIO $ do | 196 | rightSVAux f st x = unsafePerformIO $ do |
197 | a <- copy ColumnMajor x | ||
194 | s <- createVector q | 198 | s <- createVector q |
195 | v <- createMatrix ColumnMajor c c | 199 | v <- createMatrix ColumnMajor c c |
196 | g # x # s # v #| st | 200 | g # a # s # v #| st |
197 | return (s,v) | 201 | return (s,v) |
198 | where | 202 | where |
199 | r = rows x | 203 | r = rows x |
@@ -204,16 +208,17 @@ rightSVAux f st x = unsafePerformIO $ do | |||
204 | 208 | ||
205 | -- | Singular values and all left singular vectors of a real matrix, using LAPACK's /dgesvd/ with jobu == \'A\' and jobvt == \'N\'. | 209 | -- | Singular values and all left singular vectors of a real matrix, using LAPACK's /dgesvd/ with jobu == \'A\' and jobvt == \'N\'. |
206 | leftSVR :: Matrix Double -> (Matrix Double, Vector Double) | 210 | leftSVR :: Matrix Double -> (Matrix Double, Vector Double) |
207 | leftSVR = leftSVAux dgesvd "leftSVR" . fmat | 211 | leftSVR = leftSVAux dgesvd "leftSVR" |
208 | 212 | ||
209 | -- | Singular values and all left singular vectors of a complex matrix, using LAPACK's /zgesvd/ with jobu == \'A\' and jobvt == \'N\'. | 213 | -- | Singular values and all left singular vectors of a complex matrix, using LAPACK's /zgesvd/ with jobu == \'A\' and jobvt == \'N\'. |
210 | leftSVC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double) | 214 | leftSVC :: Matrix (Complex Double) -> (Matrix (Complex Double), Vector Double) |
211 | leftSVC = leftSVAux zgesvd "leftSVC" . fmat | 215 | leftSVC = leftSVAux zgesvd "leftSVC" |
212 | 216 | ||
213 | leftSVAux f st x = unsafePerformIO $ do | 217 | leftSVAux f st x = unsafePerformIO $ do |
218 | a <- copy ColumnMajor x | ||
214 | u <- createMatrix ColumnMajor r r | 219 | u <- createMatrix ColumnMajor r r |
215 | s <- createVector q | 220 | s <- createVector q |
216 | g # x # u # s #| st | 221 | g # a # u # s #| st |
217 | return (u,s) | 222 | return (u,s) |
218 | where | 223 | where |
219 | r = rows x | 224 | r = rows x |