|
5610
|
1 /* |
|
|
2 |
|
|
3 Copyright (C) 2005 David Bateman |
|
|
4 |
|
|
5 Octave is free software; you can redistribute it and/or modify it |
|
|
6 under the terms of the GNU General Public License as published by the |
|
|
7 Free Software Foundation; either version 2, or (at your option) any |
|
|
8 later version. |
|
|
9 |
|
|
10 Octave is distributed in the hope that it will be useful, but WITHOUT |
|
|
11 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
|
12 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
|
13 for more details. |
|
|
14 |
|
|
15 You should have received a copy of the GNU General Public License |
|
|
16 along with this program; see the file COPYING. If not, write to the |
|
|
17 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
|
|
18 Boston, MA 02110-1301, USA. |
|
|
19 |
|
|
20 */ |
|
|
21 |
|
|
22 #ifdef HAVE_CONFIG_H |
|
|
23 #include <config.h> |
|
|
24 #endif |
|
|
25 #include <vector> |
|
|
26 |
|
|
27 #include "lo-error.h" |
|
|
28 #include "SparseCmplxQR.h" |
|
|
29 |
|
5648
|
30 // Why did g++ 4.x stl_vector.h make |
|
|
31 // OCTAVE_LOCAL_BUFFER (double _Complex, buf, n) |
|
|
32 // an error ? |
|
|
33 #define OCTAVE_C99_COMPLEX(buf, n) \ |
|
|
34 OCTAVE_LOCAL_BUFFER (double, buf ## tmp, (2 * (n))); \ |
|
|
35 double _Complex *buf = reinterpret_cast<double _Complex *> (buf ## tmp); |
|
|
36 |
|
5681
|
37 #define OCTAVE_C99_ZERO (0. + 0.iF); |
|
|
38 |
|
5610
|
39 SparseComplexQR::SparseComplexQR_rep::SparseComplexQR_rep |
|
|
40 (const SparseComplexMatrix& a, int order) |
|
|
41 { |
|
|
42 #ifdef HAVE_CXSPARSE |
|
5648
|
43 CXSPARSE_ZNAME () A; |
|
5610
|
44 A.nzmax = a.nnz (); |
|
|
45 A.m = a.rows (); |
|
|
46 A.n = a.cols (); |
|
|
47 nrows = A.m; |
|
|
48 // Cast away const on A, with full knowledge that CSparse won't touch it |
|
|
49 // Prevents the methods below making a copy of the data. |
|
|
50 A.p = const_cast<octave_idx_type *>(a.cidx ()); |
|
|
51 A.i = const_cast<octave_idx_type *>(a.ridx ()); |
|
|
52 A.x = const_cast<double _Complex *>(reinterpret_cast<const double _Complex *> |
|
|
53 (a.data ())); |
|
|
54 A.nz = -1; |
|
|
55 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
56 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
57 S = CXSPARSE_ZNAME (_sqr) (order, &A, 1); |
|
|
58 #else |
|
|
59 S = CXSPARSE_ZNAME (_sqr) (&A, order - 1, 1); |
|
|
60 #endif |
|
5648
|
61 N = CXSPARSE_ZNAME (_qr) (&A, S); |
|
5610
|
62 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
63 if (!N) |
|
|
64 (*current_liboctave_error_handler) |
|
|
65 ("SparseComplexQR: sparse matrix QR factorization filled"); |
|
|
66 count = 1; |
|
|
67 #else |
|
|
68 (*current_liboctave_error_handler) |
|
|
69 ("SparseComplexQR: sparse matrix QR factorization not implemented"); |
|
|
70 #endif |
|
|
71 } |
|
|
72 |
|
|
73 SparseComplexQR::SparseComplexQR_rep::~SparseComplexQR_rep (void) |
|
|
74 { |
|
|
75 #ifdef HAVE_CXSPARSE |
|
5648
|
76 CXSPARSE_ZNAME (_sfree) (S); |
|
|
77 CXSPARSE_ZNAME (_nfree) (N); |
|
5610
|
78 #endif |
|
|
79 } |
|
|
80 |
|
|
81 SparseComplexMatrix |
|
|
82 SparseComplexQR::SparseComplexQR_rep::V (void) const |
|
|
83 { |
|
|
84 #ifdef HAVE_CXSPARSE |
|
|
85 // Drop zeros from V and sort |
|
5775
|
86 // FIXME Is the double transpose to sort necessary? |
|
5610
|
87 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
88 CXSPARSE_ZNAME (_dropzeros) (N->L); |
|
|
89 CXSPARSE_ZNAME () *D = CXSPARSE_ZNAME (_transpose) (N->L, 1); |
|
|
90 CXSPARSE_ZNAME (_spfree) (N->L); |
|
|
91 N->L = CXSPARSE_ZNAME (_transpose) (D, 1); |
|
|
92 CXSPARSE_ZNAME (_spfree) (D); |
|
5610
|
93 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
94 |
|
|
95 octave_idx_type nc = N->L->n; |
|
|
96 octave_idx_type nz = N->L->nzmax; |
|
|
97 SparseComplexMatrix ret (N->L->m, nc, nz); |
|
|
98 for (octave_idx_type j = 0; j < nc+1; j++) |
|
|
99 ret.xcidx (j) = N->L->p[j]; |
|
|
100 for (octave_idx_type j = 0; j < nz; j++) |
|
|
101 { |
|
|
102 ret.xridx (j) = N->L->i[j]; |
|
|
103 ret.xdata (j) = reinterpret_cast<Complex *>(N->L->x)[j]; |
|
|
104 } |
|
|
105 return ret; |
|
|
106 #else |
|
|
107 return SparseComplexMatrix (); |
|
|
108 #endif |
|
|
109 } |
|
|
110 |
|
|
111 ColumnVector |
|
|
112 SparseComplexQR::SparseComplexQR_rep::Pinv (void) const |
|
|
113 { |
|
|
114 #ifdef HAVE_CXSPARSE |
|
|
115 ColumnVector ret(N->L->m); |
|
|
116 for (octave_idx_type i = 0; i < N->L->m; i++) |
|
5792
|
117 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
118 ret.xelem(i) = S->pinv[i]; |
|
|
119 #else |
|
5610
|
120 ret.xelem(i) = S->Pinv[i]; |
|
5792
|
121 #endif |
|
5610
|
122 return ret; |
|
|
123 #else |
|
|
124 return ColumnVector (); |
|
|
125 #endif |
|
|
126 } |
|
|
127 |
|
|
128 ColumnVector |
|
|
129 SparseComplexQR::SparseComplexQR_rep::P (void) const |
|
|
130 { |
|
|
131 #ifdef HAVE_CXSPARSE |
|
|
132 ColumnVector ret(N->L->m); |
|
|
133 for (octave_idx_type i = 0; i < N->L->m; i++) |
|
5792
|
134 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
135 ret.xelem(S->pinv[i]) = i; |
|
|
136 #else |
|
5610
|
137 ret.xelem(S->Pinv[i]) = i; |
|
5792
|
138 #endif |
|
5610
|
139 return ret; |
|
|
140 #else |
|
|
141 return ColumnVector (); |
|
|
142 #endif |
|
|
143 } |
|
|
144 |
|
|
145 SparseComplexMatrix |
|
|
146 SparseComplexQR::SparseComplexQR_rep::R (const bool econ) const |
|
|
147 { |
|
|
148 #ifdef HAVE_CXSPARSE |
|
|
149 // Drop zeros from R and sort |
|
5775
|
150 // FIXME Is the double transpose to sort necessary? |
|
5610
|
151 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
152 CXSPARSE_ZNAME (_dropzeros) (N->U); |
|
|
153 CXSPARSE_ZNAME () *D = CXSPARSE_ZNAME (_transpose) (N->U, 1); |
|
|
154 CXSPARSE_ZNAME (_spfree) (N->U); |
|
|
155 N->U = CXSPARSE_ZNAME (_transpose) (D, 1); |
|
|
156 CXSPARSE_ZNAME (_spfree) (D); |
|
5610
|
157 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
158 |
|
|
159 octave_idx_type nc = N->U->n; |
|
|
160 octave_idx_type nz = N->U->nzmax; |
|
|
161 SparseComplexMatrix ret ((econ ? (nc > nrows ? nrows : nc) : nrows), nc, nz); |
|
|
162 for (octave_idx_type j = 0; j < nc+1; j++) |
|
|
163 ret.xcidx (j) = N->U->p[j]; |
|
|
164 for (octave_idx_type j = 0; j < nz; j++) |
|
|
165 { |
|
|
166 ret.xridx (j) = N->U->i[j]; |
|
|
167 ret.xdata (j) = reinterpret_cast<Complex *>(N->U->x)[j]; |
|
|
168 } |
|
|
169 return ret; |
|
|
170 #else |
|
|
171 return SparseComplexMatrix (); |
|
|
172 #endif |
|
|
173 } |
|
|
174 |
|
|
175 ComplexMatrix |
|
|
176 SparseComplexQR::SparseComplexQR_rep::C (const ComplexMatrix &b) const |
|
|
177 { |
|
|
178 #ifdef HAVE_CXSPARSE |
|
|
179 octave_idx_type b_nr = b.rows(); |
|
|
180 octave_idx_type b_nc = b.cols(); |
|
|
181 octave_idx_type nc = N->L->n; |
|
|
182 octave_idx_type nr = nrows; |
|
|
183 const double _Complex *bvec = |
|
|
184 reinterpret_cast<const double _Complex *>(b.fortran_vec()); |
|
|
185 ComplexMatrix ret(b_nr,b_nc); |
|
|
186 Complex *vec = ret.fortran_vec(); |
|
|
187 if (nr < 1 || nc < 1 || nr != b_nr) |
|
|
188 (*current_liboctave_error_handler) ("matrix dimension mismatch"); |
|
|
189 else |
|
|
190 { |
|
|
191 OCTAVE_LOCAL_BUFFER (Complex, buf, S->m2); |
|
|
192 for (volatile octave_idx_type j = 0, idx = 0; j < b_nc; j++, idx+=b_nr) |
|
|
193 { |
|
|
194 OCTAVE_QUIT; |
|
|
195 volatile octave_idx_type nm = (nr < nc ? nr : nc); |
|
|
196 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
197 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
198 CXSPARSE_ZNAME (_ipvec) |
|
|
199 (S->pinv, bvec + idx, reinterpret_cast<double _Complex *>(buf), b_nr); |
|
|
200 #else |
|
|
201 CXSPARSE_ZNAME (_ipvec) |
|
|
202 (b_nr, S->Pinv, bvec + idx, reinterpret_cast<double _Complex *>(buf)); |
|
|
203 #endif |
|
5610
|
204 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
205 for (volatile octave_idx_type i = 0; i < nm; i++) |
|
|
206 { |
|
|
207 OCTAVE_QUIT; |
|
|
208 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
209 CXSPARSE_ZNAME (_happly) |
|
5610
|
210 (N->L, i, N->B[i], reinterpret_cast<double _Complex *>(buf)); |
|
|
211 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
212 } |
|
|
213 for (octave_idx_type i = 0; i < b_nr; i++) |
|
|
214 vec[i+idx] = buf[i]; |
|
|
215 } |
|
|
216 } |
|
|
217 return ret; |
|
|
218 #else |
|
|
219 return ComplexMatrix (); |
|
|
220 #endif |
|
|
221 } |
|
|
222 |
|
|
223 ComplexMatrix |
|
|
224 qrsolve(const SparseComplexMatrix&a, const Matrix &b, octave_idx_type &info) |
|
|
225 { |
|
|
226 #ifdef HAVE_CXSPARSE |
|
|
227 octave_idx_type nr = a.rows(); |
|
|
228 octave_idx_type nc = a.cols(); |
|
|
229 octave_idx_type b_nc = b.cols(); |
|
|
230 octave_idx_type b_nr = b.rows(); |
|
|
231 ComplexMatrix x; |
|
|
232 info = 0; |
|
|
233 |
|
|
234 if (nr < 1 || nc < 1 || nr != b_nr) |
|
|
235 (*current_liboctave_error_handler) |
|
|
236 ("matrix dimension mismatch in solution of minimum norm problem"); |
|
|
237 else if (nr >= nc) |
|
|
238 { |
|
|
239 SparseComplexQR q (a, 2); |
|
|
240 if (! q.ok ()) |
|
|
241 { |
|
|
242 info = -1; |
|
|
243 return ComplexMatrix(); |
|
|
244 } |
|
|
245 x.resize(nc, b_nc); |
|
|
246 double _Complex *vec = reinterpret_cast<double _Complex *> |
|
|
247 (x.fortran_vec()); |
|
5648
|
248 OCTAVE_C99_COMPLEX (buf, q.S()->m2); |
|
5610
|
249 OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); |
|
|
250 for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) |
|
|
251 { |
|
|
252 OCTAVE_QUIT; |
|
|
253 for (octave_idx_type j = 0; j < b_nr; j++) |
|
|
254 Xx[j] = b.xelem(j,i); |
|
5681
|
255 for (octave_idx_type j = nr; j < q.S()->m2; j++) |
|
|
256 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
257 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
258 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
259 CXSPARSE_ZNAME (_ipvec) |
|
|
260 (q.S()->pinv, reinterpret_cast<double _Complex *>(Xx), buf, nr); |
|
|
261 #else |
|
5648
|
262 CXSPARSE_ZNAME (_ipvec) |
|
5610
|
263 (nr, q.S()->Pinv, reinterpret_cast<double _Complex *>(Xx), buf); |
|
5792
|
264 #endif |
|
5610
|
265 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
266 for (volatile octave_idx_type j = 0; j < nc; j++) |
|
|
267 { |
|
|
268 OCTAVE_QUIT; |
|
|
269 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
270 CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); |
|
5610
|
271 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
272 } |
|
|
273 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
274 CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); |
|
5792
|
275 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
276 CXSPARSE_ZNAME (_ipvec) (q.S()->q, buf, vec + idx, nc); |
|
|
277 #else |
|
5648
|
278 CXSPARSE_ZNAME (_ipvec) (nc, q.S()->Q, buf, vec + idx); |
|
5792
|
279 #endif |
|
5610
|
280 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
281 } |
|
|
282 } |
|
|
283 else |
|
|
284 { |
|
|
285 SparseComplexMatrix at = a.hermitian(); |
|
|
286 SparseComplexQR q (at, 2); |
|
|
287 if (! q.ok ()) |
|
|
288 { |
|
|
289 info = -1; |
|
|
290 return ComplexMatrix(); |
|
|
291 } |
|
|
292 x.resize(nc, b_nc); |
|
|
293 double _Complex *vec = reinterpret_cast<double _Complex *> |
|
|
294 (x.fortran_vec()); |
|
5681
|
295 volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); |
|
|
296 OCTAVE_C99_COMPLEX (buf, nbuf); |
|
5610
|
297 OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); |
|
|
298 OCTAVE_LOCAL_BUFFER (Complex, B, nr); |
|
|
299 for (octave_idx_type i = 0; i < nr; i++) |
|
|
300 B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); |
|
|
301 for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) |
|
|
302 { |
|
|
303 OCTAVE_QUIT; |
|
|
304 for (octave_idx_type j = 0; j < b_nr; j++) |
|
|
305 Xx[j] = b.xelem(j,i); |
|
5681
|
306 for (octave_idx_type j = nr; j < nbuf; j++) |
|
|
307 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
308 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
309 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
310 CXSPARSE_ZNAME (_pvec) |
|
|
311 (q.S()->q, reinterpret_cast<double _Complex *>(Xx), buf, nr); |
|
|
312 #else |
|
5648
|
313 CXSPARSE_ZNAME (_pvec) |
|
5610
|
314 (nr, q.S()->Q, reinterpret_cast<double _Complex *>(Xx), buf); |
|
5792
|
315 #endif |
|
5648
|
316 CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); |
|
5610
|
317 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
318 for (volatile octave_idx_type j = nr-1; j >= 0; j--) |
|
|
319 { |
|
|
320 OCTAVE_QUIT; |
|
|
321 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
322 |
|
5648
|
323 CXSPARSE_ZNAME (_happly) |
|
5610
|
324 (q.N()->L, j, reinterpret_cast<double _Complex *>(B)[j], buf); |
|
|
325 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
326 } |
|
|
327 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
328 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
329 CXSPARSE_ZNAME (_pvec) (q.S()->pinv, buf, vec + idx, nc); |
|
|
330 #else |
|
5648
|
331 CXSPARSE_ZNAME (_pvec) (nc, q.S()->Pinv, buf, vec + idx); |
|
5792
|
332 #endif |
|
5610
|
333 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
334 } |
|
|
335 } |
|
|
336 |
|
|
337 return x; |
|
|
338 #else |
|
|
339 return ComplexMatrix (); |
|
|
340 #endif |
|
|
341 } |
|
|
342 |
|
|
343 SparseComplexMatrix |
|
|
344 qrsolve(const SparseComplexMatrix&a, const SparseMatrix &b, octave_idx_type &info) |
|
|
345 { |
|
|
346 #ifdef HAVE_CXSPARSE |
|
|
347 octave_idx_type nr = a.rows(); |
|
|
348 octave_idx_type nc = a.cols(); |
|
|
349 octave_idx_type b_nc = b.cols(); |
|
|
350 octave_idx_type b_nr = b.rows(); |
|
|
351 SparseComplexMatrix x; |
|
|
352 volatile octave_idx_type ii, x_nz; |
|
|
353 info = 0; |
|
|
354 |
|
|
355 if (nr < 1 || nc < 1 || nr != b_nr) |
|
|
356 (*current_liboctave_error_handler) |
|
|
357 ("matrix dimension mismatch in solution of minimum norm problem"); |
|
|
358 else if (nr >= nc) |
|
|
359 { |
|
|
360 SparseComplexQR q (a, 2); |
|
|
361 if (! q.ok ()) |
|
|
362 { |
|
|
363 info = -1; |
|
|
364 return SparseComplexMatrix(); |
|
|
365 } |
|
|
366 x = SparseComplexMatrix (nc, b_nc, b.nzmax()); |
|
|
367 x.xcidx(0) = 0; |
|
|
368 x_nz = b.nzmax(); |
|
|
369 ii = 0; |
|
|
370 OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); |
|
5648
|
371 OCTAVE_C99_COMPLEX (buf, q.S()->m2); |
|
5610
|
372 for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) |
|
|
373 { |
|
|
374 OCTAVE_QUIT; |
|
|
375 for (octave_idx_type j = 0; j < b_nr; j++) |
|
|
376 Xx[j] = b.xelem(j,i); |
|
5681
|
377 for (octave_idx_type j = nr; j < q.S()->m2; j++) |
|
|
378 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
379 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
380 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
381 CXSPARSE_ZNAME (_ipvec) |
|
|
382 (q.S()->pinv, reinterpret_cast<double _Complex *>(Xx), buf, nr); |
|
|
383 #else |
|
5648
|
384 CXSPARSE_ZNAME (_ipvec) |
|
5610
|
385 (nr, q.S()->Pinv, reinterpret_cast<double _Complex *>(Xx), buf); |
|
5792
|
386 #endif |
|
5610
|
387 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
388 for (volatile octave_idx_type j = 0; j < nc; j++) |
|
|
389 { |
|
|
390 OCTAVE_QUIT; |
|
|
391 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
392 CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); |
|
5610
|
393 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
394 } |
|
|
395 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
396 CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); |
|
5792
|
397 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
398 CXSPARSE_ZNAME (_ipvec) |
|
|
399 (q.S()->q, buf, reinterpret_cast<double _Complex *>(Xx), nc); |
|
|
400 #else |
|
|
401 CXSPARSE_ZNAME (_ipvec) |
|
|
402 (nc, q.S()->Q, buf, reinterpret_cast<double _Complex *>(Xx)); |
|
|
403 #endif |
|
5610
|
404 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
405 |
|
|
406 for (octave_idx_type j = 0; j < nc; j++) |
|
|
407 { |
|
|
408 Complex tmp = Xx[j]; |
|
|
409 if (tmp != 0.0) |
|
|
410 { |
|
|
411 if (ii == x_nz) |
|
|
412 { |
|
|
413 // Resize the sparse matrix |
|
|
414 octave_idx_type sz = x_nz * (b_nc - i) / b_nc; |
|
|
415 sz = (sz > 10 ? sz : 10) + x_nz; |
|
|
416 x.change_capacity (sz); |
|
|
417 x_nz = sz; |
|
|
418 } |
|
|
419 x.xdata(ii) = tmp; |
|
|
420 x.xridx(ii++) = j; |
|
|
421 } |
|
|
422 } |
|
|
423 x.xcidx(i+1) = ii; |
|
|
424 } |
|
|
425 } |
|
|
426 else |
|
|
427 { |
|
|
428 SparseComplexMatrix at = a.hermitian(); |
|
|
429 SparseComplexQR q (at, 2); |
|
|
430 if (! q.ok ()) |
|
|
431 { |
|
|
432 info = -1; |
|
|
433 return SparseComplexMatrix(); |
|
|
434 } |
|
|
435 x = SparseComplexMatrix (nc, b_nc, b.nzmax()); |
|
|
436 x.xcidx(0) = 0; |
|
|
437 x_nz = b.nzmax(); |
|
|
438 ii = 0; |
|
5681
|
439 volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); |
|
5610
|
440 OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); |
|
5681
|
441 OCTAVE_C99_COMPLEX (buf, nbuf); |
|
5610
|
442 OCTAVE_LOCAL_BUFFER (Complex, B, nr); |
|
|
443 for (octave_idx_type i = 0; i < nr; i++) |
|
|
444 B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); |
|
|
445 for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) |
|
|
446 { |
|
|
447 OCTAVE_QUIT; |
|
|
448 for (octave_idx_type j = 0; j < b_nr; j++) |
|
|
449 Xx[j] = b.xelem(j,i); |
|
5681
|
450 for (octave_idx_type j = nr; j < nbuf; j++) |
|
|
451 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
452 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
453 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
454 CXSPARSE_ZNAME (_pvec) |
|
|
455 (q.S()->q, reinterpret_cast<double _Complex *>(Xx), buf, nr); |
|
|
456 #else |
|
5648
|
457 CXSPARSE_ZNAME (_pvec) |
|
5610
|
458 (nr, q.S()->Q, reinterpret_cast<double _Complex *>(Xx), buf); |
|
5792
|
459 #endif |
|
5648
|
460 CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); |
|
5610
|
461 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
462 for (volatile octave_idx_type j = nr-1; j >= 0; j--) |
|
|
463 { |
|
|
464 OCTAVE_QUIT; |
|
|
465 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
466 CXSPARSE_ZNAME (_happly) |
|
5610
|
467 (q.N()->L, j, reinterpret_cast<double _Complex *>(B)[j], buf); |
|
|
468 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
469 } |
|
|
470 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
471 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
472 CXSPARSE_ZNAME (_pvec) |
|
|
473 (q.S()->pinv, buf, reinterpret_cast<double _Complex *>(Xx), nc); |
|
|
474 #else |
|
|
475 CXSPARSE_ZNAME (_pvec) |
|
|
476 (nc, q.S()->Pinv, buf, reinterpret_cast<double _Complex *>(Xx)); |
|
|
477 #endif |
|
5610
|
478 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
479 |
|
|
480 for (octave_idx_type j = 0; j < nc; j++) |
|
|
481 { |
|
|
482 Complex tmp = Xx[j]; |
|
|
483 if (tmp != 0.0) |
|
|
484 { |
|
|
485 if (ii == x_nz) |
|
|
486 { |
|
|
487 // Resize the sparse matrix |
|
|
488 octave_idx_type sz = x_nz * (b_nc - i) / b_nc; |
|
|
489 sz = (sz > 10 ? sz : 10) + x_nz; |
|
|
490 x.change_capacity (sz); |
|
|
491 x_nz = sz; |
|
|
492 } |
|
|
493 x.xdata(ii) = tmp; |
|
|
494 x.xridx(ii++) = j; |
|
|
495 } |
|
|
496 } |
|
|
497 x.xcidx(i+1) = ii; |
|
|
498 } |
|
|
499 } |
|
|
500 |
|
|
501 x.maybe_compress (); |
|
|
502 return x; |
|
|
503 #else |
|
|
504 return SparseComplexMatrix (); |
|
|
505 #endif |
|
|
506 } |
|
|
507 |
|
|
508 ComplexMatrix |
|
|
509 qrsolve(const SparseComplexMatrix&a, const ComplexMatrix &b, octave_idx_type &info) |
|
|
510 { |
|
|
511 #ifdef HAVE_CXSPARSE |
|
|
512 octave_idx_type nr = a.rows(); |
|
|
513 octave_idx_type nc = a.cols(); |
|
|
514 octave_idx_type b_nc = b.cols(); |
|
|
515 octave_idx_type b_nr = b.rows(); |
|
|
516 const double _Complex *bvec = |
|
|
517 reinterpret_cast<const double _Complex *>(b.fortran_vec()); |
|
|
518 ComplexMatrix x; |
|
|
519 info = 0; |
|
|
520 |
|
|
521 if (nr < 1 || nc < 1 || nr != b_nr) |
|
|
522 (*current_liboctave_error_handler) |
|
|
523 ("matrix dimension mismatch in solution of minimum norm problem"); |
|
|
524 else if (nr >= nc) |
|
|
525 { |
|
|
526 SparseComplexQR q (a, 2); |
|
|
527 if (! q.ok ()) |
|
|
528 { |
|
|
529 info = -1; |
|
|
530 return ComplexMatrix(); |
|
|
531 } |
|
|
532 x.resize(nc, b_nc); |
|
|
533 double _Complex *vec = reinterpret_cast<double _Complex *> |
|
|
534 (x.fortran_vec()); |
|
5648
|
535 OCTAVE_C99_COMPLEX (buf, q.S()->m2); |
|
5610
|
536 for (volatile octave_idx_type i = 0, idx = 0, bidx = 0; i < b_nc; |
|
|
537 i++, idx+=nc, bidx+=b_nr) |
|
|
538 { |
|
|
539 OCTAVE_QUIT; |
|
5681
|
540 for (octave_idx_type j = nr; j < q.S()->m2; j++) |
|
|
541 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
542 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
543 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
544 CXSPARSE_ZNAME (_ipvec) (q.S()->pinv, bvec + bidx, buf, nr); |
|
|
545 #else |
|
5648
|
546 CXSPARSE_ZNAME (_ipvec) (nr, q.S()->Pinv, bvec + bidx, buf); |
|
5792
|
547 #endif |
|
5610
|
548 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
549 for (volatile octave_idx_type j = 0; j < nc; j++) |
|
|
550 { |
|
|
551 OCTAVE_QUIT; |
|
|
552 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
553 CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); |
|
5610
|
554 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
555 } |
|
|
556 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
557 CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); |
|
5792
|
558 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
559 CXSPARSE_ZNAME (_ipvec) (q.S()->q, buf, vec + idx, nc); |
|
|
560 #else |
|
5648
|
561 CXSPARSE_ZNAME (_ipvec) (nc, q.S()->Q, buf, vec + idx); |
|
5792
|
562 #endif |
|
5610
|
563 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
564 } |
|
|
565 } |
|
|
566 else |
|
|
567 { |
|
|
568 SparseComplexMatrix at = a.hermitian(); |
|
|
569 SparseComplexQR q (at, 2); |
|
|
570 if (! q.ok ()) |
|
|
571 { |
|
|
572 info = -1; |
|
|
573 return ComplexMatrix(); |
|
|
574 } |
|
|
575 x.resize(nc, b_nc); |
|
|
576 double _Complex *vec = reinterpret_cast<double _Complex *> |
|
|
577 (x.fortran_vec()); |
|
5681
|
578 volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); |
|
|
579 OCTAVE_C99_COMPLEX (buf, nbuf); |
|
5610
|
580 OCTAVE_LOCAL_BUFFER (Complex, B, nr); |
|
|
581 for (octave_idx_type i = 0; i < nr; i++) |
|
|
582 B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); |
|
|
583 for (volatile octave_idx_type i = 0, idx = 0, bidx = 0; i < b_nc; |
|
|
584 i++, idx+=nc, bidx+=b_nr) |
|
|
585 { |
|
|
586 OCTAVE_QUIT; |
|
5681
|
587 for (octave_idx_type j = nr; j < nbuf; j++) |
|
|
588 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
589 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
590 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
591 CXSPARSE_ZNAME (_pvec) (q.S()->q, bvec + bidx, buf, nr); |
|
|
592 #else |
|
5648
|
593 CXSPARSE_ZNAME (_pvec) (nr, q.S()->Q, bvec + bidx, buf); |
|
5792
|
594 #endif |
|
5648
|
595 CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); |
|
5610
|
596 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
597 for (volatile octave_idx_type j = nr-1; j >= 0; j--) |
|
|
598 { |
|
|
599 OCTAVE_QUIT; |
|
|
600 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
601 CXSPARSE_ZNAME (_happly) |
|
5610
|
602 (q.N()->L, j, reinterpret_cast<double _Complex *>(B)[j], buf); |
|
|
603 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
604 } |
|
|
605 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
606 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
607 CXSPARSE_ZNAME (_pvec) (q.S()->pinv, buf, vec + idx, nc); |
|
|
608 #else |
|
5648
|
609 CXSPARSE_ZNAME (_pvec) (nc, q.S()->Pinv, buf, vec + idx); |
|
5792
|
610 #endif |
|
5610
|
611 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
612 } |
|
|
613 } |
|
|
614 |
|
|
615 return x; |
|
|
616 #else |
|
|
617 return ComplexMatrix (); |
|
|
618 #endif |
|
|
619 } |
|
|
620 |
|
|
621 SparseComplexMatrix |
|
|
622 qrsolve(const SparseComplexMatrix&a, const SparseComplexMatrix &b, octave_idx_type &info) |
|
|
623 { |
|
|
624 #ifdef HAVE_CXSPARSE |
|
|
625 octave_idx_type nr = a.rows(); |
|
|
626 octave_idx_type nc = a.cols(); |
|
|
627 octave_idx_type b_nc = b.cols(); |
|
|
628 octave_idx_type b_nr = b.rows(); |
|
|
629 SparseComplexMatrix x; |
|
|
630 volatile octave_idx_type ii, x_nz; |
|
|
631 info = 0; |
|
|
632 |
|
|
633 if (nr < 1 || nc < 1 || nr != b_nr) |
|
|
634 (*current_liboctave_error_handler) |
|
|
635 ("matrix dimension mismatch in solution of minimum norm problem"); |
|
|
636 else if (nr >= nc) |
|
|
637 { |
|
|
638 SparseComplexQR q (a, 2); |
|
|
639 if (! q.ok ()) |
|
|
640 { |
|
|
641 info = -1; |
|
|
642 return SparseComplexMatrix(); |
|
|
643 } |
|
|
644 x = SparseComplexMatrix (nc, b_nc, b.nzmax()); |
|
|
645 x.xcidx(0) = 0; |
|
|
646 x_nz = b.nzmax(); |
|
|
647 ii = 0; |
|
|
648 OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); |
|
5648
|
649 OCTAVE_C99_COMPLEX (buf, q.S()->m2); |
|
5610
|
650 for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) |
|
|
651 { |
|
|
652 OCTAVE_QUIT; |
|
|
653 for (octave_idx_type j = 0; j < b_nr; j++) |
|
|
654 Xx[j] = b.xelem(j,i); |
|
5681
|
655 for (octave_idx_type j = nr; j < q.S()->m2; j++) |
|
|
656 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
657 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
658 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
659 CXSPARSE_ZNAME (_ipvec) |
|
|
660 (q.S()->pinv, reinterpret_cast<double _Complex *>(Xx), buf, nr); |
|
|
661 #else |
|
5648
|
662 CXSPARSE_ZNAME (_ipvec) |
|
5610
|
663 (nr, q.S()->Pinv, reinterpret_cast<double _Complex *>(Xx), buf); |
|
5792
|
664 #endif |
|
5610
|
665 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
666 for (volatile octave_idx_type j = 0; j < nc; j++) |
|
|
667 { |
|
|
668 OCTAVE_QUIT; |
|
|
669 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
670 CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); |
|
5610
|
671 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
672 } |
|
|
673 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
674 CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); |
|
5792
|
675 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
676 CXSPARSE_ZNAME (_ipvec) |
|
|
677 (q.S()->q, buf, reinterpret_cast<double _Complex *>(Xx), nc); |
|
|
678 #else |
|
|
679 CXSPARSE_ZNAME (_ipvec) |
|
|
680 (nc, q.S()->Q, buf, reinterpret_cast<double _Complex *>(Xx)); |
|
|
681 #endif |
|
5610
|
682 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
683 |
|
|
684 for (octave_idx_type j = 0; j < nc; j++) |
|
|
685 { |
|
|
686 Complex tmp = Xx[j]; |
|
|
687 if (tmp != 0.0) |
|
|
688 { |
|
|
689 if (ii == x_nz) |
|
|
690 { |
|
|
691 // Resize the sparse matrix |
|
|
692 octave_idx_type sz = x_nz * (b_nc - i) / b_nc; |
|
|
693 sz = (sz > 10 ? sz : 10) + x_nz; |
|
|
694 x.change_capacity (sz); |
|
|
695 x_nz = sz; |
|
|
696 } |
|
|
697 x.xdata(ii) = tmp; |
|
|
698 x.xridx(ii++) = j; |
|
|
699 } |
|
|
700 } |
|
|
701 x.xcidx(i+1) = ii; |
|
|
702 } |
|
|
703 } |
|
|
704 else |
|
|
705 { |
|
|
706 SparseComplexMatrix at = a.hermitian(); |
|
|
707 SparseComplexQR q (at, 2); |
|
|
708 if (! q.ok ()) |
|
|
709 { |
|
|
710 info = -1; |
|
|
711 return SparseComplexMatrix(); |
|
|
712 } |
|
|
713 x = SparseComplexMatrix (nc, b_nc, b.nzmax()); |
|
|
714 x.xcidx(0) = 0; |
|
|
715 x_nz = b.nzmax(); |
|
|
716 ii = 0; |
|
5681
|
717 volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); |
|
5610
|
718 OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); |
|
5681
|
719 OCTAVE_C99_COMPLEX (buf, nbuf); |
|
5610
|
720 OCTAVE_LOCAL_BUFFER (Complex, B, nr); |
|
|
721 for (octave_idx_type i = 0; i < nr; i++) |
|
|
722 B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); |
|
|
723 for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) |
|
|
724 { |
|
|
725 OCTAVE_QUIT; |
|
|
726 for (octave_idx_type j = 0; j < b_nr; j++) |
|
|
727 Xx[j] = b.xelem(j,i); |
|
5681
|
728 for (octave_idx_type j = nr; j < nbuf; j++) |
|
|
729 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
730 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
731 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
732 CXSPARSE_ZNAME (_pvec) |
|
|
733 (q.S()->q, reinterpret_cast<double _Complex *>(Xx), buf, nr); |
|
|
734 #else |
|
5648
|
735 CXSPARSE_ZNAME (_pvec) |
|
5610
|
736 (nr, q.S()->Q, reinterpret_cast<double _Complex *>(Xx), buf); |
|
5792
|
737 #endif |
|
5648
|
738 CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); |
|
5610
|
739 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
740 for (volatile octave_idx_type j = nr-1; j >= 0; j--) |
|
|
741 { |
|
|
742 OCTAVE_QUIT; |
|
|
743 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
744 CXSPARSE_ZNAME (_happly) |
|
5610
|
745 (q.N()->L, j, reinterpret_cast<double _Complex *>(B)[j], buf); |
|
|
746 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
747 } |
|
|
748 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
749 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
750 CXSPARSE_ZNAME (_pvec) |
|
|
751 (q.S()->pinv, buf, reinterpret_cast<double _Complex *>(Xx), nc); |
|
|
752 #else |
|
|
753 CXSPARSE_ZNAME (_pvec) |
|
|
754 (nc, q.S()->Pinv, buf, reinterpret_cast<double _Complex *>(Xx)); |
|
|
755 #endif |
|
5610
|
756 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
757 |
|
|
758 for (octave_idx_type j = 0; j < nc; j++) |
|
|
759 { |
|
|
760 Complex tmp = Xx[j]; |
|
|
761 if (tmp != 0.0) |
|
|
762 { |
|
|
763 if (ii == x_nz) |
|
|
764 { |
|
|
765 // Resize the sparse matrix |
|
|
766 octave_idx_type sz = x_nz * (b_nc - i) / b_nc; |
|
|
767 sz = (sz > 10 ? sz : 10) + x_nz; |
|
|
768 x.change_capacity (sz); |
|
|
769 x_nz = sz; |
|
|
770 } |
|
|
771 x.xdata(ii) = tmp; |
|
|
772 x.xridx(ii++) = j; |
|
|
773 } |
|
|
774 } |
|
|
775 x.xcidx(i+1) = ii; |
|
|
776 } |
|
|
777 } |
|
|
778 |
|
|
779 x.maybe_compress (); |
|
|
780 return x; |
|
|
781 #else |
|
|
782 return SparseComplexMatrix (); |
|
|
783 #endif |
|
|
784 } |
|
|
785 |
|
|
786 /* |
|
|
787 ;;; Local Variables: *** |
|
|
788 ;;; mode: C++ *** |
|
|
789 ;;; End: *** |
|
|
790 */ |
