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