|
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 { |
|
5797
|
226 info = -1; |
|
5610
|
227 #ifdef HAVE_CXSPARSE |
|
|
228 octave_idx_type nr = a.rows(); |
|
|
229 octave_idx_type nc = a.cols(); |
|
|
230 octave_idx_type b_nc = b.cols(); |
|
|
231 octave_idx_type b_nr = b.rows(); |
|
|
232 ComplexMatrix x; |
|
|
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 ()) |
|
5797
|
241 return ComplexMatrix(); |
|
5610
|
242 x.resize(nc, b_nc); |
|
|
243 double _Complex *vec = reinterpret_cast<double _Complex *> |
|
|
244 (x.fortran_vec()); |
|
5648
|
245 OCTAVE_C99_COMPLEX (buf, q.S()->m2); |
|
5610
|
246 OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); |
|
|
247 for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) |
|
|
248 { |
|
|
249 OCTAVE_QUIT; |
|
|
250 for (octave_idx_type j = 0; j < b_nr; j++) |
|
|
251 Xx[j] = b.xelem(j,i); |
|
5681
|
252 for (octave_idx_type j = nr; j < q.S()->m2; j++) |
|
|
253 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
254 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
255 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
256 CXSPARSE_ZNAME (_ipvec) |
|
|
257 (q.S()->pinv, reinterpret_cast<double _Complex *>(Xx), buf, nr); |
|
|
258 #else |
|
5648
|
259 CXSPARSE_ZNAME (_ipvec) |
|
5610
|
260 (nr, q.S()->Pinv, reinterpret_cast<double _Complex *>(Xx), buf); |
|
5792
|
261 #endif |
|
5610
|
262 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
263 for (volatile octave_idx_type j = 0; j < nc; j++) |
|
|
264 { |
|
|
265 OCTAVE_QUIT; |
|
|
266 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
267 CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); |
|
5610
|
268 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
269 } |
|
|
270 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
271 CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); |
|
5792
|
272 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
273 CXSPARSE_ZNAME (_ipvec) (q.S()->q, buf, vec + idx, nc); |
|
|
274 #else |
|
5648
|
275 CXSPARSE_ZNAME (_ipvec) (nc, q.S()->Q, buf, vec + idx); |
|
5792
|
276 #endif |
|
5610
|
277 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
278 } |
|
5797
|
279 info = 0; |
|
5610
|
280 } |
|
|
281 else |
|
|
282 { |
|
|
283 SparseComplexMatrix at = a.hermitian(); |
|
|
284 SparseComplexQR q (at, 2); |
|
|
285 if (! q.ok ()) |
|
5797
|
286 return ComplexMatrix(); |
|
5610
|
287 x.resize(nc, b_nc); |
|
|
288 double _Complex *vec = reinterpret_cast<double _Complex *> |
|
|
289 (x.fortran_vec()); |
|
5681
|
290 volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); |
|
|
291 OCTAVE_C99_COMPLEX (buf, nbuf); |
|
5610
|
292 OCTAVE_LOCAL_BUFFER (Complex, Xx, b_nr); |
|
|
293 OCTAVE_LOCAL_BUFFER (Complex, B, nr); |
|
|
294 for (octave_idx_type i = 0; i < nr; i++) |
|
|
295 B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); |
|
|
296 for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) |
|
|
297 { |
|
|
298 OCTAVE_QUIT; |
|
|
299 for (octave_idx_type j = 0; j < b_nr; j++) |
|
|
300 Xx[j] = b.xelem(j,i); |
|
5681
|
301 for (octave_idx_type j = nr; j < nbuf; j++) |
|
|
302 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
303 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
304 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
305 CXSPARSE_ZNAME (_pvec) |
|
|
306 (q.S()->q, reinterpret_cast<double _Complex *>(Xx), buf, nr); |
|
|
307 #else |
|
5648
|
308 CXSPARSE_ZNAME (_pvec) |
|
5610
|
309 (nr, q.S()->Q, reinterpret_cast<double _Complex *>(Xx), buf); |
|
5792
|
310 #endif |
|
5648
|
311 CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); |
|
5610
|
312 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
313 for (volatile octave_idx_type j = nr-1; j >= 0; j--) |
|
|
314 { |
|
|
315 OCTAVE_QUIT; |
|
|
316 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
317 |
|
5648
|
318 CXSPARSE_ZNAME (_happly) |
|
5610
|
319 (q.N()->L, j, reinterpret_cast<double _Complex *>(B)[j], buf); |
|
|
320 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
321 } |
|
|
322 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
323 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
324 CXSPARSE_ZNAME (_pvec) (q.S()->pinv, buf, vec + idx, nc); |
|
|
325 #else |
|
5648
|
326 CXSPARSE_ZNAME (_pvec) (nc, q.S()->Pinv, buf, vec + idx); |
|
5792
|
327 #endif |
|
5610
|
328 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
329 } |
|
5797
|
330 info = 0; |
|
5610
|
331 } |
|
|
332 |
|
|
333 return x; |
|
|
334 #else |
|
|
335 return ComplexMatrix (); |
|
|
336 #endif |
|
|
337 } |
|
|
338 |
|
|
339 SparseComplexMatrix |
|
|
340 qrsolve(const SparseComplexMatrix&a, const SparseMatrix &b, octave_idx_type &info) |
|
|
341 { |
|
5797
|
342 info = -1; |
|
5610
|
343 #ifdef HAVE_CXSPARSE |
|
|
344 octave_idx_type nr = a.rows(); |
|
|
345 octave_idx_type nc = a.cols(); |
|
|
346 octave_idx_type b_nc = b.cols(); |
|
|
347 octave_idx_type b_nr = b.rows(); |
|
|
348 SparseComplexMatrix x; |
|
|
349 volatile octave_idx_type ii, x_nz; |
|
|
350 |
|
|
351 if (nr < 1 || nc < 1 || nr != b_nr) |
|
|
352 (*current_liboctave_error_handler) |
|
|
353 ("matrix dimension mismatch in solution of minimum norm problem"); |
|
|
354 else if (nr >= nc) |
|
|
355 { |
|
|
356 SparseComplexQR q (a, 2); |
|
|
357 if (! q.ok ()) |
|
5797
|
358 return SparseComplexMatrix(); |
|
5610
|
359 x = SparseComplexMatrix (nc, b_nc, b.nzmax()); |
|
|
360 x.xcidx(0) = 0; |
|
|
361 x_nz = b.nzmax(); |
|
|
362 ii = 0; |
|
|
363 OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); |
|
5648
|
364 OCTAVE_C99_COMPLEX (buf, q.S()->m2); |
|
5610
|
365 for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) |
|
|
366 { |
|
|
367 OCTAVE_QUIT; |
|
|
368 for (octave_idx_type j = 0; j < b_nr; j++) |
|
|
369 Xx[j] = b.xelem(j,i); |
|
5681
|
370 for (octave_idx_type j = nr; j < q.S()->m2; j++) |
|
|
371 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
372 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
373 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
374 CXSPARSE_ZNAME (_ipvec) |
|
|
375 (q.S()->pinv, reinterpret_cast<double _Complex *>(Xx), buf, nr); |
|
|
376 #else |
|
5648
|
377 CXSPARSE_ZNAME (_ipvec) |
|
5610
|
378 (nr, q.S()->Pinv, reinterpret_cast<double _Complex *>(Xx), buf); |
|
5792
|
379 #endif |
|
5610
|
380 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
381 for (volatile octave_idx_type j = 0; j < nc; j++) |
|
|
382 { |
|
|
383 OCTAVE_QUIT; |
|
|
384 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
385 CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); |
|
5610
|
386 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
387 } |
|
|
388 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
389 CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); |
|
5792
|
390 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
391 CXSPARSE_ZNAME (_ipvec) |
|
|
392 (q.S()->q, buf, reinterpret_cast<double _Complex *>(Xx), nc); |
|
|
393 #else |
|
|
394 CXSPARSE_ZNAME (_ipvec) |
|
|
395 (nc, q.S()->Q, buf, reinterpret_cast<double _Complex *>(Xx)); |
|
|
396 #endif |
|
5610
|
397 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
398 |
|
|
399 for (octave_idx_type j = 0; j < nc; j++) |
|
|
400 { |
|
|
401 Complex tmp = Xx[j]; |
|
|
402 if (tmp != 0.0) |
|
|
403 { |
|
|
404 if (ii == x_nz) |
|
|
405 { |
|
|
406 // Resize the sparse matrix |
|
|
407 octave_idx_type sz = x_nz * (b_nc - i) / b_nc; |
|
|
408 sz = (sz > 10 ? sz : 10) + x_nz; |
|
|
409 x.change_capacity (sz); |
|
|
410 x_nz = sz; |
|
|
411 } |
|
|
412 x.xdata(ii) = tmp; |
|
|
413 x.xridx(ii++) = j; |
|
|
414 } |
|
|
415 } |
|
|
416 x.xcidx(i+1) = ii; |
|
|
417 } |
|
5797
|
418 info = 0; |
|
5610
|
419 } |
|
|
420 else |
|
|
421 { |
|
|
422 SparseComplexMatrix at = a.hermitian(); |
|
|
423 SparseComplexQR q (at, 2); |
|
|
424 if (! q.ok ()) |
|
5797
|
425 return SparseComplexMatrix(); |
|
5610
|
426 x = SparseComplexMatrix (nc, b_nc, b.nzmax()); |
|
|
427 x.xcidx(0) = 0; |
|
|
428 x_nz = b.nzmax(); |
|
|
429 ii = 0; |
|
5681
|
430 volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); |
|
5610
|
431 OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); |
|
5681
|
432 OCTAVE_C99_COMPLEX (buf, nbuf); |
|
5610
|
433 OCTAVE_LOCAL_BUFFER (Complex, B, nr); |
|
|
434 for (octave_idx_type i = 0; i < nr; i++) |
|
|
435 B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); |
|
|
436 for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) |
|
|
437 { |
|
|
438 OCTAVE_QUIT; |
|
|
439 for (octave_idx_type j = 0; j < b_nr; j++) |
|
|
440 Xx[j] = b.xelem(j,i); |
|
5681
|
441 for (octave_idx_type j = nr; j < nbuf; j++) |
|
|
442 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
443 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
444 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
445 CXSPARSE_ZNAME (_pvec) |
|
|
446 (q.S()->q, reinterpret_cast<double _Complex *>(Xx), buf, nr); |
|
|
447 #else |
|
5648
|
448 CXSPARSE_ZNAME (_pvec) |
|
5610
|
449 (nr, q.S()->Q, reinterpret_cast<double _Complex *>(Xx), buf); |
|
5792
|
450 #endif |
|
5648
|
451 CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); |
|
5610
|
452 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
453 for (volatile octave_idx_type j = nr-1; j >= 0; j--) |
|
|
454 { |
|
|
455 OCTAVE_QUIT; |
|
|
456 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
457 CXSPARSE_ZNAME (_happly) |
|
5610
|
458 (q.N()->L, j, reinterpret_cast<double _Complex *>(B)[j], buf); |
|
|
459 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
460 } |
|
|
461 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
462 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
463 CXSPARSE_ZNAME (_pvec) |
|
|
464 (q.S()->pinv, buf, reinterpret_cast<double _Complex *>(Xx), nc); |
|
|
465 #else |
|
|
466 CXSPARSE_ZNAME (_pvec) |
|
|
467 (nc, q.S()->Pinv, buf, reinterpret_cast<double _Complex *>(Xx)); |
|
|
468 #endif |
|
5610
|
469 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
470 |
|
|
471 for (octave_idx_type j = 0; j < nc; j++) |
|
|
472 { |
|
|
473 Complex tmp = Xx[j]; |
|
|
474 if (tmp != 0.0) |
|
|
475 { |
|
|
476 if (ii == x_nz) |
|
|
477 { |
|
|
478 // Resize the sparse matrix |
|
|
479 octave_idx_type sz = x_nz * (b_nc - i) / b_nc; |
|
|
480 sz = (sz > 10 ? sz : 10) + x_nz; |
|
|
481 x.change_capacity (sz); |
|
|
482 x_nz = sz; |
|
|
483 } |
|
|
484 x.xdata(ii) = tmp; |
|
|
485 x.xridx(ii++) = j; |
|
|
486 } |
|
|
487 } |
|
|
488 x.xcidx(i+1) = ii; |
|
|
489 } |
|
5797
|
490 info = 0; |
|
5610
|
491 } |
|
|
492 |
|
|
493 x.maybe_compress (); |
|
|
494 return x; |
|
|
495 #else |
|
|
496 return SparseComplexMatrix (); |
|
|
497 #endif |
|
|
498 } |
|
|
499 |
|
|
500 ComplexMatrix |
|
|
501 qrsolve(const SparseComplexMatrix&a, const ComplexMatrix &b, octave_idx_type &info) |
|
|
502 { |
|
5797
|
503 info = -1; |
|
5610
|
504 #ifdef HAVE_CXSPARSE |
|
|
505 octave_idx_type nr = a.rows(); |
|
|
506 octave_idx_type nc = a.cols(); |
|
|
507 octave_idx_type b_nc = b.cols(); |
|
|
508 octave_idx_type b_nr = b.rows(); |
|
|
509 const double _Complex *bvec = |
|
|
510 reinterpret_cast<const double _Complex *>(b.fortran_vec()); |
|
|
511 ComplexMatrix x; |
|
|
512 |
|
|
513 if (nr < 1 || nc < 1 || nr != b_nr) |
|
|
514 (*current_liboctave_error_handler) |
|
|
515 ("matrix dimension mismatch in solution of minimum norm problem"); |
|
|
516 else if (nr >= nc) |
|
|
517 { |
|
|
518 SparseComplexQR q (a, 2); |
|
|
519 if (! q.ok ()) |
|
5797
|
520 return ComplexMatrix(); |
|
5610
|
521 x.resize(nc, b_nc); |
|
|
522 double _Complex *vec = reinterpret_cast<double _Complex *> |
|
|
523 (x.fortran_vec()); |
|
5648
|
524 OCTAVE_C99_COMPLEX (buf, q.S()->m2); |
|
5610
|
525 for (volatile octave_idx_type i = 0, idx = 0, bidx = 0; i < b_nc; |
|
|
526 i++, idx+=nc, bidx+=b_nr) |
|
|
527 { |
|
|
528 OCTAVE_QUIT; |
|
5681
|
529 for (octave_idx_type j = nr; j < q.S()->m2; j++) |
|
|
530 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
531 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
532 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
533 CXSPARSE_ZNAME (_ipvec) (q.S()->pinv, bvec + bidx, buf, nr); |
|
|
534 #else |
|
5648
|
535 CXSPARSE_ZNAME (_ipvec) (nr, q.S()->Pinv, bvec + bidx, buf); |
|
5792
|
536 #endif |
|
5610
|
537 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
538 for (volatile octave_idx_type j = 0; j < nc; j++) |
|
|
539 { |
|
|
540 OCTAVE_QUIT; |
|
|
541 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
542 CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); |
|
5610
|
543 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
544 } |
|
|
545 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
546 CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); |
|
5792
|
547 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
548 CXSPARSE_ZNAME (_ipvec) (q.S()->q, buf, vec + idx, nc); |
|
|
549 #else |
|
5648
|
550 CXSPARSE_ZNAME (_ipvec) (nc, q.S()->Q, buf, vec + idx); |
|
5792
|
551 #endif |
|
5610
|
552 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
553 } |
|
5797
|
554 info = 0; |
|
5610
|
555 } |
|
|
556 else |
|
|
557 { |
|
|
558 SparseComplexMatrix at = a.hermitian(); |
|
|
559 SparseComplexQR q (at, 2); |
|
|
560 if (! q.ok ()) |
|
5797
|
561 return ComplexMatrix(); |
|
5610
|
562 x.resize(nc, b_nc); |
|
|
563 double _Complex *vec = reinterpret_cast<double _Complex *> |
|
|
564 (x.fortran_vec()); |
|
5681
|
565 volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); |
|
|
566 OCTAVE_C99_COMPLEX (buf, nbuf); |
|
5610
|
567 OCTAVE_LOCAL_BUFFER (Complex, B, nr); |
|
|
568 for (octave_idx_type i = 0; i < nr; i++) |
|
|
569 B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); |
|
|
570 for (volatile octave_idx_type i = 0, idx = 0, bidx = 0; i < b_nc; |
|
|
571 i++, idx+=nc, bidx+=b_nr) |
|
|
572 { |
|
|
573 OCTAVE_QUIT; |
|
5681
|
574 for (octave_idx_type j = nr; j < nbuf; j++) |
|
|
575 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
576 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
577 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
578 CXSPARSE_ZNAME (_pvec) (q.S()->q, bvec + bidx, buf, nr); |
|
|
579 #else |
|
5648
|
580 CXSPARSE_ZNAME (_pvec) (nr, q.S()->Q, bvec + bidx, buf); |
|
5792
|
581 #endif |
|
5648
|
582 CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); |
|
5610
|
583 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
584 for (volatile octave_idx_type j = nr-1; j >= 0; j--) |
|
|
585 { |
|
|
586 OCTAVE_QUIT; |
|
|
587 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
588 CXSPARSE_ZNAME (_happly) |
|
5610
|
589 (q.N()->L, j, reinterpret_cast<double _Complex *>(B)[j], buf); |
|
|
590 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
591 } |
|
|
592 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
593 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
594 CXSPARSE_ZNAME (_pvec) (q.S()->pinv, buf, vec + idx, nc); |
|
|
595 #else |
|
5648
|
596 CXSPARSE_ZNAME (_pvec) (nc, q.S()->Pinv, buf, vec + idx); |
|
5792
|
597 #endif |
|
5610
|
598 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
599 } |
|
5797
|
600 info = 0; |
|
5610
|
601 } |
|
|
602 |
|
|
603 return x; |
|
|
604 #else |
|
|
605 return ComplexMatrix (); |
|
|
606 #endif |
|
|
607 } |
|
|
608 |
|
|
609 SparseComplexMatrix |
|
|
610 qrsolve(const SparseComplexMatrix&a, const SparseComplexMatrix &b, octave_idx_type &info) |
|
|
611 { |
|
5797
|
612 info = -1; |
|
5610
|
613 #ifdef HAVE_CXSPARSE |
|
|
614 octave_idx_type nr = a.rows(); |
|
|
615 octave_idx_type nc = a.cols(); |
|
|
616 octave_idx_type b_nc = b.cols(); |
|
|
617 octave_idx_type b_nr = b.rows(); |
|
|
618 SparseComplexMatrix x; |
|
|
619 volatile octave_idx_type ii, x_nz; |
|
|
620 |
|
|
621 if (nr < 1 || nc < 1 || nr != b_nr) |
|
|
622 (*current_liboctave_error_handler) |
|
|
623 ("matrix dimension mismatch in solution of minimum norm problem"); |
|
|
624 else if (nr >= nc) |
|
|
625 { |
|
|
626 SparseComplexQR q (a, 2); |
|
|
627 if (! q.ok ()) |
|
5797
|
628 return SparseComplexMatrix(); |
|
5610
|
629 x = SparseComplexMatrix (nc, b_nc, b.nzmax()); |
|
|
630 x.xcidx(0) = 0; |
|
|
631 x_nz = b.nzmax(); |
|
|
632 ii = 0; |
|
|
633 OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); |
|
5648
|
634 OCTAVE_C99_COMPLEX (buf, q.S()->m2); |
|
5610
|
635 for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) |
|
|
636 { |
|
|
637 OCTAVE_QUIT; |
|
|
638 for (octave_idx_type j = 0; j < b_nr; j++) |
|
|
639 Xx[j] = b.xelem(j,i); |
|
5681
|
640 for (octave_idx_type j = nr; j < q.S()->m2; j++) |
|
|
641 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
642 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
643 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
644 CXSPARSE_ZNAME (_ipvec) |
|
|
645 (q.S()->pinv, reinterpret_cast<double _Complex *>(Xx), buf, nr); |
|
|
646 #else |
|
5648
|
647 CXSPARSE_ZNAME (_ipvec) |
|
5610
|
648 (nr, q.S()->Pinv, reinterpret_cast<double _Complex *>(Xx), buf); |
|
5792
|
649 #endif |
|
5610
|
650 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
651 for (volatile octave_idx_type j = 0; j < nc; j++) |
|
|
652 { |
|
|
653 OCTAVE_QUIT; |
|
|
654 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
655 CXSPARSE_ZNAME (_happly) (q.N()->L, j, q.N()->B[j], buf); |
|
5610
|
656 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
657 } |
|
|
658 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
659 CXSPARSE_ZNAME (_usolve) (q.N()->U, buf); |
|
5792
|
660 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
661 CXSPARSE_ZNAME (_ipvec) |
|
|
662 (q.S()->q, buf, reinterpret_cast<double _Complex *>(Xx), nc); |
|
|
663 #else |
|
|
664 CXSPARSE_ZNAME (_ipvec) |
|
|
665 (nc, q.S()->Q, buf, reinterpret_cast<double _Complex *>(Xx)); |
|
|
666 #endif |
|
5610
|
667 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
668 |
|
|
669 for (octave_idx_type j = 0; j < nc; j++) |
|
|
670 { |
|
|
671 Complex tmp = Xx[j]; |
|
|
672 if (tmp != 0.0) |
|
|
673 { |
|
|
674 if (ii == x_nz) |
|
|
675 { |
|
|
676 // Resize the sparse matrix |
|
|
677 octave_idx_type sz = x_nz * (b_nc - i) / b_nc; |
|
|
678 sz = (sz > 10 ? sz : 10) + x_nz; |
|
|
679 x.change_capacity (sz); |
|
|
680 x_nz = sz; |
|
|
681 } |
|
|
682 x.xdata(ii) = tmp; |
|
|
683 x.xridx(ii++) = j; |
|
|
684 } |
|
|
685 } |
|
|
686 x.xcidx(i+1) = ii; |
|
|
687 } |
|
5797
|
688 info = 0; |
|
5610
|
689 } |
|
|
690 else |
|
|
691 { |
|
|
692 SparseComplexMatrix at = a.hermitian(); |
|
|
693 SparseComplexQR q (at, 2); |
|
|
694 if (! q.ok ()) |
|
5797
|
695 return SparseComplexMatrix(); |
|
5610
|
696 x = SparseComplexMatrix (nc, b_nc, b.nzmax()); |
|
|
697 x.xcidx(0) = 0; |
|
|
698 x_nz = b.nzmax(); |
|
|
699 ii = 0; |
|
5681
|
700 volatile octave_idx_type nbuf = (nc > q.S()->m2 ? nc : q.S()->m2); |
|
5610
|
701 OCTAVE_LOCAL_BUFFER (Complex, Xx, (b_nr > nc ? b_nr : nc)); |
|
5681
|
702 OCTAVE_C99_COMPLEX (buf, nbuf); |
|
5610
|
703 OCTAVE_LOCAL_BUFFER (Complex, B, nr); |
|
|
704 for (octave_idx_type i = 0; i < nr; i++) |
|
|
705 B[i] = conj (reinterpret_cast<Complex *>(q.N()->B) [i]); |
|
|
706 for (volatile octave_idx_type i = 0, idx = 0; i < b_nc; i++, idx+=nc) |
|
|
707 { |
|
|
708 OCTAVE_QUIT; |
|
|
709 for (octave_idx_type j = 0; j < b_nr; j++) |
|
|
710 Xx[j] = b.xelem(j,i); |
|
5681
|
711 for (octave_idx_type j = nr; j < nbuf; j++) |
|
|
712 buf[j] = OCTAVE_C99_ZERO; |
|
5610
|
713 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
714 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
715 CXSPARSE_ZNAME (_pvec) |
|
|
716 (q.S()->q, reinterpret_cast<double _Complex *>(Xx), buf, nr); |
|
|
717 #else |
|
5648
|
718 CXSPARSE_ZNAME (_pvec) |
|
5610
|
719 (nr, q.S()->Q, reinterpret_cast<double _Complex *>(Xx), buf); |
|
5792
|
720 #endif |
|
5648
|
721 CXSPARSE_ZNAME (_utsolve) (q.N()->U, buf); |
|
5610
|
722 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
723 for (volatile octave_idx_type j = nr-1; j >= 0; j--) |
|
|
724 { |
|
|
725 OCTAVE_QUIT; |
|
|
726 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5648
|
727 CXSPARSE_ZNAME (_happly) |
|
5610
|
728 (q.N()->L, j, reinterpret_cast<double _Complex *>(B)[j], buf); |
|
|
729 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
730 } |
|
|
731 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
5792
|
732 #if defined(CS_VER) && (CS_VER >= 2) |
|
|
733 CXSPARSE_ZNAME (_pvec) |
|
|
734 (q.S()->pinv, buf, reinterpret_cast<double _Complex *>(Xx), nc); |
|
|
735 #else |
|
|
736 CXSPARSE_ZNAME (_pvec) |
|
|
737 (nc, q.S()->Pinv, buf, reinterpret_cast<double _Complex *>(Xx)); |
|
|
738 #endif |
|
5610
|
739 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
|
740 |
|
|
741 for (octave_idx_type j = 0; j < nc; j++) |
|
|
742 { |
|
|
743 Complex tmp = Xx[j]; |
|
|
744 if (tmp != 0.0) |
|
|
745 { |
|
|
746 if (ii == x_nz) |
|
|
747 { |
|
|
748 // Resize the sparse matrix |
|
|
749 octave_idx_type sz = x_nz * (b_nc - i) / b_nc; |
|
|
750 sz = (sz > 10 ? sz : 10) + x_nz; |
|
|
751 x.change_capacity (sz); |
|
|
752 x_nz = sz; |
|
|
753 } |
|
|
754 x.xdata(ii) = tmp; |
|
|
755 x.xridx(ii++) = j; |
|
|
756 } |
|
|
757 } |
|
|
758 x.xcidx(i+1) = ii; |
|
|
759 } |
|
5797
|
760 info = 0; |
|
5610
|
761 } |
|
|
762 |
|
|
763 x.maybe_compress (); |
|
|
764 return x; |
|
|
765 #else |
|
|
766 return SparseComplexMatrix (); |
|
|
767 #endif |
|
|
768 } |
|
|
769 |
|
|
770 /* |
|
|
771 ;;; Local Variables: *** |
|
|
772 ;;; mode: C++ *** |
|
|
773 ;;; End: *** |
|
|
774 */ |
