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