Mercurial > hg > octave-lyh
comparison liboctave/fMatrix.cc @ 7789:82be108cc558
First attempt at single precision tyeps
* * *
corrections to qrupdate single precision routines
* * *
prefer demotion to single over promotion to double
* * *
Add single precision support to log2 function
* * *
Trivial PROJECT file update
* * *
Cache optimized hermitian/transpose methods
* * *
Add tests for tranpose/hermitian and ChangeLog entry for new transpose code
author | David Bateman <dbateman@free.fr> |
---|---|
date | Sun, 27 Apr 2008 22:34:17 +0200 |
parents | |
children | f42c6f8d6d8e |
comparison
equal
deleted
inserted
replaced
7788:45f5faba05a2 | 7789:82be108cc558 |
---|---|
1 // Matrix manipulations. | |
2 /* | |
3 | |
4 Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, | |
5 2003, 2004, 2005, 2006, 2007 John W. Eaton | |
6 | |
7 This file is part of Octave. | |
8 | |
9 Octave is free software; you can redistribute it and/or modify it | |
10 under the terms of the GNU General Public License as published by the | |
11 Free Software Foundation; either version 3 of the License, or (at your | |
12 option) any later version. | |
13 | |
14 Octave is distributed in the hope that it will be useful, but WITHOUT | |
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
17 for more details. | |
18 | |
19 You should have received a copy of the GNU General Public License | |
20 along with Octave; see the file COPYING. If not, see | |
21 <http://www.gnu.org/licenses/>. | |
22 | |
23 */ | |
24 | |
25 #ifdef HAVE_CONFIG_H | |
26 #include <config.h> | |
27 #endif | |
28 | |
29 #include <cfloat> | |
30 | |
31 #include <iostream> | |
32 #include <vector> | |
33 | |
34 #include "Array-util.h" | |
35 #include "byte-swap.h" | |
36 #include "fMatrix.h" | |
37 #include "floatDET.h" | |
38 #include "floatSCHUR.h" | |
39 #include "floatSVD.h" | |
40 #include "floatCHOL.h" | |
41 #include "f77-fcn.h" | |
42 #include "functor.h" | |
43 #include "lo-error.h" | |
44 #include "lo-ieee.h" | |
45 #include "lo-mappers.h" | |
46 #include "lo-utils.h" | |
47 #include "mx-base.h" | |
48 #include "mx-fm-fdm.h" | |
49 #include "mx-fdm-fm.h" | |
50 #include "mx-inlines.cc" | |
51 #include "oct-cmplx.h" | |
52 #include "quit.h" | |
53 | |
54 #if defined (HAVE_FFTW3) | |
55 #include "oct-fftw.h" | |
56 #endif | |
57 | |
58 // Fortran functions we call. | |
59 | |
60 extern "C" | |
61 { | |
62 F77_RET_T | |
63 F77_FUNC (xilaenv, XILAENV) (const octave_idx_type&, F77_CONST_CHAR_ARG_DECL, | |
64 F77_CONST_CHAR_ARG_DECL, | |
65 const octave_idx_type&, const octave_idx_type&, | |
66 const octave_idx_type&, const octave_idx_type&, | |
67 octave_idx_type& | |
68 F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL); | |
69 | |
70 F77_RET_T | |
71 F77_FUNC (sgebal, SGEBAL) (F77_CONST_CHAR_ARG_DECL, | |
72 const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type&, | |
73 octave_idx_type&, float*, octave_idx_type& | |
74 F77_CHAR_ARG_LEN_DECL); | |
75 | |
76 F77_RET_T | |
77 F77_FUNC (sgebak, SGEBAK) (F77_CONST_CHAR_ARG_DECL, | |
78 F77_CONST_CHAR_ARG_DECL, | |
79 const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, float*, | |
80 const octave_idx_type&, float*, const octave_idx_type&, octave_idx_type& | |
81 F77_CHAR_ARG_LEN_DECL | |
82 F77_CHAR_ARG_LEN_DECL); | |
83 | |
84 | |
85 F77_RET_T | |
86 F77_FUNC (sgemm, SGEMM) (F77_CONST_CHAR_ARG_DECL, | |
87 F77_CONST_CHAR_ARG_DECL, | |
88 const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, | |
89 const float&, const float*, const octave_idx_type&, | |
90 const float*, const octave_idx_type&, const float&, | |
91 float*, const octave_idx_type& | |
92 F77_CHAR_ARG_LEN_DECL | |
93 F77_CHAR_ARG_LEN_DECL); | |
94 | |
95 F77_RET_T | |
96 F77_FUNC (sgemv, SGEMV) (F77_CONST_CHAR_ARG_DECL, | |
97 const octave_idx_type&, const octave_idx_type&, const float&, | |
98 const float*, const octave_idx_type&, const float*, | |
99 const octave_idx_type&, const float&, float*, | |
100 const octave_idx_type& | |
101 F77_CHAR_ARG_LEN_DECL); | |
102 | |
103 F77_RET_T | |
104 F77_FUNC (xsdot, XSDOT) (const octave_idx_type&, const float*, const octave_idx_type&, | |
105 const float*, const octave_idx_type&, float&); | |
106 | |
107 F77_RET_T | |
108 F77_FUNC (sgetrf, SGETRF) (const octave_idx_type&, const octave_idx_type&, float*, const octave_idx_type&, | |
109 octave_idx_type*, octave_idx_type&); | |
110 | |
111 F77_RET_T | |
112 F77_FUNC (sgetrs, SGETRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, const octave_idx_type&, | |
113 const float*, const octave_idx_type&, | |
114 const octave_idx_type*, float*, const octave_idx_type&, octave_idx_type& | |
115 F77_CHAR_ARG_LEN_DECL); | |
116 | |
117 F77_RET_T | |
118 F77_FUNC (sgetri, SGETRI) (const octave_idx_type&, float*, const octave_idx_type&, const octave_idx_type*, | |
119 float*, const octave_idx_type&, octave_idx_type&); | |
120 | |
121 F77_RET_T | |
122 F77_FUNC (sgecon, SGECON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, float*, | |
123 const octave_idx_type&, const float&, float&, | |
124 float*, octave_idx_type*, octave_idx_type& | |
125 F77_CHAR_ARG_LEN_DECL); | |
126 | |
127 F77_RET_T | |
128 F77_FUNC (sgelsy, SGELSY) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, | |
129 float*, const octave_idx_type&, float*, | |
130 const octave_idx_type&, octave_idx_type*, float&, octave_idx_type&, | |
131 float*, const octave_idx_type&, octave_idx_type&); | |
132 | |
133 F77_RET_T | |
134 F77_FUNC (sgelsd, SGELSD) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, | |
135 float*, const octave_idx_type&, float*, | |
136 const octave_idx_type&, float*, float&, octave_idx_type&, | |
137 float*, const octave_idx_type&, octave_idx_type*, | |
138 octave_idx_type&); | |
139 | |
140 F77_RET_T | |
141 F77_FUNC (spotrf, SPOTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, | |
142 float *, const octave_idx_type&, | |
143 octave_idx_type& F77_CHAR_ARG_LEN_DECL); | |
144 | |
145 F77_RET_T | |
146 F77_FUNC (spocon, SPOCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, | |
147 float*, const octave_idx_type&, const float&, | |
148 float&, float*, octave_idx_type*, | |
149 octave_idx_type& F77_CHAR_ARG_LEN_DECL); | |
150 F77_RET_T | |
151 F77_FUNC (spotrs, SPOTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, | |
152 const octave_idx_type&, const float*, | |
153 const octave_idx_type&, float*, | |
154 const octave_idx_type&, octave_idx_type& | |
155 F77_CHAR_ARG_LEN_DECL); | |
156 | |
157 F77_RET_T | |
158 F77_FUNC (strtri, STRTRI) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, | |
159 const octave_idx_type&, const float*, | |
160 const octave_idx_type&, octave_idx_type& | |
161 F77_CHAR_ARG_LEN_DECL | |
162 F77_CHAR_ARG_LEN_DECL); | |
163 F77_RET_T | |
164 F77_FUNC (strcon, STRCON) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, | |
165 F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, | |
166 const float*, const octave_idx_type&, float&, | |
167 float*, octave_idx_type*, octave_idx_type& | |
168 F77_CHAR_ARG_LEN_DECL | |
169 F77_CHAR_ARG_LEN_DECL | |
170 F77_CHAR_ARG_LEN_DECL); | |
171 F77_RET_T | |
172 F77_FUNC (strtrs, STRTRS) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, | |
173 F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, | |
174 const octave_idx_type&, const float*, | |
175 const octave_idx_type&, float*, | |
176 const octave_idx_type&, octave_idx_type& | |
177 F77_CHAR_ARG_LEN_DECL | |
178 F77_CHAR_ARG_LEN_DECL | |
179 F77_CHAR_ARG_LEN_DECL); | |
180 | |
181 // Note that the original complex fft routines were not written for | |
182 // float complex arguments. They have been modified by adding an | |
183 // implicit float precision (a-h,o-z) statement at the beginning of | |
184 // each subroutine. | |
185 | |
186 F77_RET_T | |
187 F77_FUNC (cffti, CFFTI) (const octave_idx_type&, FloatComplex*); | |
188 | |
189 F77_RET_T | |
190 F77_FUNC (cfftf, CFFTF) (const octave_idx_type&, FloatComplex*, FloatComplex*); | |
191 | |
192 F77_RET_T | |
193 F77_FUNC (cfftb, CFFTB) (const octave_idx_type&, FloatComplex*, FloatComplex*); | |
194 | |
195 F77_RET_T | |
196 F77_FUNC (slartg, SLARTG) (const float&, const float&, float&, | |
197 float&, float&); | |
198 | |
199 F77_RET_T | |
200 F77_FUNC (strsyl, STRSYL) (F77_CONST_CHAR_ARG_DECL, | |
201 F77_CONST_CHAR_ARG_DECL, | |
202 const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, | |
203 const float*, const octave_idx_type&, const float*, | |
204 const octave_idx_type&, const float*, const octave_idx_type&, | |
205 float&, octave_idx_type& | |
206 F77_CHAR_ARG_LEN_DECL | |
207 F77_CHAR_ARG_LEN_DECL); | |
208 | |
209 F77_RET_T | |
210 F77_FUNC (xslange, XSLANGE) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, | |
211 const octave_idx_type&, const float*, | |
212 const octave_idx_type&, float*, float& | |
213 F77_CHAR_ARG_LEN_DECL); | |
214 } | |
215 | |
216 // Matrix class. | |
217 | |
218 FloatMatrix::FloatMatrix (const FloatRowVector& rv) | |
219 : MArray2<float> (1, rv.length (), 0.0) | |
220 { | |
221 for (octave_idx_type i = 0; i < rv.length (); i++) | |
222 elem (0, i) = rv.elem (i); | |
223 } | |
224 | |
225 FloatMatrix::FloatMatrix (const FloatColumnVector& cv) | |
226 : MArray2<float> (cv.length (), 1, 0.0) | |
227 { | |
228 for (octave_idx_type i = 0; i < cv.length (); i++) | |
229 elem (i, 0) = cv.elem (i); | |
230 } | |
231 | |
232 FloatMatrix::FloatMatrix (const FloatDiagMatrix& a) | |
233 : MArray2<float> (a.rows (), a.cols (), 0.0) | |
234 { | |
235 for (octave_idx_type i = 0; i < a.length (); i++) | |
236 elem (i, i) = a.elem (i, i); | |
237 } | |
238 | |
239 // FIXME -- could we use a templated mixed-type copy function | |
240 // here? | |
241 | |
242 FloatMatrix::FloatMatrix (const boolMatrix& a) | |
243 : MArray2<float> (a.rows (), a.cols ()) | |
244 { | |
245 for (octave_idx_type i = 0; i < a.rows (); i++) | |
246 for (octave_idx_type j = 0; j < a.cols (); j++) | |
247 elem (i, j) = a.elem (i, j); | |
248 } | |
249 | |
250 FloatMatrix::FloatMatrix (const charMatrix& a) | |
251 : MArray2<float> (a.rows (), a.cols ()) | |
252 { | |
253 for (octave_idx_type i = 0; i < a.rows (); i++) | |
254 for (octave_idx_type j = 0; j < a.cols (); j++) | |
255 elem (i, j) = a.elem (i, j); | |
256 } | |
257 | |
258 bool | |
259 FloatMatrix::operator == (const FloatMatrix& a) const | |
260 { | |
261 if (rows () != a.rows () || cols () != a.cols ()) | |
262 return false; | |
263 | |
264 return mx_inline_equal (data (), a.data (), length ()); | |
265 } | |
266 | |
267 bool | |
268 FloatMatrix::operator != (const FloatMatrix& a) const | |
269 { | |
270 return !(*this == a); | |
271 } | |
272 | |
273 bool | |
274 FloatMatrix::is_symmetric (void) const | |
275 { | |
276 if (is_square () && rows () > 0) | |
277 { | |
278 for (octave_idx_type i = 0; i < rows (); i++) | |
279 for (octave_idx_type j = i+1; j < cols (); j++) | |
280 if (elem (i, j) != elem (j, i)) | |
281 return false; | |
282 | |
283 return true; | |
284 } | |
285 | |
286 return false; | |
287 } | |
288 | |
289 FloatMatrix& | |
290 FloatMatrix::insert (const FloatMatrix& a, octave_idx_type r, octave_idx_type c) | |
291 { | |
292 Array2<float>::insert (a, r, c); | |
293 return *this; | |
294 } | |
295 | |
296 FloatMatrix& | |
297 FloatMatrix::insert (const FloatRowVector& a, octave_idx_type r, octave_idx_type c) | |
298 { | |
299 octave_idx_type a_len = a.length (); | |
300 | |
301 if (r < 0 || r >= rows () || c < 0 || c + a_len > cols ()) | |
302 { | |
303 (*current_liboctave_error_handler) ("range error for insert"); | |
304 return *this; | |
305 } | |
306 | |
307 if (a_len > 0) | |
308 { | |
309 make_unique (); | |
310 | |
311 for (octave_idx_type i = 0; i < a_len; i++) | |
312 xelem (r, c+i) = a.elem (i); | |
313 } | |
314 | |
315 return *this; | |
316 } | |
317 | |
318 FloatMatrix& | |
319 FloatMatrix::insert (const FloatColumnVector& a, octave_idx_type r, octave_idx_type c) | |
320 { | |
321 octave_idx_type a_len = a.length (); | |
322 | |
323 if (r < 0 || r + a_len > rows () || c < 0 || c >= cols ()) | |
324 { | |
325 (*current_liboctave_error_handler) ("range error for insert"); | |
326 return *this; | |
327 } | |
328 | |
329 if (a_len > 0) | |
330 { | |
331 make_unique (); | |
332 | |
333 for (octave_idx_type i = 0; i < a_len; i++) | |
334 xelem (r+i, c) = a.elem (i); | |
335 } | |
336 | |
337 return *this; | |
338 } | |
339 | |
340 FloatMatrix& | |
341 FloatMatrix::insert (const FloatDiagMatrix& a, octave_idx_type r, octave_idx_type c) | |
342 { | |
343 octave_idx_type a_nr = a.rows (); | |
344 octave_idx_type a_nc = a.cols (); | |
345 | |
346 if (r < 0 || r + a_nr > rows () || c < 0 || c + a_nc > cols ()) | |
347 { | |
348 (*current_liboctave_error_handler) ("range error for insert"); | |
349 return *this; | |
350 } | |
351 | |
352 fill (0.0, r, c, r + a_nr - 1, c + a_nc - 1); | |
353 | |
354 octave_idx_type a_len = a.length (); | |
355 | |
356 if (a_len > 0) | |
357 { | |
358 make_unique (); | |
359 | |
360 for (octave_idx_type i = 0; i < a_len; i++) | |
361 xelem (r+i, c+i) = a.elem (i, i); | |
362 } | |
363 | |
364 return *this; | |
365 } | |
366 | |
367 FloatMatrix& | |
368 FloatMatrix::fill (float val) | |
369 { | |
370 octave_idx_type nr = rows (); | |
371 octave_idx_type nc = cols (); | |
372 | |
373 if (nr > 0 && nc > 0) | |
374 { | |
375 make_unique (); | |
376 | |
377 for (octave_idx_type j = 0; j < nc; j++) | |
378 for (octave_idx_type i = 0; i < nr; i++) | |
379 xelem (i, j) = val; | |
380 } | |
381 | |
382 return *this; | |
383 } | |
384 | |
385 FloatMatrix& | |
386 FloatMatrix::fill (float val, octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2) | |
387 { | |
388 octave_idx_type nr = rows (); | |
389 octave_idx_type nc = cols (); | |
390 | |
391 if (r1 < 0 || r2 < 0 || c1 < 0 || c2 < 0 | |
392 || r1 >= nr || r2 >= nr || c1 >= nc || c2 >= nc) | |
393 { | |
394 (*current_liboctave_error_handler) ("range error for fill"); | |
395 return *this; | |
396 } | |
397 | |
398 if (r1 > r2) { octave_idx_type tmp = r1; r1 = r2; r2 = tmp; } | |
399 if (c1 > c2) { octave_idx_type tmp = c1; c1 = c2; c2 = tmp; } | |
400 | |
401 if (r2 >= r1 && c2 >= c1) | |
402 { | |
403 make_unique (); | |
404 | |
405 for (octave_idx_type j = c1; j <= c2; j++) | |
406 for (octave_idx_type i = r1; i <= r2; i++) | |
407 xelem (i, j) = val; | |
408 } | |
409 | |
410 return *this; | |
411 } | |
412 | |
413 FloatMatrix | |
414 FloatMatrix::append (const FloatMatrix& a) const | |
415 { | |
416 octave_idx_type nr = rows (); | |
417 octave_idx_type nc = cols (); | |
418 if (nr != a.rows ()) | |
419 { | |
420 (*current_liboctave_error_handler) ("row dimension mismatch for append"); | |
421 return FloatMatrix (); | |
422 } | |
423 | |
424 octave_idx_type nc_insert = nc; | |
425 FloatMatrix retval (nr, nc + a.cols ()); | |
426 retval.insert (*this, 0, 0); | |
427 retval.insert (a, 0, nc_insert); | |
428 return retval; | |
429 } | |
430 | |
431 FloatMatrix | |
432 FloatMatrix::append (const FloatRowVector& a) const | |
433 { | |
434 octave_idx_type nr = rows (); | |
435 octave_idx_type nc = cols (); | |
436 if (nr != 1) | |
437 { | |
438 (*current_liboctave_error_handler) ("row dimension mismatch for append"); | |
439 return FloatMatrix (); | |
440 } | |
441 | |
442 octave_idx_type nc_insert = nc; | |
443 FloatMatrix retval (nr, nc + a.length ()); | |
444 retval.insert (*this, 0, 0); | |
445 retval.insert (a, 0, nc_insert); | |
446 return retval; | |
447 } | |
448 | |
449 FloatMatrix | |
450 FloatMatrix::append (const FloatColumnVector& a) const | |
451 { | |
452 octave_idx_type nr = rows (); | |
453 octave_idx_type nc = cols (); | |
454 if (nr != a.length ()) | |
455 { | |
456 (*current_liboctave_error_handler) ("row dimension mismatch for append"); | |
457 return FloatMatrix (); | |
458 } | |
459 | |
460 octave_idx_type nc_insert = nc; | |
461 FloatMatrix retval (nr, nc + 1); | |
462 retval.insert (*this, 0, 0); | |
463 retval.insert (a, 0, nc_insert); | |
464 return retval; | |
465 } | |
466 | |
467 FloatMatrix | |
468 FloatMatrix::append (const FloatDiagMatrix& a) const | |
469 { | |
470 octave_idx_type nr = rows (); | |
471 octave_idx_type nc = cols (); | |
472 if (nr != a.rows ()) | |
473 { | |
474 (*current_liboctave_error_handler) ("row dimension mismatch for append"); | |
475 return *this; | |
476 } | |
477 | |
478 octave_idx_type nc_insert = nc; | |
479 FloatMatrix retval (nr, nc + a.cols ()); | |
480 retval.insert (*this, 0, 0); | |
481 retval.insert (a, 0, nc_insert); | |
482 return retval; | |
483 } | |
484 | |
485 FloatMatrix | |
486 FloatMatrix::stack (const FloatMatrix& a) const | |
487 { | |
488 octave_idx_type nr = rows (); | |
489 octave_idx_type nc = cols (); | |
490 if (nc != a.cols ()) | |
491 { | |
492 (*current_liboctave_error_handler) | |
493 ("column dimension mismatch for stack"); | |
494 return FloatMatrix (); | |
495 } | |
496 | |
497 octave_idx_type nr_insert = nr; | |
498 FloatMatrix retval (nr + a.rows (), nc); | |
499 retval.insert (*this, 0, 0); | |
500 retval.insert (a, nr_insert, 0); | |
501 return retval; | |
502 } | |
503 | |
504 FloatMatrix | |
505 FloatMatrix::stack (const FloatRowVector& a) const | |
506 { | |
507 octave_idx_type nr = rows (); | |
508 octave_idx_type nc = cols (); | |
509 if (nc != a.length ()) | |
510 { | |
511 (*current_liboctave_error_handler) | |
512 ("column dimension mismatch for stack"); | |
513 return FloatMatrix (); | |
514 } | |
515 | |
516 octave_idx_type nr_insert = nr; | |
517 FloatMatrix retval (nr + 1, nc); | |
518 retval.insert (*this, 0, 0); | |
519 retval.insert (a, nr_insert, 0); | |
520 return retval; | |
521 } | |
522 | |
523 FloatMatrix | |
524 FloatMatrix::stack (const FloatColumnVector& a) const | |
525 { | |
526 octave_idx_type nr = rows (); | |
527 octave_idx_type nc = cols (); | |
528 if (nc != 1) | |
529 { | |
530 (*current_liboctave_error_handler) | |
531 ("column dimension mismatch for stack"); | |
532 return FloatMatrix (); | |
533 } | |
534 | |
535 octave_idx_type nr_insert = nr; | |
536 FloatMatrix retval (nr + a.length (), nc); | |
537 retval.insert (*this, 0, 0); | |
538 retval.insert (a, nr_insert, 0); | |
539 return retval; | |
540 } | |
541 | |
542 FloatMatrix | |
543 FloatMatrix::stack (const FloatDiagMatrix& a) const | |
544 { | |
545 octave_idx_type nr = rows (); | |
546 octave_idx_type nc = cols (); | |
547 if (nc != a.cols ()) | |
548 { | |
549 (*current_liboctave_error_handler) | |
550 ("column dimension mismatch for stack"); | |
551 return FloatMatrix (); | |
552 } | |
553 | |
554 octave_idx_type nr_insert = nr; | |
555 FloatMatrix retval (nr + a.rows (), nc); | |
556 retval.insert (*this, 0, 0); | |
557 retval.insert (a, nr_insert, 0); | |
558 return retval; | |
559 } | |
560 | |
561 FloatMatrix | |
562 real (const FloatComplexMatrix& a) | |
563 { | |
564 octave_idx_type a_len = a.length (); | |
565 FloatMatrix retval; | |
566 if (a_len > 0) | |
567 retval = FloatMatrix (mx_inline_real_dup (a.data (), a_len), | |
568 a.rows (), a.cols ()); | |
569 return retval; | |
570 } | |
571 | |
572 FloatMatrix | |
573 imag (const FloatComplexMatrix& a) | |
574 { | |
575 octave_idx_type a_len = a.length (); | |
576 FloatMatrix retval; | |
577 if (a_len > 0) | |
578 retval = FloatMatrix (mx_inline_imag_dup (a.data (), a_len), | |
579 a.rows (), a.cols ()); | |
580 return retval; | |
581 } | |
582 | |
583 FloatMatrix | |
584 FloatMatrix::extract (octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2) const | |
585 { | |
586 if (r1 > r2) { octave_idx_type tmp = r1; r1 = r2; r2 = tmp; } | |
587 if (c1 > c2) { octave_idx_type tmp = c1; c1 = c2; c2 = tmp; } | |
588 | |
589 octave_idx_type new_r = r2 - r1 + 1; | |
590 octave_idx_type new_c = c2 - c1 + 1; | |
591 | |
592 FloatMatrix result (new_r, new_c); | |
593 | |
594 for (octave_idx_type j = 0; j < new_c; j++) | |
595 for (octave_idx_type i = 0; i < new_r; i++) | |
596 result.xelem (i, j) = elem (r1+i, c1+j); | |
597 | |
598 return result; | |
599 } | |
600 | |
601 FloatMatrix | |
602 FloatMatrix::extract_n (octave_idx_type r1, octave_idx_type c1, octave_idx_type nr, octave_idx_type nc) const | |
603 { | |
604 FloatMatrix result (nr, nc); | |
605 | |
606 for (octave_idx_type j = 0; j < nc; j++) | |
607 for (octave_idx_type i = 0; i < nr; i++) | |
608 result.xelem (i, j) = elem (r1+i, c1+j); | |
609 | |
610 return result; | |
611 } | |
612 | |
613 // extract row or column i. | |
614 | |
615 FloatRowVector | |
616 FloatMatrix::row (octave_idx_type i) const | |
617 { | |
618 octave_idx_type nc = cols (); | |
619 if (i < 0 || i >= rows ()) | |
620 { | |
621 (*current_liboctave_error_handler) ("invalid row selection"); | |
622 return FloatRowVector (); | |
623 } | |
624 | |
625 FloatRowVector retval (nc); | |
626 for (octave_idx_type j = 0; j < nc; j++) | |
627 retval.xelem (j) = elem (i, j); | |
628 | |
629 return retval; | |
630 } | |
631 | |
632 FloatColumnVector | |
633 FloatMatrix::column (octave_idx_type i) const | |
634 { | |
635 octave_idx_type nr = rows (); | |
636 if (i < 0 || i >= cols ()) | |
637 { | |
638 (*current_liboctave_error_handler) ("invalid column selection"); | |
639 return FloatColumnVector (); | |
640 } | |
641 | |
642 FloatColumnVector retval (nr); | |
643 for (octave_idx_type j = 0; j < nr; j++) | |
644 retval.xelem (j) = elem (j, i); | |
645 | |
646 return retval; | |
647 } | |
648 | |
649 FloatMatrix | |
650 FloatMatrix::inverse (void) const | |
651 { | |
652 octave_idx_type info; | |
653 float rcond; | |
654 MatrixType mattype (*this); | |
655 return inverse (mattype, info, rcond, 0, 0); | |
656 } | |
657 | |
658 FloatMatrix | |
659 FloatMatrix::inverse (octave_idx_type& info) const | |
660 { | |
661 float rcond; | |
662 MatrixType mattype (*this); | |
663 return inverse (mattype, info, rcond, 0, 0); | |
664 } | |
665 | |
666 FloatMatrix | |
667 FloatMatrix::inverse (octave_idx_type& info, float& rcond, int force, | |
668 int calc_cond) const | |
669 { | |
670 MatrixType mattype (*this); | |
671 return inverse (mattype, info, rcond, force, calc_cond); | |
672 } | |
673 | |
674 FloatMatrix | |
675 FloatMatrix::inverse (MatrixType& mattype) const | |
676 { | |
677 octave_idx_type info; | |
678 float rcond; | |
679 return inverse (mattype, info, rcond, 0, 0); | |
680 } | |
681 | |
682 FloatMatrix | |
683 FloatMatrix::inverse (MatrixType &mattype, octave_idx_type& info) const | |
684 { | |
685 float rcond; | |
686 return inverse (mattype, info, rcond, 0, 0); | |
687 } | |
688 | |
689 FloatMatrix | |
690 FloatMatrix::tinverse (MatrixType &mattype, octave_idx_type& info, float& rcond, | |
691 int force, int calc_cond) const | |
692 { | |
693 FloatMatrix retval; | |
694 | |
695 octave_idx_type nr = rows (); | |
696 octave_idx_type nc = cols (); | |
697 | |
698 if (nr != nc || nr == 0 || nc == 0) | |
699 (*current_liboctave_error_handler) ("inverse requires square matrix"); | |
700 else | |
701 { | |
702 int typ = mattype.type (); | |
703 char uplo = (typ == MatrixType::Lower ? 'L' : 'U'); | |
704 char udiag = 'N'; | |
705 retval = *this; | |
706 float *tmp_data = retval.fortran_vec (); | |
707 | |
708 F77_XFCN (strtri, STRTRI, (F77_CONST_CHAR_ARG2 (&uplo, 1), | |
709 F77_CONST_CHAR_ARG2 (&udiag, 1), | |
710 nr, tmp_data, nr, info | |
711 F77_CHAR_ARG_LEN (1) | |
712 F77_CHAR_ARG_LEN (1))); | |
713 | |
714 // Throw-away extra info LAPACK gives so as to not change output. | |
715 rcond = 0.0; | |
716 if (info != 0) | |
717 info = -1; | |
718 else if (calc_cond) | |
719 { | |
720 octave_idx_type dtrcon_info = 0; | |
721 char job = '1'; | |
722 | |
723 OCTAVE_LOCAL_BUFFER (float, work, 3 * nr); | |
724 OCTAVE_LOCAL_BUFFER (octave_idx_type, iwork, nr); | |
725 | |
726 F77_XFCN (strcon, STRCON, (F77_CONST_CHAR_ARG2 (&job, 1), | |
727 F77_CONST_CHAR_ARG2 (&uplo, 1), | |
728 F77_CONST_CHAR_ARG2 (&udiag, 1), | |
729 nr, tmp_data, nr, rcond, | |
730 work, iwork, dtrcon_info | |
731 F77_CHAR_ARG_LEN (1) | |
732 F77_CHAR_ARG_LEN (1) | |
733 F77_CHAR_ARG_LEN (1))); | |
734 | |
735 if (dtrcon_info != 0) | |
736 info = -1; | |
737 } | |
738 | |
739 if (info == -1 && ! force) | |
740 retval = *this; // Restore matrix contents. | |
741 } | |
742 | |
743 return retval; | |
744 } | |
745 | |
746 | |
747 FloatMatrix | |
748 FloatMatrix::finverse (MatrixType &mattype, octave_idx_type& info, float& rcond, | |
749 int force, int calc_cond) const | |
750 { | |
751 FloatMatrix retval; | |
752 | |
753 octave_idx_type nr = rows (); | |
754 octave_idx_type nc = cols (); | |
755 | |
756 if (nr != nc || nr == 0 || nc == 0) | |
757 (*current_liboctave_error_handler) ("inverse requires square matrix"); | |
758 else | |
759 { | |
760 Array<octave_idx_type> ipvt (nr); | |
761 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
762 | |
763 retval = *this; | |
764 float *tmp_data = retval.fortran_vec (); | |
765 | |
766 Array<float> z(1); | |
767 octave_idx_type lwork = -1; | |
768 | |
769 // Query the optimum work array size. | |
770 F77_XFCN (sgetri, SGETRI, (nc, tmp_data, nr, pipvt, | |
771 z.fortran_vec (), lwork, info)); | |
772 | |
773 lwork = static_cast<octave_idx_type> (z(0)); | |
774 lwork = (lwork < 2 *nc ? 2*nc : lwork); | |
775 z.resize (lwork); | |
776 float *pz = z.fortran_vec (); | |
777 | |
778 info = 0; | |
779 | |
780 // Calculate the norm of the matrix, for later use. | |
781 float anorm = 0; | |
782 if (calc_cond) | |
783 anorm = retval.abs().sum().row(static_cast<octave_idx_type>(0)).max(); | |
784 | |
785 F77_XFCN (sgetrf, SGETRF, (nc, nc, tmp_data, nr, pipvt, info)); | |
786 | |
787 // Throw-away extra info LAPACK gives so as to not change output. | |
788 rcond = 0.0; | |
789 if (info != 0) | |
790 info = -1; | |
791 else if (calc_cond) | |
792 { | |
793 octave_idx_type dgecon_info = 0; | |
794 | |
795 // Now calculate the condition number for non-singular matrix. | |
796 char job = '1'; | |
797 Array<octave_idx_type> iz (nc); | |
798 octave_idx_type *piz = iz.fortran_vec (); | |
799 F77_XFCN (sgecon, SGECON, (F77_CONST_CHAR_ARG2 (&job, 1), | |
800 nc, tmp_data, nr, anorm, | |
801 rcond, pz, piz, dgecon_info | |
802 F77_CHAR_ARG_LEN (1))); | |
803 | |
804 if (dgecon_info != 0) | |
805 info = -1; | |
806 } | |
807 | |
808 if (info == -1 && ! force) | |
809 retval = *this; // Restore matrix contents. | |
810 else | |
811 { | |
812 octave_idx_type dgetri_info = 0; | |
813 | |
814 F77_XFCN (sgetri, SGETRI, (nc, tmp_data, nr, pipvt, | |
815 pz, lwork, dgetri_info)); | |
816 | |
817 if (dgetri_info != 0) | |
818 info = -1; | |
819 } | |
820 | |
821 if (info != 0) | |
822 mattype.mark_as_rectangular(); | |
823 } | |
824 | |
825 return retval; | |
826 } | |
827 | |
828 FloatMatrix | |
829 FloatMatrix::inverse (MatrixType &mattype, octave_idx_type& info, float& rcond, | |
830 int force, int calc_cond) const | |
831 { | |
832 int typ = mattype.type (false); | |
833 FloatMatrix ret; | |
834 | |
835 if (typ == MatrixType::Unknown) | |
836 typ = mattype.type (*this); | |
837 | |
838 if (typ == MatrixType::Upper || typ == MatrixType::Lower) | |
839 ret = tinverse (mattype, info, rcond, force, calc_cond); | |
840 else | |
841 { | |
842 if (mattype.is_hermitian ()) | |
843 { | |
844 FloatCHOL chol (*this, info, calc_cond); | |
845 if (info == 0) | |
846 { | |
847 if (calc_cond) | |
848 rcond = chol.rcond (); | |
849 else | |
850 rcond = 1.0; | |
851 ret = chol.inverse (); | |
852 } | |
853 else | |
854 mattype.mark_as_unsymmetric (); | |
855 } | |
856 | |
857 if (!mattype.is_hermitian ()) | |
858 ret = finverse(mattype, info, rcond, force, calc_cond); | |
859 | |
860 if ((mattype.is_hermitian () || calc_cond) && rcond == 0.) | |
861 ret = FloatMatrix (rows (), columns (), octave_Float_Inf); | |
862 } | |
863 | |
864 return ret; | |
865 } | |
866 | |
867 FloatMatrix | |
868 FloatMatrix::pseudo_inverse (float tol) const | |
869 { | |
870 FloatSVD result (*this, SVD::economy); | |
871 | |
872 FloatDiagMatrix S = result.singular_values (); | |
873 FloatMatrix U = result.left_singular_matrix (); | |
874 FloatMatrix V = result.right_singular_matrix (); | |
875 | |
876 FloatColumnVector sigma = S.diag (); | |
877 | |
878 octave_idx_type r = sigma.length () - 1; | |
879 octave_idx_type nr = rows (); | |
880 octave_idx_type nc = cols (); | |
881 | |
882 if (tol <= 0.0) | |
883 { | |
884 if (nr > nc) | |
885 tol = nr * sigma.elem (0) * DBL_EPSILON; | |
886 else | |
887 tol = nc * sigma.elem (0) * DBL_EPSILON; | |
888 } | |
889 | |
890 while (r >= 0 && sigma.elem (r) < tol) | |
891 r--; | |
892 | |
893 if (r < 0) | |
894 return FloatMatrix (nc, nr, 0.0); | |
895 else | |
896 { | |
897 FloatMatrix Ur = U.extract (0, 0, nr-1, r); | |
898 FloatDiagMatrix D = FloatDiagMatrix (sigma.extract (0, r)) . inverse (); | |
899 FloatMatrix Vr = V.extract (0, 0, nc-1, r); | |
900 return Vr * D * Ur.transpose (); | |
901 } | |
902 } | |
903 | |
904 #if defined (HAVE_FFTW3) | |
905 | |
906 FloatComplexMatrix | |
907 FloatMatrix::fourier (void) const | |
908 { | |
909 size_t nr = rows (); | |
910 size_t nc = cols (); | |
911 | |
912 FloatComplexMatrix retval (nr, nc); | |
913 | |
914 size_t npts, nsamples; | |
915 | |
916 if (nr == 1 || nc == 1) | |
917 { | |
918 npts = nr > nc ? nr : nc; | |
919 nsamples = 1; | |
920 } | |
921 else | |
922 { | |
923 npts = nr; | |
924 nsamples = nc; | |
925 } | |
926 | |
927 const float *in (fortran_vec ()); | |
928 FloatComplex *out (retval.fortran_vec ()); | |
929 | |
930 octave_fftw::fft (in, out, npts, nsamples); | |
931 | |
932 return retval; | |
933 } | |
934 | |
935 FloatComplexMatrix | |
936 FloatMatrix::ifourier (void) const | |
937 { | |
938 size_t nr = rows (); | |
939 size_t nc = cols (); | |
940 | |
941 FloatComplexMatrix retval (nr, nc); | |
942 | |
943 size_t npts, nsamples; | |
944 | |
945 if (nr == 1 || nc == 1) | |
946 { | |
947 npts = nr > nc ? nr : nc; | |
948 nsamples = 1; | |
949 } | |
950 else | |
951 { | |
952 npts = nr; | |
953 nsamples = nc; | |
954 } | |
955 | |
956 FloatComplexMatrix tmp (*this); | |
957 FloatComplex *in (tmp.fortran_vec ()); | |
958 FloatComplex *out (retval.fortran_vec ()); | |
959 | |
960 octave_fftw::ifft (in, out, npts, nsamples); | |
961 | |
962 return retval; | |
963 } | |
964 | |
965 FloatComplexMatrix | |
966 FloatMatrix::fourier2d (void) const | |
967 { | |
968 dim_vector dv(rows (), cols ()); | |
969 | |
970 const float *in = fortran_vec (); | |
971 FloatComplexMatrix retval (rows (), cols ()); | |
972 octave_fftw::fftNd (in, retval.fortran_vec (), 2, dv); | |
973 | |
974 return retval; | |
975 } | |
976 | |
977 FloatComplexMatrix | |
978 FloatMatrix::ifourier2d (void) const | |
979 { | |
980 dim_vector dv(rows (), cols ()); | |
981 | |
982 FloatComplexMatrix retval (*this); | |
983 FloatComplex *out (retval.fortran_vec ()); | |
984 | |
985 octave_fftw::ifftNd (out, out, 2, dv); | |
986 | |
987 return retval; | |
988 } | |
989 | |
990 #else | |
991 | |
992 FloatComplexMatrix | |
993 FloatMatrix::fourier (void) const | |
994 { | |
995 FloatComplexMatrix retval; | |
996 | |
997 octave_idx_type nr = rows (); | |
998 octave_idx_type nc = cols (); | |
999 | |
1000 octave_idx_type npts, nsamples; | |
1001 | |
1002 if (nr == 1 || nc == 1) | |
1003 { | |
1004 npts = nr > nc ? nr : nc; | |
1005 nsamples = 1; | |
1006 } | |
1007 else | |
1008 { | |
1009 npts = nr; | |
1010 nsamples = nc; | |
1011 } | |
1012 | |
1013 octave_idx_type nn = 4*npts+15; | |
1014 | |
1015 Array<FloatComplex> wsave (nn); | |
1016 FloatComplex *pwsave = wsave.fortran_vec (); | |
1017 | |
1018 retval = FloatComplexMatrix (*this); | |
1019 FloatComplex *tmp_data = retval.fortran_vec (); | |
1020 | |
1021 F77_FUNC (cffti, CFFTI) (npts, pwsave); | |
1022 | |
1023 for (octave_idx_type j = 0; j < nsamples; j++) | |
1024 { | |
1025 OCTAVE_QUIT; | |
1026 | |
1027 F77_FUNC (cfftf, CFFTF) (npts, &tmp_data[npts*j], pwsave); | |
1028 } | |
1029 | |
1030 return retval; | |
1031 } | |
1032 | |
1033 FloatComplexMatrix | |
1034 FloatMatrix::ifourier (void) const | |
1035 { | |
1036 FloatComplexMatrix retval; | |
1037 | |
1038 octave_idx_type nr = rows (); | |
1039 octave_idx_type nc = cols (); | |
1040 | |
1041 octave_idx_type npts, nsamples; | |
1042 | |
1043 if (nr == 1 || nc == 1) | |
1044 { | |
1045 npts = nr > nc ? nr : nc; | |
1046 nsamples = 1; | |
1047 } | |
1048 else | |
1049 { | |
1050 npts = nr; | |
1051 nsamples = nc; | |
1052 } | |
1053 | |
1054 octave_idx_type nn = 4*npts+15; | |
1055 | |
1056 Array<FloatComplex> wsave (nn); | |
1057 FloatComplex *pwsave = wsave.fortran_vec (); | |
1058 | |
1059 retval = FloatComplexMatrix (*this); | |
1060 FloatComplex *tmp_data = retval.fortran_vec (); | |
1061 | |
1062 F77_FUNC (cffti, CFFTI) (npts, pwsave); | |
1063 | |
1064 for (octave_idx_type j = 0; j < nsamples; j++) | |
1065 { | |
1066 OCTAVE_QUIT; | |
1067 | |
1068 F77_FUNC (cfftb, CFFTB) (npts, &tmp_data[npts*j], pwsave); | |
1069 } | |
1070 | |
1071 for (octave_idx_type j = 0; j < npts*nsamples; j++) | |
1072 tmp_data[j] = tmp_data[j] / static_cast<float> (npts); | |
1073 | |
1074 return retval; | |
1075 } | |
1076 | |
1077 FloatComplexMatrix | |
1078 FloatMatrix::fourier2d (void) const | |
1079 { | |
1080 FloatComplexMatrix retval; | |
1081 | |
1082 octave_idx_type nr = rows (); | |
1083 octave_idx_type nc = cols (); | |
1084 | |
1085 octave_idx_type npts, nsamples; | |
1086 | |
1087 if (nr == 1 || nc == 1) | |
1088 { | |
1089 npts = nr > nc ? nr : nc; | |
1090 nsamples = 1; | |
1091 } | |
1092 else | |
1093 { | |
1094 npts = nr; | |
1095 nsamples = nc; | |
1096 } | |
1097 | |
1098 octave_idx_type nn = 4*npts+15; | |
1099 | |
1100 Array<FloatComplex> wsave (nn); | |
1101 FloatComplex *pwsave = wsave.fortran_vec (); | |
1102 | |
1103 retval = FloatComplexMatrix (*this); | |
1104 FloatComplex *tmp_data = retval.fortran_vec (); | |
1105 | |
1106 F77_FUNC (cffti, CFFTI) (npts, pwsave); | |
1107 | |
1108 for (octave_idx_type j = 0; j < nsamples; j++) | |
1109 { | |
1110 OCTAVE_QUIT; | |
1111 | |
1112 F77_FUNC (cfftf, CFFTF) (npts, &tmp_data[npts*j], pwsave); | |
1113 } | |
1114 | |
1115 npts = nc; | |
1116 nsamples = nr; | |
1117 nn = 4*npts+15; | |
1118 | |
1119 wsave.resize (nn); | |
1120 pwsave = wsave.fortran_vec (); | |
1121 | |
1122 Array<FloatComplex> tmp (npts); | |
1123 FloatComplex *prow = tmp.fortran_vec (); | |
1124 | |
1125 F77_FUNC (cffti, CFFTI) (npts, pwsave); | |
1126 | |
1127 for (octave_idx_type j = 0; j < nsamples; j++) | |
1128 { | |
1129 OCTAVE_QUIT; | |
1130 | |
1131 for (octave_idx_type i = 0; i < npts; i++) | |
1132 prow[i] = tmp_data[i*nr + j]; | |
1133 | |
1134 F77_FUNC (cfftf, CFFTF) (npts, prow, pwsave); | |
1135 | |
1136 for (octave_idx_type i = 0; i < npts; i++) | |
1137 tmp_data[i*nr + j] = prow[i]; | |
1138 } | |
1139 | |
1140 return retval; | |
1141 } | |
1142 | |
1143 FloatComplexMatrix | |
1144 FloatMatrix::ifourier2d (void) const | |
1145 { | |
1146 FloatComplexMatrix retval; | |
1147 | |
1148 octave_idx_type nr = rows (); | |
1149 octave_idx_type nc = cols (); | |
1150 | |
1151 octave_idx_type npts, nsamples; | |
1152 | |
1153 if (nr == 1 || nc == 1) | |
1154 { | |
1155 npts = nr > nc ? nr : nc; | |
1156 nsamples = 1; | |
1157 } | |
1158 else | |
1159 { | |
1160 npts = nr; | |
1161 nsamples = nc; | |
1162 } | |
1163 | |
1164 octave_idx_type nn = 4*npts+15; | |
1165 | |
1166 Array<FloatComplex> wsave (nn); | |
1167 FloatComplex *pwsave = wsave.fortran_vec (); | |
1168 | |
1169 retval = FloatComplexMatrix (*this); | |
1170 FloatComplex *tmp_data = retval.fortran_vec (); | |
1171 | |
1172 F77_FUNC (cffti, CFFTI) (npts, pwsave); | |
1173 | |
1174 for (octave_idx_type j = 0; j < nsamples; j++) | |
1175 { | |
1176 OCTAVE_QUIT; | |
1177 | |
1178 F77_FUNC (cfftb, CFFTB) (npts, &tmp_data[npts*j], pwsave); | |
1179 } | |
1180 | |
1181 for (octave_idx_type j = 0; j < npts*nsamples; j++) | |
1182 tmp_data[j] = tmp_data[j] / static_cast<float> (npts); | |
1183 | |
1184 npts = nc; | |
1185 nsamples = nr; | |
1186 nn = 4*npts+15; | |
1187 | |
1188 wsave.resize (nn); | |
1189 pwsave = wsave.fortran_vec (); | |
1190 | |
1191 Array<FloatComplex> tmp (npts); | |
1192 FloatComplex *prow = tmp.fortran_vec (); | |
1193 | |
1194 F77_FUNC (cffti, CFFTI) (npts, pwsave); | |
1195 | |
1196 for (octave_idx_type j = 0; j < nsamples; j++) | |
1197 { | |
1198 OCTAVE_QUIT; | |
1199 | |
1200 for (octave_idx_type i = 0; i < npts; i++) | |
1201 prow[i] = tmp_data[i*nr + j]; | |
1202 | |
1203 F77_FUNC (cfftb, CFFTB) (npts, prow, pwsave); | |
1204 | |
1205 for (octave_idx_type i = 0; i < npts; i++) | |
1206 tmp_data[i*nr + j] = prow[i] / static_cast<float> (npts); | |
1207 } | |
1208 | |
1209 return retval; | |
1210 } | |
1211 | |
1212 #endif | |
1213 | |
1214 FloatDET | |
1215 FloatMatrix::determinant (void) const | |
1216 { | |
1217 octave_idx_type info; | |
1218 float rcond; | |
1219 return determinant (info, rcond, 0); | |
1220 } | |
1221 | |
1222 FloatDET | |
1223 FloatMatrix::determinant (octave_idx_type& info) const | |
1224 { | |
1225 float rcond; | |
1226 return determinant (info, rcond, 0); | |
1227 } | |
1228 | |
1229 FloatDET | |
1230 FloatMatrix::determinant (octave_idx_type& info, float& rcond, int calc_cond) const | |
1231 { | |
1232 FloatDET retval; | |
1233 | |
1234 octave_idx_type nr = rows (); | |
1235 octave_idx_type nc = cols (); | |
1236 | |
1237 if (nr == 0 || nc == 0) | |
1238 { | |
1239 retval = FloatDET (1.0, 0); | |
1240 } | |
1241 else | |
1242 { | |
1243 Array<octave_idx_type> ipvt (nr); | |
1244 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
1245 | |
1246 FloatMatrix atmp = *this; | |
1247 float *tmp_data = atmp.fortran_vec (); | |
1248 | |
1249 info = 0; | |
1250 | |
1251 // Calculate the norm of the matrix, for later use. | |
1252 float anorm = 0; | |
1253 if (calc_cond) | |
1254 anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); | |
1255 | |
1256 F77_XFCN (sgetrf, SGETRF, (nr, nr, tmp_data, nr, pipvt, info)); | |
1257 | |
1258 // Throw-away extra info LAPACK gives so as to not change output. | |
1259 rcond = 0.0; | |
1260 if (info != 0) | |
1261 { | |
1262 info = -1; | |
1263 retval = FloatDET (); | |
1264 } | |
1265 else | |
1266 { | |
1267 if (calc_cond) | |
1268 { | |
1269 // Now calc the condition number for non-singular matrix. | |
1270 char job = '1'; | |
1271 Array<float> z (4 * nc); | |
1272 float *pz = z.fortran_vec (); | |
1273 Array<octave_idx_type> iz (nc); | |
1274 octave_idx_type *piz = iz.fortran_vec (); | |
1275 | |
1276 F77_XFCN (sgecon, SGECON, (F77_CONST_CHAR_ARG2 (&job, 1), | |
1277 nc, tmp_data, nr, anorm, | |
1278 rcond, pz, piz, info | |
1279 F77_CHAR_ARG_LEN (1))); | |
1280 } | |
1281 | |
1282 if (info != 0) | |
1283 { | |
1284 info = -1; | |
1285 retval = FloatDET (); | |
1286 } | |
1287 else | |
1288 { | |
1289 float c = 1.0; | |
1290 int e = 0; | |
1291 | |
1292 for (octave_idx_type i = 0; i < nc; i++) | |
1293 { | |
1294 if (ipvt(i) != (i+1)) | |
1295 c = -c; | |
1296 | |
1297 c *= atmp(i,i); | |
1298 | |
1299 if (c == 0.0) | |
1300 break; | |
1301 | |
1302 while (fabs (c) < 0.5) | |
1303 { | |
1304 c *= 2.0; | |
1305 e--; | |
1306 } | |
1307 | |
1308 while (fabs (c) >= 2.0) | |
1309 { | |
1310 c /= 2.0; | |
1311 e++; | |
1312 } | |
1313 } | |
1314 | |
1315 retval = FloatDET (c, e); | |
1316 } | |
1317 } | |
1318 } | |
1319 | |
1320 return retval; | |
1321 } | |
1322 | |
1323 FloatMatrix | |
1324 FloatMatrix::utsolve (MatrixType &mattype, const FloatMatrix& b, octave_idx_type& info, | |
1325 float& rcond, solve_singularity_handler sing_handler, | |
1326 bool calc_cond) const | |
1327 { | |
1328 FloatMatrix retval; | |
1329 | |
1330 octave_idx_type nr = rows (); | |
1331 octave_idx_type nc = cols (); | |
1332 | |
1333 if (nr != b.rows ()) | |
1334 (*current_liboctave_error_handler) | |
1335 ("matrix dimension mismatch solution of linear equations"); | |
1336 else if (nr == 0 || nc == 0 || b.cols () == 0) | |
1337 retval = FloatMatrix (nc, b.cols (), 0.0); | |
1338 else | |
1339 { | |
1340 volatile int typ = mattype.type (); | |
1341 | |
1342 if (typ == MatrixType::Permuted_Upper || | |
1343 typ == MatrixType::Upper) | |
1344 { | |
1345 octave_idx_type b_nc = b.cols (); | |
1346 rcond = 1.; | |
1347 info = 0; | |
1348 | |
1349 if (typ == MatrixType::Permuted_Upper) | |
1350 { | |
1351 (*current_liboctave_error_handler) | |
1352 ("permuted triangular matrix not implemented"); | |
1353 } | |
1354 else | |
1355 { | |
1356 const float *tmp_data = fortran_vec (); | |
1357 | |
1358 if (calc_cond) | |
1359 { | |
1360 char norm = '1'; | |
1361 char uplo = 'U'; | |
1362 char dia = 'N'; | |
1363 | |
1364 Array<float> z (3 * nc); | |
1365 float *pz = z.fortran_vec (); | |
1366 Array<octave_idx_type> iz (nc); | |
1367 octave_idx_type *piz = iz.fortran_vec (); | |
1368 | |
1369 F77_XFCN (strcon, STRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), | |
1370 F77_CONST_CHAR_ARG2 (&uplo, 1), | |
1371 F77_CONST_CHAR_ARG2 (&dia, 1), | |
1372 nr, tmp_data, nr, rcond, | |
1373 pz, piz, info | |
1374 F77_CHAR_ARG_LEN (1) | |
1375 F77_CHAR_ARG_LEN (1) | |
1376 F77_CHAR_ARG_LEN (1))); | |
1377 | |
1378 if (info != 0) | |
1379 info = -2; | |
1380 | |
1381 volatile float rcond_plus_one = rcond + 1.0; | |
1382 | |
1383 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
1384 { | |
1385 info = -2; | |
1386 | |
1387 if (sing_handler) | |
1388 sing_handler (rcond); | |
1389 else | |
1390 (*current_liboctave_error_handler) | |
1391 ("matrix singular to machine precision, rcond = %g", | |
1392 rcond); | |
1393 } | |
1394 } | |
1395 | |
1396 if (info == 0) | |
1397 { | |
1398 retval = b; | |
1399 float *result = retval.fortran_vec (); | |
1400 | |
1401 char uplo = 'U'; | |
1402 char trans = 'N'; | |
1403 char dia = 'N'; | |
1404 | |
1405 F77_XFCN (strtrs, STRTRS, (F77_CONST_CHAR_ARG2 (&uplo, 1), | |
1406 F77_CONST_CHAR_ARG2 (&trans, 1), | |
1407 F77_CONST_CHAR_ARG2 (&dia, 1), | |
1408 nr, b_nc, tmp_data, nr, | |
1409 result, nr, info | |
1410 F77_CHAR_ARG_LEN (1) | |
1411 F77_CHAR_ARG_LEN (1) | |
1412 F77_CHAR_ARG_LEN (1))); | |
1413 } | |
1414 } | |
1415 } | |
1416 else | |
1417 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
1418 } | |
1419 | |
1420 return retval; | |
1421 } | |
1422 | |
1423 FloatMatrix | |
1424 FloatMatrix::ltsolve (MatrixType &mattype, const FloatMatrix& b, octave_idx_type& info, | |
1425 float& rcond, solve_singularity_handler sing_handler, | |
1426 bool calc_cond) const | |
1427 { | |
1428 FloatMatrix retval; | |
1429 | |
1430 octave_idx_type nr = rows (); | |
1431 octave_idx_type nc = cols (); | |
1432 | |
1433 if (nr != b.rows ()) | |
1434 (*current_liboctave_error_handler) | |
1435 ("matrix dimension mismatch solution of linear equations"); | |
1436 else if (nr == 0 || nc == 0 || b.cols () == 0) | |
1437 retval = FloatMatrix (nc, b.cols (), 0.0); | |
1438 else | |
1439 { | |
1440 volatile int typ = mattype.type (); | |
1441 | |
1442 if (typ == MatrixType::Permuted_Lower || | |
1443 typ == MatrixType::Lower) | |
1444 { | |
1445 octave_idx_type b_nc = b.cols (); | |
1446 rcond = 1.; | |
1447 info = 0; | |
1448 | |
1449 if (typ == MatrixType::Permuted_Lower) | |
1450 { | |
1451 (*current_liboctave_error_handler) | |
1452 ("permuted triangular matrix not implemented"); | |
1453 } | |
1454 else | |
1455 { | |
1456 const float *tmp_data = fortran_vec (); | |
1457 | |
1458 if (calc_cond) | |
1459 { | |
1460 char norm = '1'; | |
1461 char uplo = 'L'; | |
1462 char dia = 'N'; | |
1463 | |
1464 Array<float> z (3 * nc); | |
1465 float *pz = z.fortran_vec (); | |
1466 Array<octave_idx_type> iz (nc); | |
1467 octave_idx_type *piz = iz.fortran_vec (); | |
1468 | |
1469 F77_XFCN (strcon, STRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), | |
1470 F77_CONST_CHAR_ARG2 (&uplo, 1), | |
1471 F77_CONST_CHAR_ARG2 (&dia, 1), | |
1472 nr, tmp_data, nr, rcond, | |
1473 pz, piz, info | |
1474 F77_CHAR_ARG_LEN (1) | |
1475 F77_CHAR_ARG_LEN (1) | |
1476 F77_CHAR_ARG_LEN (1))); | |
1477 | |
1478 if (info != 0) | |
1479 info = -2; | |
1480 | |
1481 volatile float rcond_plus_one = rcond + 1.0; | |
1482 | |
1483 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
1484 { | |
1485 info = -2; | |
1486 | |
1487 if (sing_handler) | |
1488 sing_handler (rcond); | |
1489 else | |
1490 (*current_liboctave_error_handler) | |
1491 ("matrix singular to machine precision, rcond = %g", | |
1492 rcond); | |
1493 } | |
1494 } | |
1495 | |
1496 if (info == 0) | |
1497 { | |
1498 retval = b; | |
1499 float *result = retval.fortran_vec (); | |
1500 | |
1501 char uplo = 'L'; | |
1502 char trans = 'N'; | |
1503 char dia = 'N'; | |
1504 | |
1505 F77_XFCN (strtrs, STRTRS, (F77_CONST_CHAR_ARG2 (&uplo, 1), | |
1506 F77_CONST_CHAR_ARG2 (&trans, 1), | |
1507 F77_CONST_CHAR_ARG2 (&dia, 1), | |
1508 nr, b_nc, tmp_data, nr, | |
1509 result, nr, info | |
1510 F77_CHAR_ARG_LEN (1) | |
1511 F77_CHAR_ARG_LEN (1) | |
1512 F77_CHAR_ARG_LEN (1))); | |
1513 } | |
1514 } | |
1515 } | |
1516 else | |
1517 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
1518 } | |
1519 | |
1520 return retval; | |
1521 } | |
1522 | |
1523 FloatMatrix | |
1524 FloatMatrix::fsolve (MatrixType &mattype, const FloatMatrix& b, octave_idx_type& info, | |
1525 float& rcond, solve_singularity_handler sing_handler, | |
1526 bool calc_cond) const | |
1527 { | |
1528 FloatMatrix retval; | |
1529 | |
1530 octave_idx_type nr = rows (); | |
1531 octave_idx_type nc = cols (); | |
1532 | |
1533 if (nr != nc || nr != b.rows ()) | |
1534 (*current_liboctave_error_handler) | |
1535 ("matrix dimension mismatch solution of linear equations"); | |
1536 else if (nr == 0 || b.cols () == 0) | |
1537 retval = FloatMatrix (nc, b.cols (), 0.0); | |
1538 else | |
1539 { | |
1540 volatile int typ = mattype.type (); | |
1541 | |
1542 // Calculate the norm of the matrix, for later use. | |
1543 float anorm = -1.; | |
1544 | |
1545 if (typ == MatrixType::Hermitian) | |
1546 { | |
1547 info = 0; | |
1548 char job = 'L'; | |
1549 FloatMatrix atmp = *this; | |
1550 float *tmp_data = atmp.fortran_vec (); | |
1551 anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); | |
1552 | |
1553 F77_XFCN (spotrf, SPOTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, | |
1554 tmp_data, nr, info | |
1555 F77_CHAR_ARG_LEN (1))); | |
1556 | |
1557 // Throw-away extra info LAPACK gives so as to not change output. | |
1558 rcond = 0.0; | |
1559 if (info != 0) | |
1560 { | |
1561 info = -2; | |
1562 | |
1563 mattype.mark_as_unsymmetric (); | |
1564 typ = MatrixType::Full; | |
1565 } | |
1566 else | |
1567 { | |
1568 if (calc_cond) | |
1569 { | |
1570 Array<float> z (3 * nc); | |
1571 float *pz = z.fortran_vec (); | |
1572 Array<octave_idx_type> iz (nc); | |
1573 octave_idx_type *piz = iz.fortran_vec (); | |
1574 | |
1575 F77_XFCN (spocon, SPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), | |
1576 nr, tmp_data, nr, anorm, | |
1577 rcond, pz, piz, info | |
1578 F77_CHAR_ARG_LEN (1))); | |
1579 | |
1580 if (info != 0) | |
1581 info = -2; | |
1582 | |
1583 volatile float rcond_plus_one = rcond + 1.0; | |
1584 | |
1585 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
1586 { | |
1587 info = -2; | |
1588 | |
1589 if (sing_handler) | |
1590 sing_handler (rcond); | |
1591 else | |
1592 (*current_liboctave_error_handler) | |
1593 ("matrix singular to machine precision, rcond = %g", | |
1594 rcond); | |
1595 } | |
1596 } | |
1597 | |
1598 if (info == 0) | |
1599 { | |
1600 retval = b; | |
1601 float *result = retval.fortran_vec (); | |
1602 | |
1603 octave_idx_type b_nc = b.cols (); | |
1604 | |
1605 F77_XFCN (spotrs, SPOTRS, (F77_CONST_CHAR_ARG2 (&job, 1), | |
1606 nr, b_nc, tmp_data, nr, | |
1607 result, b.rows(), info | |
1608 F77_CHAR_ARG_LEN (1))); | |
1609 } | |
1610 else | |
1611 { | |
1612 mattype.mark_as_unsymmetric (); | |
1613 typ = MatrixType::Full; | |
1614 } | |
1615 } | |
1616 } | |
1617 | |
1618 if (typ == MatrixType::Full) | |
1619 { | |
1620 info = 0; | |
1621 | |
1622 Array<octave_idx_type> ipvt (nr); | |
1623 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
1624 | |
1625 FloatMatrix atmp = *this; | |
1626 float *tmp_data = atmp.fortran_vec (); | |
1627 if(anorm < 0.) | |
1628 anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); | |
1629 | |
1630 Array<float> z (4 * nc); | |
1631 float *pz = z.fortran_vec (); | |
1632 Array<octave_idx_type> iz (nc); | |
1633 octave_idx_type *piz = iz.fortran_vec (); | |
1634 | |
1635 F77_XFCN (sgetrf, SGETRF, (nr, nr, tmp_data, nr, pipvt, info)); | |
1636 | |
1637 // Throw-away extra info LAPACK gives so as to not change output. | |
1638 rcond = 0.0; | |
1639 if (info != 0) | |
1640 { | |
1641 info = -2; | |
1642 | |
1643 if (sing_handler) | |
1644 sing_handler (rcond); | |
1645 else | |
1646 (*current_liboctave_error_handler) | |
1647 ("matrix singular to machine precision"); | |
1648 | |
1649 mattype.mark_as_rectangular (); | |
1650 } | |
1651 else | |
1652 { | |
1653 if (calc_cond) | |
1654 { | |
1655 // Now calculate the condition number for | |
1656 // non-singular matrix. | |
1657 char job = '1'; | |
1658 F77_XFCN (sgecon, SGECON, (F77_CONST_CHAR_ARG2 (&job, 1), | |
1659 nc, tmp_data, nr, anorm, | |
1660 rcond, pz, piz, info | |
1661 F77_CHAR_ARG_LEN (1))); | |
1662 | |
1663 if (info != 0) | |
1664 info = -2; | |
1665 | |
1666 volatile float rcond_plus_one = rcond + 1.0; | |
1667 | |
1668 if (rcond_plus_one == 1.0 || xisnan (rcond)) | |
1669 { | |
1670 info = -2; | |
1671 | |
1672 if (sing_handler) | |
1673 sing_handler (rcond); | |
1674 else | |
1675 (*current_liboctave_error_handler) | |
1676 ("matrix singular to machine precision, rcond = %g", | |
1677 rcond); | |
1678 } | |
1679 } | |
1680 | |
1681 if (info == 0) | |
1682 { | |
1683 retval = b; | |
1684 float *result = retval.fortran_vec (); | |
1685 | |
1686 octave_idx_type b_nc = b.cols (); | |
1687 | |
1688 char job = 'N'; | |
1689 F77_XFCN (sgetrs, SGETRS, (F77_CONST_CHAR_ARG2 (&job, 1), | |
1690 nr, b_nc, tmp_data, nr, | |
1691 pipvt, result, b.rows(), info | |
1692 F77_CHAR_ARG_LEN (1))); | |
1693 } | |
1694 else | |
1695 mattype.mark_as_rectangular (); | |
1696 } | |
1697 } | |
1698 else if (typ != MatrixType::Hermitian) | |
1699 (*current_liboctave_error_handler) ("incorrect matrix type"); | |
1700 } | |
1701 | |
1702 return retval; | |
1703 } | |
1704 | |
1705 FloatMatrix | |
1706 FloatMatrix::solve (MatrixType &typ, const FloatMatrix& b) const | |
1707 { | |
1708 octave_idx_type info; | |
1709 float rcond; | |
1710 return solve (typ, b, info, rcond, 0); | |
1711 } | |
1712 | |
1713 FloatMatrix | |
1714 FloatMatrix::solve (MatrixType &typ, const FloatMatrix& b, octave_idx_type& info, | |
1715 float& rcond) const | |
1716 { | |
1717 return solve (typ, b, info, rcond, 0); | |
1718 } | |
1719 | |
1720 FloatMatrix | |
1721 FloatMatrix::solve (MatrixType &mattype, const FloatMatrix& b, octave_idx_type& info, | |
1722 float& rcond, solve_singularity_handler sing_handler, | |
1723 bool singular_fallback) const | |
1724 { | |
1725 FloatMatrix retval; | |
1726 int typ = mattype.type (); | |
1727 | |
1728 if (typ == MatrixType::Unknown) | |
1729 typ = mattype.type (*this); | |
1730 | |
1731 // Only calculate the condition number for LU/Cholesky | |
1732 if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) | |
1733 retval = utsolve (mattype, b, info, rcond, sing_handler, false); | |
1734 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) | |
1735 retval = ltsolve (mattype, b, info, rcond, sing_handler, false); | |
1736 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) | |
1737 retval = fsolve (mattype, b, info, rcond, sing_handler, true); | |
1738 else if (typ != MatrixType::Rectangular) | |
1739 { | |
1740 (*current_liboctave_error_handler) ("unknown matrix type"); | |
1741 return FloatMatrix (); | |
1742 } | |
1743 | |
1744 // Rectangular or one of the above solvers flags a singular matrix | |
1745 if (singular_fallback && mattype.type () == MatrixType::Rectangular) | |
1746 { | |
1747 octave_idx_type rank; | |
1748 retval = lssolve (b, info, rank, rcond); | |
1749 } | |
1750 | |
1751 return retval; | |
1752 } | |
1753 | |
1754 FloatComplexMatrix | |
1755 FloatMatrix::solve (MatrixType &typ, const FloatComplexMatrix& b) const | |
1756 { | |
1757 FloatComplexMatrix tmp (*this); | |
1758 return tmp.solve (typ, b); | |
1759 } | |
1760 | |
1761 FloatComplexMatrix | |
1762 FloatMatrix::solve (MatrixType &typ, const FloatComplexMatrix& b, | |
1763 octave_idx_type& info) const | |
1764 { | |
1765 FloatComplexMatrix tmp (*this); | |
1766 return tmp.solve (typ, b, info); | |
1767 } | |
1768 | |
1769 FloatComplexMatrix | |
1770 FloatMatrix::solve (MatrixType &typ, const FloatComplexMatrix& b, octave_idx_type& info, | |
1771 float& rcond) const | |
1772 { | |
1773 FloatComplexMatrix tmp (*this); | |
1774 return tmp.solve (typ, b, info, rcond); | |
1775 } | |
1776 | |
1777 FloatComplexMatrix | |
1778 FloatMatrix::solve (MatrixType &typ, const FloatComplexMatrix& b, octave_idx_type& info, | |
1779 float& rcond, solve_singularity_handler sing_handler, | |
1780 bool singular_fallback) const | |
1781 { | |
1782 FloatComplexMatrix tmp (*this); | |
1783 return tmp.solve (typ, b, info, rcond, sing_handler, singular_fallback); | |
1784 } | |
1785 | |
1786 FloatColumnVector | |
1787 FloatMatrix::solve (MatrixType &typ, const FloatColumnVector& b) const | |
1788 { | |
1789 octave_idx_type info; float rcond; | |
1790 return solve (typ, b, info, rcond); | |
1791 } | |
1792 | |
1793 FloatColumnVector | |
1794 FloatMatrix::solve (MatrixType &typ, const FloatColumnVector& b, | |
1795 octave_idx_type& info) const | |
1796 { | |
1797 float rcond; | |
1798 return solve (typ, b, info, rcond); | |
1799 } | |
1800 | |
1801 FloatColumnVector | |
1802 FloatMatrix::solve (MatrixType &typ, const FloatColumnVector& b, octave_idx_type& info, | |
1803 float& rcond) const | |
1804 { | |
1805 return solve (typ, b, info, rcond, 0); | |
1806 } | |
1807 | |
1808 FloatColumnVector | |
1809 FloatMatrix::solve (MatrixType &typ, const FloatColumnVector& b, octave_idx_type& info, | |
1810 float& rcond, solve_singularity_handler sing_handler) const | |
1811 { | |
1812 FloatMatrix tmp (b); | |
1813 return solve (typ, tmp, info, rcond, sing_handler).column(static_cast<octave_idx_type> (0)); | |
1814 } | |
1815 | |
1816 FloatComplexColumnVector | |
1817 FloatMatrix::solve (MatrixType &typ, const FloatComplexColumnVector& b) const | |
1818 { | |
1819 FloatComplexMatrix tmp (*this); | |
1820 return tmp.solve (typ, b); | |
1821 } | |
1822 | |
1823 FloatComplexColumnVector | |
1824 FloatMatrix::solve (MatrixType &typ, const FloatComplexColumnVector& b, | |
1825 octave_idx_type& info) const | |
1826 { | |
1827 FloatComplexMatrix tmp (*this); | |
1828 return tmp.solve (typ, b, info); | |
1829 } | |
1830 | |
1831 FloatComplexColumnVector | |
1832 FloatMatrix::solve (MatrixType &typ, const FloatComplexColumnVector& b, | |
1833 octave_idx_type& info, float& rcond) const | |
1834 { | |
1835 FloatComplexMatrix tmp (*this); | |
1836 return tmp.solve (typ, b, info, rcond); | |
1837 } | |
1838 | |
1839 FloatComplexColumnVector | |
1840 FloatMatrix::solve (MatrixType &typ, const FloatComplexColumnVector& b, | |
1841 octave_idx_type& info, float& rcond, | |
1842 solve_singularity_handler sing_handler) const | |
1843 { | |
1844 FloatComplexMatrix tmp (*this); | |
1845 return tmp.solve(typ, b, info, rcond, sing_handler); | |
1846 } | |
1847 | |
1848 FloatMatrix | |
1849 FloatMatrix::solve (const FloatMatrix& b) const | |
1850 { | |
1851 octave_idx_type info; | |
1852 float rcond; | |
1853 return solve (b, info, rcond, 0); | |
1854 } | |
1855 | |
1856 FloatMatrix | |
1857 FloatMatrix::solve (const FloatMatrix& b, octave_idx_type& info) const | |
1858 { | |
1859 float rcond; | |
1860 return solve (b, info, rcond, 0); | |
1861 } | |
1862 | |
1863 FloatMatrix | |
1864 FloatMatrix::solve (const FloatMatrix& b, octave_idx_type& info, float& rcond) const | |
1865 { | |
1866 return solve (b, info, rcond, 0); | |
1867 } | |
1868 | |
1869 FloatMatrix | |
1870 FloatMatrix::solve (const FloatMatrix& b, octave_idx_type& info, | |
1871 float& rcond, solve_singularity_handler sing_handler) const | |
1872 { | |
1873 MatrixType mattype (*this); | |
1874 return solve (mattype, b, info, rcond, sing_handler); | |
1875 } | |
1876 | |
1877 FloatComplexMatrix | |
1878 FloatMatrix::solve (const FloatComplexMatrix& b) const | |
1879 { | |
1880 FloatComplexMatrix tmp (*this); | |
1881 return tmp.solve (b); | |
1882 } | |
1883 | |
1884 FloatComplexMatrix | |
1885 FloatMatrix::solve (const FloatComplexMatrix& b, octave_idx_type& info) const | |
1886 { | |
1887 FloatComplexMatrix tmp (*this); | |
1888 return tmp.solve (b, info); | |
1889 } | |
1890 | |
1891 FloatComplexMatrix | |
1892 FloatMatrix::solve (const FloatComplexMatrix& b, octave_idx_type& info, float& rcond) const | |
1893 { | |
1894 FloatComplexMatrix tmp (*this); | |
1895 return tmp.solve (b, info, rcond); | |
1896 } | |
1897 | |
1898 FloatComplexMatrix | |
1899 FloatMatrix::solve (const FloatComplexMatrix& b, octave_idx_type& info, float& rcond, | |
1900 solve_singularity_handler sing_handler) const | |
1901 { | |
1902 FloatComplexMatrix tmp (*this); | |
1903 return tmp.solve (b, info, rcond, sing_handler); | |
1904 } | |
1905 | |
1906 FloatColumnVector | |
1907 FloatMatrix::solve (const FloatColumnVector& b) const | |
1908 { | |
1909 octave_idx_type info; float rcond; | |
1910 return solve (b, info, rcond); | |
1911 } | |
1912 | |
1913 FloatColumnVector | |
1914 FloatMatrix::solve (const FloatColumnVector& b, octave_idx_type& info) const | |
1915 { | |
1916 float rcond; | |
1917 return solve (b, info, rcond); | |
1918 } | |
1919 | |
1920 FloatColumnVector | |
1921 FloatMatrix::solve (const FloatColumnVector& b, octave_idx_type& info, float& rcond) const | |
1922 { | |
1923 return solve (b, info, rcond, 0); | |
1924 } | |
1925 | |
1926 FloatColumnVector | |
1927 FloatMatrix::solve (const FloatColumnVector& b, octave_idx_type& info, float& rcond, | |
1928 solve_singularity_handler sing_handler) const | |
1929 { | |
1930 MatrixType mattype (*this); | |
1931 return solve (mattype, b, info, rcond, sing_handler); | |
1932 } | |
1933 | |
1934 FloatComplexColumnVector | |
1935 FloatMatrix::solve (const FloatComplexColumnVector& b) const | |
1936 { | |
1937 FloatComplexMatrix tmp (*this); | |
1938 return tmp.solve (b); | |
1939 } | |
1940 | |
1941 FloatComplexColumnVector | |
1942 FloatMatrix::solve (const FloatComplexColumnVector& b, octave_idx_type& info) const | |
1943 { | |
1944 FloatComplexMatrix tmp (*this); | |
1945 return tmp.solve (b, info); | |
1946 } | |
1947 | |
1948 FloatComplexColumnVector | |
1949 FloatMatrix::solve (const FloatComplexColumnVector& b, octave_idx_type& info, float& rcond) const | |
1950 { | |
1951 FloatComplexMatrix tmp (*this); | |
1952 return tmp.solve (b, info, rcond); | |
1953 } | |
1954 | |
1955 FloatComplexColumnVector | |
1956 FloatMatrix::solve (const FloatComplexColumnVector& b, octave_idx_type& info, float& rcond, | |
1957 solve_singularity_handler sing_handler) const | |
1958 { | |
1959 FloatComplexMatrix tmp (*this); | |
1960 return tmp.solve (b, info, rcond, sing_handler); | |
1961 } | |
1962 | |
1963 FloatMatrix | |
1964 FloatMatrix::lssolve (const FloatMatrix& b) const | |
1965 { | |
1966 octave_idx_type info; | |
1967 octave_idx_type rank; | |
1968 float rcond; | |
1969 return lssolve (b, info, rank, rcond); | |
1970 } | |
1971 | |
1972 FloatMatrix | |
1973 FloatMatrix::lssolve (const FloatMatrix& b, octave_idx_type& info) const | |
1974 { | |
1975 octave_idx_type rank; | |
1976 float rcond; | |
1977 return lssolve (b, info, rank, rcond); | |
1978 } | |
1979 | |
1980 FloatMatrix | |
1981 FloatMatrix::lssolve (const FloatMatrix& b, octave_idx_type& info, | |
1982 octave_idx_type& rank) const | |
1983 { | |
1984 float rcond; | |
1985 return lssolve (b, info, rank, rcond); | |
1986 } | |
1987 | |
1988 FloatMatrix | |
1989 FloatMatrix::lssolve (const FloatMatrix& b, octave_idx_type& info, | |
1990 octave_idx_type& rank, float &rcond) const | |
1991 { | |
1992 FloatMatrix retval; | |
1993 | |
1994 octave_idx_type nrhs = b.cols (); | |
1995 | |
1996 octave_idx_type m = rows (); | |
1997 octave_idx_type n = cols (); | |
1998 | |
1999 if (m != b.rows ()) | |
2000 (*current_liboctave_error_handler) | |
2001 ("matrix dimension mismatch solution of linear equations"); | |
2002 else if (m == 0 || n == 0 || b.cols () == 0) | |
2003 retval = FloatMatrix (n, b.cols (), 0.0); | |
2004 else | |
2005 { | |
2006 volatile octave_idx_type minmn = (m < n ? m : n); | |
2007 octave_idx_type maxmn = m > n ? m : n; | |
2008 rcond = -1.0; | |
2009 if (m != n) | |
2010 { | |
2011 retval = FloatMatrix (maxmn, nrhs, 0.0); | |
2012 | |
2013 for (octave_idx_type j = 0; j < nrhs; j++) | |
2014 for (octave_idx_type i = 0; i < m; i++) | |
2015 retval.elem (i, j) = b.elem (i, j); | |
2016 } | |
2017 else | |
2018 retval = b; | |
2019 | |
2020 FloatMatrix atmp = *this; | |
2021 float *tmp_data = atmp.fortran_vec (); | |
2022 | |
2023 float *pretval = retval.fortran_vec (); | |
2024 Array<float> s (minmn); | |
2025 float *ps = s.fortran_vec (); | |
2026 | |
2027 // Ask DGELSD what the dimension of WORK should be. | |
2028 octave_idx_type lwork = -1; | |
2029 | |
2030 Array<float> work (1); | |
2031 | |
2032 octave_idx_type smlsiz; | |
2033 F77_FUNC (xilaenv, XILAENV) (9, F77_CONST_CHAR_ARG2 ("SGELSD", 6), | |
2034 F77_CONST_CHAR_ARG2 (" ", 1), | |
2035 0, 0, 0, 0, smlsiz | |
2036 F77_CHAR_ARG_LEN (6) | |
2037 F77_CHAR_ARG_LEN (1)); | |
2038 | |
2039 octave_idx_type mnthr; | |
2040 F77_FUNC (xilaenv, XILAENV) (6, F77_CONST_CHAR_ARG2 ("SGELSD", 6), | |
2041 F77_CONST_CHAR_ARG2 (" ", 1), | |
2042 m, n, nrhs, -1, mnthr | |
2043 F77_CHAR_ARG_LEN (6) | |
2044 F77_CHAR_ARG_LEN (1)); | |
2045 | |
2046 // We compute the size of iwork because DGELSD in older versions | |
2047 // of LAPACK does not return it on a query call. | |
2048 float dminmn = static_cast<float> (minmn); | |
2049 float dsmlsizp1 = static_cast<float> (smlsiz+1); | |
2050 #if defined (HAVE_LOG2) | |
2051 float tmp = log2 (dminmn / dsmlsizp1); | |
2052 #else | |
2053 float tmp = log (dminmn / dsmlsizp1) / log (2.0); | |
2054 #endif | |
2055 octave_idx_type nlvl = static_cast<octave_idx_type> (tmp) + 1; | |
2056 if (nlvl < 0) | |
2057 nlvl = 0; | |
2058 | |
2059 octave_idx_type liwork = 3 * minmn * nlvl + 11 * minmn; | |
2060 if (liwork < 1) | |
2061 liwork = 1; | |
2062 Array<octave_idx_type> iwork (liwork); | |
2063 octave_idx_type* piwork = iwork.fortran_vec (); | |
2064 | |
2065 F77_XFCN (sgelsd, SGELSD, (m, n, nrhs, tmp_data, m, pretval, maxmn, | |
2066 ps, rcond, rank, work.fortran_vec (), | |
2067 lwork, piwork, info)); | |
2068 | |
2069 // The workspace query is broken in at least LAPACK 3.0.0 | |
2070 // through 3.1.1 when n >= mnthr. The obtuse formula below | |
2071 // should provide sufficient workspace for DGELSD to operate | |
2072 // efficiently. | |
2073 if (n >= mnthr) | |
2074 { | |
2075 const octave_idx_type wlalsd | |
2076 = 9*m + 2*m*smlsiz + 8*m*nlvl + m*nrhs + (smlsiz+1)*(smlsiz+1); | |
2077 | |
2078 octave_idx_type addend = m; | |
2079 | |
2080 if (2*m-4 > addend) | |
2081 addend = 2*m-4; | |
2082 | |
2083 if (nrhs > addend) | |
2084 addend = nrhs; | |
2085 | |
2086 if (n-3*m > addend) | |
2087 addend = n-3*m; | |
2088 | |
2089 if (wlalsd > addend) | |
2090 addend = wlalsd; | |
2091 | |
2092 const octave_idx_type lworkaround = 4*m + m*m + addend; | |
2093 | |
2094 if (work(0) < lworkaround) | |
2095 work(0) = lworkaround; | |
2096 } | |
2097 else if (m >= n) | |
2098 { | |
2099 octave_idx_type lworkaround | |
2100 = 12*n + 2*n*smlsiz + 8*n*nlvl + n*nrhs + (smlsiz+1)*(smlsiz+1); | |
2101 | |
2102 if (work(0) < lworkaround) | |
2103 work(0) = lworkaround; | |
2104 } | |
2105 | |
2106 lwork = static_cast<octave_idx_type> (work(0)); | |
2107 work.resize (lwork); | |
2108 | |
2109 F77_XFCN (sgelsd, SGELSD, (m, n, nrhs, tmp_data, m, pretval, | |
2110 maxmn, ps, rcond, rank, | |
2111 work.fortran_vec (), lwork, | |
2112 piwork, info)); | |
2113 | |
2114 if (rank < minmn) | |
2115 (*current_liboctave_warning_handler) | |
2116 ("dgelsd: rank deficient %dx%d matrix, rank = %d", m, n, rank); | |
2117 if (s.elem (0) == 0.0) | |
2118 rcond = 0.0; | |
2119 else | |
2120 rcond = s.elem (minmn - 1) / s.elem (0); | |
2121 | |
2122 retval.resize (n, nrhs); | |
2123 } | |
2124 | |
2125 return retval; | |
2126 } | |
2127 | |
2128 FloatComplexMatrix | |
2129 FloatMatrix::lssolve (const FloatComplexMatrix& b) const | |
2130 { | |
2131 FloatComplexMatrix tmp (*this); | |
2132 octave_idx_type info; | |
2133 octave_idx_type rank; | |
2134 float rcond; | |
2135 return tmp.lssolve (b, info, rank, rcond); | |
2136 } | |
2137 | |
2138 FloatComplexMatrix | |
2139 FloatMatrix::lssolve (const FloatComplexMatrix& b, octave_idx_type& info) const | |
2140 { | |
2141 FloatComplexMatrix tmp (*this); | |
2142 octave_idx_type rank; | |
2143 float rcond; | |
2144 return tmp.lssolve (b, info, rank, rcond); | |
2145 } | |
2146 | |
2147 FloatComplexMatrix | |
2148 FloatMatrix::lssolve (const FloatComplexMatrix& b, octave_idx_type& info, | |
2149 octave_idx_type& rank) const | |
2150 { | |
2151 FloatComplexMatrix tmp (*this); | |
2152 float rcond; | |
2153 return tmp.lssolve (b, info, rank, rcond); | |
2154 } | |
2155 | |
2156 FloatComplexMatrix | |
2157 FloatMatrix::lssolve (const FloatComplexMatrix& b, octave_idx_type& info, | |
2158 octave_idx_type& rank, float& rcond) const | |
2159 { | |
2160 FloatComplexMatrix tmp (*this); | |
2161 return tmp.lssolve (b, info, rank, rcond); | |
2162 } | |
2163 | |
2164 FloatColumnVector | |
2165 FloatMatrix::lssolve (const FloatColumnVector& b) const | |
2166 { | |
2167 octave_idx_type info; | |
2168 octave_idx_type rank; | |
2169 float rcond; | |
2170 return lssolve (b, info, rank, rcond); | |
2171 } | |
2172 | |
2173 FloatColumnVector | |
2174 FloatMatrix::lssolve (const FloatColumnVector& b, octave_idx_type& info) const | |
2175 { | |
2176 octave_idx_type rank; | |
2177 float rcond; | |
2178 return lssolve (b, info, rank, rcond); | |
2179 } | |
2180 | |
2181 FloatColumnVector | |
2182 FloatMatrix::lssolve (const FloatColumnVector& b, octave_idx_type& info, | |
2183 octave_idx_type& rank) const | |
2184 { | |
2185 float rcond; | |
2186 return lssolve (b, info, rank, rcond); | |
2187 } | |
2188 | |
2189 FloatColumnVector | |
2190 FloatMatrix::lssolve (const FloatColumnVector& b, octave_idx_type& info, | |
2191 octave_idx_type& rank, float &rcond) const | |
2192 { | |
2193 FloatColumnVector retval; | |
2194 | |
2195 octave_idx_type nrhs = 1; | |
2196 | |
2197 octave_idx_type m = rows (); | |
2198 octave_idx_type n = cols (); | |
2199 | |
2200 if (m != b.length ()) | |
2201 (*current_liboctave_error_handler) | |
2202 ("matrix dimension mismatch solution of linear equations"); | |
2203 else if (m == 0 || n == 0) | |
2204 retval = FloatColumnVector (n, 0.0); | |
2205 else | |
2206 { | |
2207 volatile octave_idx_type minmn = (m < n ? m : n); | |
2208 octave_idx_type maxmn = m > n ? m : n; | |
2209 rcond = -1.0; | |
2210 | |
2211 if (m != n) | |
2212 { | |
2213 retval = FloatColumnVector (maxmn, 0.0); | |
2214 | |
2215 for (octave_idx_type i = 0; i < m; i++) | |
2216 retval.elem (i) = b.elem (i); | |
2217 } | |
2218 else | |
2219 retval = b; | |
2220 | |
2221 FloatMatrix atmp = *this; | |
2222 float *tmp_data = atmp.fortran_vec (); | |
2223 | |
2224 float *pretval = retval.fortran_vec (); | |
2225 Array<float> s (minmn); | |
2226 float *ps = s.fortran_vec (); | |
2227 | |
2228 // Ask DGELSD what the dimension of WORK should be. | |
2229 octave_idx_type lwork = -1; | |
2230 | |
2231 Array<float> work (1); | |
2232 | |
2233 octave_idx_type smlsiz; | |
2234 F77_FUNC (xilaenv, XILAENV) (9, F77_CONST_CHAR_ARG2 ("SGELSD", 6), | |
2235 F77_CONST_CHAR_ARG2 (" ", 1), | |
2236 0, 0, 0, 0, smlsiz | |
2237 F77_CHAR_ARG_LEN (6) | |
2238 F77_CHAR_ARG_LEN (1)); | |
2239 | |
2240 // We compute the size of iwork because DGELSD in older versions | |
2241 // of LAPACK does not return it on a query call. | |
2242 float dminmn = static_cast<float> (minmn); | |
2243 float dsmlsizp1 = static_cast<float> (smlsiz+1); | |
2244 #if defined (HAVE_LOG2) | |
2245 float tmp = log2 (dminmn / dsmlsizp1); | |
2246 #else | |
2247 float tmp = log (dminmn / dsmlsizp1) / log (2.0); | |
2248 #endif | |
2249 octave_idx_type nlvl = static_cast<octave_idx_type> (tmp) + 1; | |
2250 if (nlvl < 0) | |
2251 nlvl = 0; | |
2252 | |
2253 octave_idx_type liwork = 3 * minmn * nlvl + 11 * minmn; | |
2254 if (liwork < 1) | |
2255 liwork = 1; | |
2256 Array<octave_idx_type> iwork (liwork); | |
2257 octave_idx_type* piwork = iwork.fortran_vec (); | |
2258 | |
2259 F77_XFCN (sgelsd, SGELSD, (m, n, nrhs, tmp_data, m, pretval, maxmn, | |
2260 ps, rcond, rank, work.fortran_vec (), | |
2261 lwork, piwork, info)); | |
2262 | |
2263 lwork = static_cast<octave_idx_type> (work(0)); | |
2264 work.resize (lwork); | |
2265 | |
2266 F77_XFCN (sgelsd, SGELSD, (m, n, nrhs, tmp_data, m, pretval, | |
2267 maxmn, ps, rcond, rank, | |
2268 work.fortran_vec (), lwork, | |
2269 piwork, info)); | |
2270 | |
2271 if (rank < minmn) | |
2272 { | |
2273 if (rank < minmn) | |
2274 (*current_liboctave_warning_handler) | |
2275 ("dgelsd: rank deficient %dx%d matrix, rank = %d", m, n, rank); | |
2276 if (s.elem (0) == 0.0) | |
2277 rcond = 0.0; | |
2278 else | |
2279 rcond = s.elem (minmn - 1) / s.elem (0); | |
2280 } | |
2281 | |
2282 retval.resize (n, nrhs); | |
2283 } | |
2284 | |
2285 return retval; | |
2286 } | |
2287 | |
2288 FloatComplexColumnVector | |
2289 FloatMatrix::lssolve (const FloatComplexColumnVector& b) const | |
2290 { | |
2291 FloatComplexMatrix tmp (*this); | |
2292 octave_idx_type info; | |
2293 octave_idx_type rank; | |
2294 float rcond; | |
2295 return tmp.lssolve (b, info, rank, rcond); | |
2296 } | |
2297 | |
2298 FloatComplexColumnVector | |
2299 FloatMatrix::lssolve (const FloatComplexColumnVector& b, octave_idx_type& info) const | |
2300 { | |
2301 FloatComplexMatrix tmp (*this); | |
2302 octave_idx_type rank; | |
2303 float rcond; | |
2304 return tmp.lssolve (b, info, rank, rcond); | |
2305 } | |
2306 | |
2307 FloatComplexColumnVector | |
2308 FloatMatrix::lssolve (const FloatComplexColumnVector& b, octave_idx_type& info, | |
2309 octave_idx_type& rank) const | |
2310 { | |
2311 FloatComplexMatrix tmp (*this); | |
2312 float rcond; | |
2313 return tmp.lssolve (b, info, rank, rcond); | |
2314 } | |
2315 | |
2316 FloatComplexColumnVector | |
2317 FloatMatrix::lssolve (const FloatComplexColumnVector& b, octave_idx_type& info, | |
2318 octave_idx_type& rank, float &rcond) const | |
2319 { | |
2320 FloatComplexMatrix tmp (*this); | |
2321 return tmp.lssolve (b, info, rank, rcond); | |
2322 } | |
2323 | |
2324 // Constants for matrix exponential calculation. | |
2325 | |
2326 static float padec [] = | |
2327 { | |
2328 5.0000000000000000e-1, | |
2329 1.1666666666666667e-1, | |
2330 1.6666666666666667e-2, | |
2331 1.6025641025641026e-3, | |
2332 1.0683760683760684e-4, | |
2333 4.8562548562548563e-6, | |
2334 1.3875013875013875e-7, | |
2335 1.9270852604185938e-9, | |
2336 }; | |
2337 | |
2338 static void | |
2339 solve_singularity_warning (float rcond) | |
2340 { | |
2341 (*current_liboctave_warning_handler) | |
2342 ("singular matrix encountered in expm calculation, rcond = %g", | |
2343 rcond); | |
2344 } | |
2345 | |
2346 FloatMatrix | |
2347 FloatMatrix::expm (void) const | |
2348 { | |
2349 FloatMatrix retval; | |
2350 | |
2351 FloatMatrix m = *this; | |
2352 | |
2353 if (numel () == 1) | |
2354 return FloatMatrix (1, 1, exp (m(0))); | |
2355 | |
2356 octave_idx_type nc = columns (); | |
2357 | |
2358 // Preconditioning step 1: trace normalization to reduce dynamic | |
2359 // range of poles, but avoid making stable eigenvalues unstable. | |
2360 | |
2361 // trace shift value | |
2362 volatile float trshift = 0.0; | |
2363 | |
2364 for (octave_idx_type i = 0; i < nc; i++) | |
2365 trshift += m.elem (i, i); | |
2366 | |
2367 trshift /= nc; | |
2368 | |
2369 if (trshift > 0.0) | |
2370 { | |
2371 for (octave_idx_type i = 0; i < nc; i++) | |
2372 m.elem (i, i) -= trshift; | |
2373 } | |
2374 | |
2375 // Preconditioning step 2: balancing; code follows development | |
2376 // in AEPBAL | |
2377 | |
2378 float *p_m = m.fortran_vec (); | |
2379 | |
2380 octave_idx_type info, ilo, ihi, ilos, ihis; | |
2381 Array<float> dpermute (nc); | |
2382 Array<float> dscale (nc); | |
2383 | |
2384 // permutation first | |
2385 char job = 'P'; | |
2386 F77_XFCN (sgebal, SGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), | |
2387 nc, p_m, nc, ilo, ihi, | |
2388 dpermute.fortran_vec (), info | |
2389 F77_CHAR_ARG_LEN (1))); | |
2390 | |
2391 // then scaling | |
2392 job = 'S'; | |
2393 F77_XFCN (sgebal, SGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), | |
2394 nc, p_m, nc, ilos, ihis, | |
2395 dscale.fortran_vec (), info | |
2396 F77_CHAR_ARG_LEN (1))); | |
2397 | |
2398 // Preconditioning step 3: scaling. | |
2399 | |
2400 FloatColumnVector work(nc); | |
2401 float inf_norm; | |
2402 | |
2403 F77_XFCN (xslange, XSLANGE, (F77_CONST_CHAR_ARG2 ("I", 1), | |
2404 nc, nc, m.fortran_vec (), nc, | |
2405 work.fortran_vec (), inf_norm | |
2406 F77_CHAR_ARG_LEN (1))); | |
2407 | |
2408 octave_idx_type sqpow = static_cast<octave_idx_type> (inf_norm > 0.0 | |
2409 ? (1.0 + log (inf_norm) / log (2.0)) | |
2410 : 0.0); | |
2411 | |
2412 // Check whether we need to square at all. | |
2413 | |
2414 if (sqpow < 0) | |
2415 sqpow = 0; | |
2416 | |
2417 if (sqpow > 0) | |
2418 { | |
2419 if (sqpow > 1023) | |
2420 sqpow = 1023; | |
2421 | |
2422 float scale_factor = 1.0; | |
2423 for (octave_idx_type i = 0; i < sqpow; i++) | |
2424 scale_factor *= 2.0; | |
2425 | |
2426 m = m / scale_factor; | |
2427 } | |
2428 | |
2429 // npp, dpp: pade' approx polynomial matrices. | |
2430 | |
2431 FloatMatrix npp (nc, nc, 0.0); | |
2432 float *pnpp = npp.fortran_vec (); | |
2433 FloatMatrix dpp = npp; | |
2434 float *pdpp = dpp.fortran_vec (); | |
2435 | |
2436 // Now powers a^8 ... a^1. | |
2437 | |
2438 octave_idx_type minus_one_j = -1; | |
2439 for (octave_idx_type j = 7; j >= 0; j--) | |
2440 { | |
2441 for (octave_idx_type i = 0; i < nc; i++) | |
2442 { | |
2443 octave_idx_type k = i * nc + i; | |
2444 pnpp[k] += padec[j]; | |
2445 pdpp[k] += minus_one_j * padec[j]; | |
2446 } | |
2447 | |
2448 npp = m * npp; | |
2449 pnpp = npp.fortran_vec (); | |
2450 | |
2451 dpp = m * dpp; | |
2452 pdpp = dpp.fortran_vec (); | |
2453 | |
2454 minus_one_j *= -1; | |
2455 } | |
2456 | |
2457 // Zero power. | |
2458 | |
2459 dpp = -dpp; | |
2460 for (octave_idx_type j = 0; j < nc; j++) | |
2461 { | |
2462 npp.elem (j, j) += 1.0; | |
2463 dpp.elem (j, j) += 1.0; | |
2464 } | |
2465 | |
2466 // Compute pade approximation = inverse (dpp) * npp. | |
2467 | |
2468 float rcond; | |
2469 retval = dpp.solve (npp, info, rcond, solve_singularity_warning); | |
2470 | |
2471 if (info < 0) | |
2472 return retval; | |
2473 | |
2474 // Reverse preconditioning step 3: repeated squaring. | |
2475 | |
2476 while (sqpow) | |
2477 { | |
2478 retval = retval * retval; | |
2479 sqpow--; | |
2480 } | |
2481 | |
2482 // Reverse preconditioning step 2: inverse balancing. | |
2483 // apply inverse scaling to computed exponential | |
2484 for (octave_idx_type i = 0; i < nc; i++) | |
2485 for (octave_idx_type j = 0; j < nc; j++) | |
2486 retval(i,j) *= dscale(i) / dscale(j); | |
2487 | |
2488 OCTAVE_QUIT; | |
2489 | |
2490 // construct balancing permutation vector | |
2491 Array<octave_idx_type> iperm (nc); | |
2492 for (octave_idx_type i = 0; i < nc; i++) | |
2493 iperm(i) = i; // identity permutation | |
2494 | |
2495 // leading permutations in forward order | |
2496 for (octave_idx_type i = 0; i < (ilo-1); i++) | |
2497 { | |
2498 octave_idx_type swapidx = static_cast<octave_idx_type> (dpermute(i)) - 1; | |
2499 octave_idx_type tmp = iperm(i); | |
2500 iperm(i) = iperm (swapidx); | |
2501 iperm(swapidx) = tmp; | |
2502 } | |
2503 | |
2504 // construct inverse balancing permutation vector | |
2505 Array<octave_idx_type> invpvec (nc); | |
2506 for (octave_idx_type i = 0; i < nc; i++) | |
2507 invpvec(iperm(i)) = i; // Thanks to R. A. Lippert for this method | |
2508 | |
2509 OCTAVE_QUIT; | |
2510 | |
2511 FloatMatrix tmpMat = retval; | |
2512 for (octave_idx_type i = 0; i < nc; i++) | |
2513 for (octave_idx_type j = 0; j < nc; j++) | |
2514 retval(i,j) = tmpMat(invpvec(i),invpvec(j)); | |
2515 | |
2516 OCTAVE_QUIT; | |
2517 | |
2518 for (octave_idx_type i = 0; i < nc; i++) | |
2519 iperm(i) = i; // identity permutation | |
2520 | |
2521 // trailing permutations must be done in reverse order | |
2522 for (octave_idx_type i = nc - 1; i >= ihi; i--) | |
2523 { | |
2524 octave_idx_type swapidx = static_cast<octave_idx_type> (dpermute(i)) - 1; | |
2525 octave_idx_type tmp = iperm(i); | |
2526 iperm(i) = iperm(swapidx); | |
2527 iperm(swapidx) = tmp; | |
2528 } | |
2529 | |
2530 // construct inverse balancing permutation vector | |
2531 for (octave_idx_type i = 0; i < nc; i++) | |
2532 invpvec(iperm(i)) = i; // Thanks to R. A. Lippert for this method | |
2533 | |
2534 OCTAVE_QUIT; | |
2535 | |
2536 tmpMat = retval; | |
2537 for (octave_idx_type i = 0; i < nc; i++) | |
2538 for (octave_idx_type j = 0; j < nc; j++) | |
2539 retval(i,j) = tmpMat(invpvec(i),invpvec(j)); | |
2540 | |
2541 // Reverse preconditioning step 1: fix trace normalization. | |
2542 | |
2543 if (trshift > 0.0) | |
2544 retval = expf (trshift) * retval; | |
2545 | |
2546 return retval; | |
2547 } | |
2548 | |
2549 FloatMatrix& | |
2550 FloatMatrix::operator += (const FloatDiagMatrix& a) | |
2551 { | |
2552 octave_idx_type nr = rows (); | |
2553 octave_idx_type nc = cols (); | |
2554 | |
2555 octave_idx_type a_nr = a.rows (); | |
2556 octave_idx_type a_nc = a.cols (); | |
2557 | |
2558 if (nr != a_nr || nc != a_nc) | |
2559 { | |
2560 gripe_nonconformant ("operator +=", nr, nc, a_nr, a_nc); | |
2561 return *this; | |
2562 } | |
2563 | |
2564 for (octave_idx_type i = 0; i < a.length (); i++) | |
2565 elem (i, i) += a.elem (i, i); | |
2566 | |
2567 return *this; | |
2568 } | |
2569 | |
2570 FloatMatrix& | |
2571 FloatMatrix::operator -= (const FloatDiagMatrix& a) | |
2572 { | |
2573 octave_idx_type nr = rows (); | |
2574 octave_idx_type nc = cols (); | |
2575 | |
2576 octave_idx_type a_nr = a.rows (); | |
2577 octave_idx_type a_nc = a.cols (); | |
2578 | |
2579 if (nr != a_nr || nc != a_nc) | |
2580 { | |
2581 gripe_nonconformant ("operator -=", nr, nc, a_nr, a_nc); | |
2582 return *this; | |
2583 } | |
2584 | |
2585 for (octave_idx_type i = 0; i < a.length (); i++) | |
2586 elem (i, i) -= a.elem (i, i); | |
2587 | |
2588 return *this; | |
2589 } | |
2590 | |
2591 // unary operations | |
2592 | |
2593 boolMatrix | |
2594 FloatMatrix::operator ! (void) const | |
2595 { | |
2596 octave_idx_type nr = rows (); | |
2597 octave_idx_type nc = cols (); | |
2598 | |
2599 boolMatrix b (nr, nc); | |
2600 | |
2601 for (octave_idx_type j = 0; j < nc; j++) | |
2602 for (octave_idx_type i = 0; i < nr; i++) | |
2603 b.elem (i, j) = ! elem (i, j); | |
2604 | |
2605 return b; | |
2606 } | |
2607 | |
2608 // column vector by row vector -> matrix operations | |
2609 | |
2610 FloatMatrix | |
2611 operator * (const FloatColumnVector& v, const FloatRowVector& a) | |
2612 { | |
2613 FloatMatrix retval; | |
2614 | |
2615 octave_idx_type len = v.length (); | |
2616 | |
2617 if (len != 0) | |
2618 { | |
2619 octave_idx_type a_len = a.length (); | |
2620 | |
2621 retval.resize (len, a_len); | |
2622 float *c = retval.fortran_vec (); | |
2623 | |
2624 F77_XFCN (sgemm, SGEMM, (F77_CONST_CHAR_ARG2 ("N", 1), | |
2625 F77_CONST_CHAR_ARG2 ("N", 1), | |
2626 len, a_len, 1, 1.0, v.data (), len, | |
2627 a.data (), 1, 0.0, c, len | |
2628 F77_CHAR_ARG_LEN (1) | |
2629 F77_CHAR_ARG_LEN (1))); | |
2630 } | |
2631 | |
2632 return retval; | |
2633 } | |
2634 | |
2635 // other operations. | |
2636 | |
2637 FloatMatrix | |
2638 FloatMatrix::map (dmapper fcn) const | |
2639 { | |
2640 return MArray2<float>::map<float> (func_ptr (fcn)); | |
2641 } | |
2642 | |
2643 FloatComplexMatrix | |
2644 FloatMatrix::map (cmapper fcn) const | |
2645 { | |
2646 return MArray2<float>::map<FloatComplex> (func_ptr (fcn)); | |
2647 } | |
2648 | |
2649 boolMatrix | |
2650 FloatMatrix::map (bmapper fcn) const | |
2651 { | |
2652 return MArray2<float>::map<bool> (func_ptr (fcn)); | |
2653 } | |
2654 | |
2655 bool | |
2656 FloatMatrix::any_element_is_negative (bool neg_zero) const | |
2657 { | |
2658 octave_idx_type nel = nelem (); | |
2659 | |
2660 if (neg_zero) | |
2661 { | |
2662 for (octave_idx_type i = 0; i < nel; i++) | |
2663 if (lo_ieee_signbit (elem (i))) | |
2664 return true; | |
2665 } | |
2666 else | |
2667 { | |
2668 for (octave_idx_type i = 0; i < nel; i++) | |
2669 if (elem (i) < 0) | |
2670 return true; | |
2671 } | |
2672 | |
2673 return false; | |
2674 } | |
2675 | |
2676 | |
2677 bool | |
2678 FloatMatrix::any_element_is_inf_or_nan (void) const | |
2679 { | |
2680 octave_idx_type nel = nelem (); | |
2681 | |
2682 for (octave_idx_type i = 0; i < nel; i++) | |
2683 { | |
2684 float val = elem (i); | |
2685 if (xisinf (val) || xisnan (val)) | |
2686 return true; | |
2687 } | |
2688 | |
2689 return false; | |
2690 } | |
2691 | |
2692 bool | |
2693 FloatMatrix::any_element_not_one_or_zero (void) const | |
2694 { | |
2695 octave_idx_type nel = nelem (); | |
2696 | |
2697 for (octave_idx_type i = 0; i < nel; i++) | |
2698 { | |
2699 float val = elem (i); | |
2700 if (val != 0 && val != 1) | |
2701 return true; | |
2702 } | |
2703 | |
2704 return false; | |
2705 } | |
2706 | |
2707 bool | |
2708 FloatMatrix::all_elements_are_int_or_inf_or_nan (void) const | |
2709 { | |
2710 octave_idx_type nel = nelem (); | |
2711 | |
2712 for (octave_idx_type i = 0; i < nel; i++) | |
2713 { | |
2714 float val = elem (i); | |
2715 if (xisnan (val) || D_NINT (val) == val) | |
2716 continue; | |
2717 else | |
2718 return false; | |
2719 } | |
2720 | |
2721 return true; | |
2722 } | |
2723 | |
2724 // Return nonzero if any element of M is not an integer. Also extract | |
2725 // the largest and smallest values and return them in MAX_VAL and MIN_VAL. | |
2726 | |
2727 bool | |
2728 FloatMatrix::all_integers (float& max_val, float& min_val) const | |
2729 { | |
2730 octave_idx_type nel = nelem (); | |
2731 | |
2732 if (nel > 0) | |
2733 { | |
2734 max_val = elem (0); | |
2735 min_val = elem (0); | |
2736 } | |
2737 else | |
2738 return false; | |
2739 | |
2740 for (octave_idx_type i = 0; i < nel; i++) | |
2741 { | |
2742 float val = elem (i); | |
2743 | |
2744 if (val > max_val) | |
2745 max_val = val; | |
2746 | |
2747 if (val < min_val) | |
2748 min_val = val; | |
2749 | |
2750 if (D_NINT (val) != val) | |
2751 return false; | |
2752 } | |
2753 | |
2754 return true; | |
2755 } | |
2756 | |
2757 bool | |
2758 FloatMatrix::too_large_for_float (void) const | |
2759 { | |
2760 octave_idx_type nel = nelem (); | |
2761 | |
2762 for (octave_idx_type i = 0; i < nel; i++) | |
2763 { | |
2764 float val = elem (i); | |
2765 | |
2766 if (! (xisnan (val) || xisinf (val)) | |
2767 && fabs (val) > FLT_MAX) | |
2768 return true; | |
2769 } | |
2770 | |
2771 return false; | |
2772 } | |
2773 | |
2774 // FIXME Do these really belong here? Maybe they should be | |
2775 // in a base class? | |
2776 | |
2777 boolMatrix | |
2778 FloatMatrix::all (int dim) const | |
2779 { | |
2780 MX_ALL_OP (dim); | |
2781 } | |
2782 | |
2783 boolMatrix | |
2784 FloatMatrix::any (int dim) const | |
2785 { | |
2786 MX_ANY_OP (dim); | |
2787 } | |
2788 | |
2789 FloatMatrix | |
2790 FloatMatrix::cumprod (int dim) const | |
2791 { | |
2792 MX_CUMULATIVE_OP (FloatMatrix, float, *=); | |
2793 } | |
2794 | |
2795 FloatMatrix | |
2796 FloatMatrix::cumsum (int dim) const | |
2797 { | |
2798 MX_CUMULATIVE_OP (FloatMatrix, float, +=); | |
2799 } | |
2800 | |
2801 FloatMatrix | |
2802 FloatMatrix::prod (int dim) const | |
2803 { | |
2804 MX_REDUCTION_OP (FloatMatrix, *=, 1.0, 1.0); | |
2805 } | |
2806 | |
2807 FloatMatrix | |
2808 FloatMatrix::sum (int dim) const | |
2809 { | |
2810 MX_REDUCTION_OP (FloatMatrix, +=, 0.0, 0.0); | |
2811 } | |
2812 | |
2813 FloatMatrix | |
2814 FloatMatrix::sumsq (int dim) const | |
2815 { | |
2816 #define ROW_EXPR \ | |
2817 float d = elem (i, j); \ | |
2818 retval.elem (i, 0) += d * d | |
2819 | |
2820 #define COL_EXPR \ | |
2821 float d = elem (i, j); \ | |
2822 retval.elem (0, j) += d * d | |
2823 | |
2824 MX_BASE_REDUCTION_OP (FloatMatrix, ROW_EXPR, COL_EXPR, 0.0, 0.0); | |
2825 | |
2826 #undef ROW_EXPR | |
2827 #undef COL_EXPR | |
2828 } | |
2829 | |
2830 FloatMatrix | |
2831 FloatMatrix::abs (void) const | |
2832 { | |
2833 octave_idx_type nr = rows (); | |
2834 octave_idx_type nc = cols (); | |
2835 | |
2836 FloatMatrix retval (nr, nc); | |
2837 | |
2838 for (octave_idx_type j = 0; j < nc; j++) | |
2839 for (octave_idx_type i = 0; i < nr; i++) | |
2840 retval (i, j) = fabs (elem (i, j)); | |
2841 | |
2842 return retval; | |
2843 } | |
2844 | |
2845 FloatMatrix | |
2846 FloatMatrix::diag (octave_idx_type k) const | |
2847 { | |
2848 return MArray2<float>::diag (k); | |
2849 } | |
2850 | |
2851 FloatColumnVector | |
2852 FloatMatrix::row_min (void) const | |
2853 { | |
2854 Array<octave_idx_type> dummy_idx; | |
2855 return row_min (dummy_idx); | |
2856 } | |
2857 | |
2858 FloatColumnVector | |
2859 FloatMatrix::row_min (Array<octave_idx_type>& idx_arg) const | |
2860 { | |
2861 FloatColumnVector result; | |
2862 | |
2863 octave_idx_type nr = rows (); | |
2864 octave_idx_type nc = cols (); | |
2865 | |
2866 if (nr > 0 && nc > 0) | |
2867 { | |
2868 result.resize (nr); | |
2869 idx_arg.resize (nr); | |
2870 | |
2871 for (octave_idx_type i = 0; i < nr; i++) | |
2872 { | |
2873 octave_idx_type idx_j; | |
2874 | |
2875 float tmp_min = octave_Float_NaN; | |
2876 | |
2877 for (idx_j = 0; idx_j < nc; idx_j++) | |
2878 { | |
2879 tmp_min = elem (i, idx_j); | |
2880 | |
2881 if (! xisnan (tmp_min)) | |
2882 break; | |
2883 } | |
2884 | |
2885 for (octave_idx_type j = idx_j+1; j < nc; j++) | |
2886 { | |
2887 float tmp = elem (i, j); | |
2888 | |
2889 if (xisnan (tmp)) | |
2890 continue; | |
2891 else if (tmp < tmp_min) | |
2892 { | |
2893 idx_j = j; | |
2894 tmp_min = tmp; | |
2895 } | |
2896 } | |
2897 | |
2898 result.elem (i) = tmp_min; | |
2899 idx_arg.elem (i) = xisnan (tmp_min) ? 0 : idx_j; | |
2900 } | |
2901 } | |
2902 | |
2903 return result; | |
2904 } | |
2905 | |
2906 FloatColumnVector | |
2907 FloatMatrix::row_max (void) const | |
2908 { | |
2909 Array<octave_idx_type> dummy_idx; | |
2910 return row_max (dummy_idx); | |
2911 } | |
2912 | |
2913 FloatColumnVector | |
2914 FloatMatrix::row_max (Array<octave_idx_type>& idx_arg) const | |
2915 { | |
2916 FloatColumnVector result; | |
2917 | |
2918 octave_idx_type nr = rows (); | |
2919 octave_idx_type nc = cols (); | |
2920 | |
2921 if (nr > 0 && nc > 0) | |
2922 { | |
2923 result.resize (nr); | |
2924 idx_arg.resize (nr); | |
2925 | |
2926 for (octave_idx_type i = 0; i < nr; i++) | |
2927 { | |
2928 octave_idx_type idx_j; | |
2929 | |
2930 float tmp_max = octave_Float_NaN; | |
2931 | |
2932 for (idx_j = 0; idx_j < nc; idx_j++) | |
2933 { | |
2934 tmp_max = elem (i, idx_j); | |
2935 | |
2936 if (! xisnan (tmp_max)) | |
2937 break; | |
2938 } | |
2939 | |
2940 for (octave_idx_type j = idx_j+1; j < nc; j++) | |
2941 { | |
2942 float tmp = elem (i, j); | |
2943 | |
2944 if (xisnan (tmp)) | |
2945 continue; | |
2946 else if (tmp > tmp_max) | |
2947 { | |
2948 idx_j = j; | |
2949 tmp_max = tmp; | |
2950 } | |
2951 } | |
2952 | |
2953 result.elem (i) = tmp_max; | |
2954 idx_arg.elem (i) = xisnan (tmp_max) ? 0 : idx_j; | |
2955 } | |
2956 } | |
2957 | |
2958 return result; | |
2959 } | |
2960 | |
2961 FloatRowVector | |
2962 FloatMatrix::column_min (void) const | |
2963 { | |
2964 Array<octave_idx_type> dummy_idx; | |
2965 return column_min (dummy_idx); | |
2966 } | |
2967 | |
2968 FloatRowVector | |
2969 FloatMatrix::column_min (Array<octave_idx_type>& idx_arg) const | |
2970 { | |
2971 FloatRowVector result; | |
2972 | |
2973 octave_idx_type nr = rows (); | |
2974 octave_idx_type nc = cols (); | |
2975 | |
2976 if (nr > 0 && nc > 0) | |
2977 { | |
2978 result.resize (nc); | |
2979 idx_arg.resize (nc); | |
2980 | |
2981 for (octave_idx_type j = 0; j < nc; j++) | |
2982 { | |
2983 octave_idx_type idx_i; | |
2984 | |
2985 float tmp_min = octave_Float_NaN; | |
2986 | |
2987 for (idx_i = 0; idx_i < nr; idx_i++) | |
2988 { | |
2989 tmp_min = elem (idx_i, j); | |
2990 | |
2991 if (! xisnan (tmp_min)) | |
2992 break; | |
2993 } | |
2994 | |
2995 for (octave_idx_type i = idx_i+1; i < nr; i++) | |
2996 { | |
2997 float tmp = elem (i, j); | |
2998 | |
2999 if (xisnan (tmp)) | |
3000 continue; | |
3001 else if (tmp < tmp_min) | |
3002 { | |
3003 idx_i = i; | |
3004 tmp_min = tmp; | |
3005 } | |
3006 } | |
3007 | |
3008 result.elem (j) = tmp_min; | |
3009 idx_arg.elem (j) = xisnan (tmp_min) ? 0 : idx_i; | |
3010 } | |
3011 } | |
3012 | |
3013 return result; | |
3014 } | |
3015 | |
3016 FloatRowVector | |
3017 FloatMatrix::column_max (void) const | |
3018 { | |
3019 Array<octave_idx_type> dummy_idx; | |
3020 return column_max (dummy_idx); | |
3021 } | |
3022 | |
3023 FloatRowVector | |
3024 FloatMatrix::column_max (Array<octave_idx_type>& idx_arg) const | |
3025 { | |
3026 FloatRowVector result; | |
3027 | |
3028 octave_idx_type nr = rows (); | |
3029 octave_idx_type nc = cols (); | |
3030 | |
3031 if (nr > 0 && nc > 0) | |
3032 { | |
3033 result.resize (nc); | |
3034 idx_arg.resize (nc); | |
3035 | |
3036 for (octave_idx_type j = 0; j < nc; j++) | |
3037 { | |
3038 octave_idx_type idx_i; | |
3039 | |
3040 float tmp_max = octave_Float_NaN; | |
3041 | |
3042 for (idx_i = 0; idx_i < nr; idx_i++) | |
3043 { | |
3044 tmp_max = elem (idx_i, j); | |
3045 | |
3046 if (! xisnan (tmp_max)) | |
3047 break; | |
3048 } | |
3049 | |
3050 for (octave_idx_type i = idx_i+1; i < nr; i++) | |
3051 { | |
3052 float tmp = elem (i, j); | |
3053 | |
3054 if (xisnan (tmp)) | |
3055 continue; | |
3056 else if (tmp > tmp_max) | |
3057 { | |
3058 idx_i = i; | |
3059 tmp_max = tmp; | |
3060 } | |
3061 } | |
3062 | |
3063 result.elem (j) = tmp_max; | |
3064 idx_arg.elem (j) = xisnan (tmp_max) ? 0 : idx_i; | |
3065 } | |
3066 } | |
3067 | |
3068 return result; | |
3069 } | |
3070 | |
3071 std::ostream& | |
3072 operator << (std::ostream& os, const FloatMatrix& a) | |
3073 { | |
3074 for (octave_idx_type i = 0; i < a.rows (); i++) | |
3075 { | |
3076 for (octave_idx_type j = 0; j < a.cols (); j++) | |
3077 { | |
3078 os << " "; | |
3079 octave_write_float (os, a.elem (i, j)); | |
3080 } | |
3081 os << "\n"; | |
3082 } | |
3083 return os; | |
3084 } | |
3085 | |
3086 std::istream& | |
3087 operator >> (std::istream& is, FloatMatrix& a) | |
3088 { | |
3089 octave_idx_type nr = a.rows (); | |
3090 octave_idx_type nc = a.cols (); | |
3091 | |
3092 if (nr < 1 || nc < 1) | |
3093 is.clear (std::ios::badbit); | |
3094 else | |
3095 { | |
3096 float tmp; | |
3097 for (octave_idx_type i = 0; i < nr; i++) | |
3098 for (octave_idx_type j = 0; j < nc; j++) | |
3099 { | |
3100 tmp = octave_read_float (is); | |
3101 if (is) | |
3102 a.elem (i, j) = tmp; | |
3103 else | |
3104 goto done; | |
3105 } | |
3106 } | |
3107 | |
3108 done: | |
3109 | |
3110 return is; | |
3111 } | |
3112 | |
3113 FloatMatrix | |
3114 Givens (float x, float y) | |
3115 { | |
3116 float cc, s, temp_r; | |
3117 | |
3118 F77_FUNC (slartg, SLARTG) (x, y, cc, s, temp_r); | |
3119 | |
3120 FloatMatrix g (2, 2); | |
3121 | |
3122 g.elem (0, 0) = cc; | |
3123 g.elem (1, 1) = cc; | |
3124 g.elem (0, 1) = s; | |
3125 g.elem (1, 0) = -s; | |
3126 | |
3127 return g; | |
3128 } | |
3129 | |
3130 FloatMatrix | |
3131 Sylvester (const FloatMatrix& a, const FloatMatrix& b, const FloatMatrix& c) | |
3132 { | |
3133 FloatMatrix retval; | |
3134 | |
3135 // FIXME -- need to check that a, b, and c are all the same | |
3136 // size. | |
3137 | |
3138 // Compute Schur decompositions. | |
3139 | |
3140 FloatSCHUR as (a, "U"); | |
3141 FloatSCHUR bs (b, "U"); | |
3142 | |
3143 // Transform c to new coordinates. | |
3144 | |
3145 FloatMatrix ua = as.unitary_matrix (); | |
3146 FloatMatrix sch_a = as.schur_matrix (); | |
3147 | |
3148 FloatMatrix ub = bs.unitary_matrix (); | |
3149 FloatMatrix sch_b = bs.schur_matrix (); | |
3150 | |
3151 FloatMatrix cx = ua.transpose () * c * ub; | |
3152 | |
3153 // Solve the sylvester equation, back-transform, and return the | |
3154 // solution. | |
3155 | |
3156 octave_idx_type a_nr = a.rows (); | |
3157 octave_idx_type b_nr = b.rows (); | |
3158 | |
3159 float scale; | |
3160 octave_idx_type info; | |
3161 | |
3162 float *pa = sch_a.fortran_vec (); | |
3163 float *pb = sch_b.fortran_vec (); | |
3164 float *px = cx.fortran_vec (); | |
3165 | |
3166 F77_XFCN (strsyl, STRSYL, (F77_CONST_CHAR_ARG2 ("N", 1), | |
3167 F77_CONST_CHAR_ARG2 ("N", 1), | |
3168 1, a_nr, b_nr, pa, a_nr, pb, | |
3169 b_nr, px, a_nr, scale, info | |
3170 F77_CHAR_ARG_LEN (1) | |
3171 F77_CHAR_ARG_LEN (1))); | |
3172 | |
3173 | |
3174 // FIXME -- check info? | |
3175 | |
3176 retval = -ua*cx*ub.transpose (); | |
3177 | |
3178 return retval; | |
3179 } | |
3180 | |
3181 // matrix by matrix -> matrix operations | |
3182 | |
3183 /* Simple Dot Product, Matrix-Vector and Matrix-Matrix Unit tests | |
3184 %!assert([1 2 3] * [ 4 ; 5 ; 6], 32, 1e-14) | |
3185 %!assert([1 2 ; 3 4 ] * [5 ; 6], [17 ; 39 ], 1e-14) | |
3186 %!assert([1 2 ; 3 4 ] * [5 6 ; 7 8], [19 22; 43 50], 1e-14) | |
3187 */ | |
3188 | |
3189 /* Test some simple identities | |
3190 %!shared M, cv, rv | |
3191 %! M = randn(10,10); | |
3192 %! cv = randn(10,1); | |
3193 %! rv = randn(1,10); | |
3194 %!assert([M*cv,M*cv],M*[cv,cv],1e-14) | |
3195 %!assert([rv*M;rv*M],[rv;rv]*M,1e-14) | |
3196 %!assert(2*rv*cv,[rv,rv]*[cv;cv],1e-14) | |
3197 */ | |
3198 | |
3199 | |
3200 FloatMatrix | |
3201 operator * (const FloatMatrix& m, const FloatMatrix& a) | |
3202 { | |
3203 FloatMatrix retval; | |
3204 | |
3205 octave_idx_type nr = m.rows (); | |
3206 octave_idx_type nc = m.cols (); | |
3207 | |
3208 octave_idx_type a_nr = a.rows (); | |
3209 octave_idx_type a_nc = a.cols (); | |
3210 | |
3211 if (nc != a_nr) | |
3212 gripe_nonconformant ("operator *", nr, nc, a_nr, a_nc); | |
3213 else | |
3214 { | |
3215 if (nr == 0 || nc == 0 || a_nc == 0) | |
3216 retval.resize (nr, a_nc, 0.0); | |
3217 else | |
3218 { | |
3219 octave_idx_type ld = nr; | |
3220 octave_idx_type lda = a_nr; | |
3221 | |
3222 retval.resize (nr, a_nc); | |
3223 float *c = retval.fortran_vec (); | |
3224 | |
3225 if (a_nc == 1) | |
3226 { | |
3227 if (nr == 1) | |
3228 F77_FUNC (xsdot, XSDOT) (nc, m.data (), 1, a.data (), 1, *c); | |
3229 else | |
3230 { | |
3231 F77_XFCN (sgemv, SGEMV, (F77_CONST_CHAR_ARG2 ("N", 1), | |
3232 nr, nc, 1.0, m.data (), ld, | |
3233 a.data (), 1, 0.0, c, 1 | |
3234 F77_CHAR_ARG_LEN (1))); | |
3235 } | |
3236 } | |
3237 else | |
3238 { | |
3239 F77_XFCN (sgemm, SGEMM, (F77_CONST_CHAR_ARG2 ("N", 1), | |
3240 F77_CONST_CHAR_ARG2 ("N", 1), | |
3241 nr, a_nc, nc, 1.0, m.data (), | |
3242 ld, a.data (), lda, 0.0, c, nr | |
3243 F77_CHAR_ARG_LEN (1) | |
3244 F77_CHAR_ARG_LEN (1))); | |
3245 } | |
3246 } | |
3247 } | |
3248 | |
3249 return retval; | |
3250 } | |
3251 | |
3252 // FIXME -- it would be nice to share code among the min/max | |
3253 // functions below. | |
3254 | |
3255 #define EMPTY_RETURN_CHECK(T) \ | |
3256 if (nr == 0 || nc == 0) \ | |
3257 return T (nr, nc); | |
3258 | |
3259 FloatMatrix | |
3260 min (float d, const FloatMatrix& m) | |
3261 { | |
3262 octave_idx_type nr = m.rows (); | |
3263 octave_idx_type nc = m.columns (); | |
3264 | |
3265 EMPTY_RETURN_CHECK (FloatMatrix); | |
3266 | |
3267 FloatMatrix result (nr, nc); | |
3268 | |
3269 for (octave_idx_type j = 0; j < nc; j++) | |
3270 for (octave_idx_type i = 0; i < nr; i++) | |
3271 { | |
3272 OCTAVE_QUIT; | |
3273 result (i, j) = xmin (d, m (i, j)); | |
3274 } | |
3275 | |
3276 return result; | |
3277 } | |
3278 | |
3279 FloatMatrix | |
3280 min (const FloatMatrix& m, float d) | |
3281 { | |
3282 octave_idx_type nr = m.rows (); | |
3283 octave_idx_type nc = m.columns (); | |
3284 | |
3285 EMPTY_RETURN_CHECK (FloatMatrix); | |
3286 | |
3287 FloatMatrix result (nr, nc); | |
3288 | |
3289 for (octave_idx_type j = 0; j < nc; j++) | |
3290 for (octave_idx_type i = 0; i < nr; i++) | |
3291 { | |
3292 OCTAVE_QUIT; | |
3293 result (i, j) = xmin (m (i, j), d); | |
3294 } | |
3295 | |
3296 return result; | |
3297 } | |
3298 | |
3299 FloatMatrix | |
3300 min (const FloatMatrix& a, const FloatMatrix& b) | |
3301 { | |
3302 octave_idx_type nr = a.rows (); | |
3303 octave_idx_type nc = a.columns (); | |
3304 | |
3305 if (nr != b.rows () || nc != b.columns ()) | |
3306 { | |
3307 (*current_liboctave_error_handler) | |
3308 ("two-arg min expecting args of same size"); | |
3309 return FloatMatrix (); | |
3310 } | |
3311 | |
3312 EMPTY_RETURN_CHECK (FloatMatrix); | |
3313 | |
3314 FloatMatrix result (nr, nc); | |
3315 | |
3316 for (octave_idx_type j = 0; j < nc; j++) | |
3317 for (octave_idx_type i = 0; i < nr; i++) | |
3318 { | |
3319 OCTAVE_QUIT; | |
3320 result (i, j) = xmin (a (i, j), b (i, j)); | |
3321 } | |
3322 | |
3323 return result; | |
3324 } | |
3325 | |
3326 FloatMatrix | |
3327 max (float d, const FloatMatrix& m) | |
3328 { | |
3329 octave_idx_type nr = m.rows (); | |
3330 octave_idx_type nc = m.columns (); | |
3331 | |
3332 EMPTY_RETURN_CHECK (FloatMatrix); | |
3333 | |
3334 FloatMatrix result (nr, nc); | |
3335 | |
3336 for (octave_idx_type j = 0; j < nc; j++) | |
3337 for (octave_idx_type i = 0; i < nr; i++) | |
3338 { | |
3339 OCTAVE_QUIT; | |
3340 result (i, j) = xmax (d, m (i, j)); | |
3341 } | |
3342 | |
3343 return result; | |
3344 } | |
3345 | |
3346 FloatMatrix | |
3347 max (const FloatMatrix& m, float d) | |
3348 { | |
3349 octave_idx_type nr = m.rows (); | |
3350 octave_idx_type nc = m.columns (); | |
3351 | |
3352 EMPTY_RETURN_CHECK (FloatMatrix); | |
3353 | |
3354 FloatMatrix result (nr, nc); | |
3355 | |
3356 for (octave_idx_type j = 0; j < nc; j++) | |
3357 for (octave_idx_type i = 0; i < nr; i++) | |
3358 { | |
3359 OCTAVE_QUIT; | |
3360 result (i, j) = xmax (m (i, j), d); | |
3361 } | |
3362 | |
3363 return result; | |
3364 } | |
3365 | |
3366 FloatMatrix | |
3367 max (const FloatMatrix& a, const FloatMatrix& b) | |
3368 { | |
3369 octave_idx_type nr = a.rows (); | |
3370 octave_idx_type nc = a.columns (); | |
3371 | |
3372 if (nr != b.rows () || nc != b.columns ()) | |
3373 { | |
3374 (*current_liboctave_error_handler) | |
3375 ("two-arg max expecting args of same size"); | |
3376 return FloatMatrix (); | |
3377 } | |
3378 | |
3379 EMPTY_RETURN_CHECK (FloatMatrix); | |
3380 | |
3381 FloatMatrix result (nr, nc); | |
3382 | |
3383 for (octave_idx_type j = 0; j < nc; j++) | |
3384 for (octave_idx_type i = 0; i < nr; i++) | |
3385 { | |
3386 OCTAVE_QUIT; | |
3387 result (i, j) = xmax (a (i, j), b (i, j)); | |
3388 } | |
3389 | |
3390 return result; | |
3391 } | |
3392 | |
3393 MS_CMP_OPS(FloatMatrix, , float, ) | |
3394 MS_BOOL_OPS(FloatMatrix, float, 0.0) | |
3395 | |
3396 SM_CMP_OPS(float, , FloatMatrix, ) | |
3397 SM_BOOL_OPS(float, FloatMatrix, 0.0) | |
3398 | |
3399 MM_CMP_OPS(FloatMatrix, , FloatMatrix, ) | |
3400 MM_BOOL_OPS(FloatMatrix, FloatMatrix, 0.0) | |
3401 | |
3402 /* | |
3403 ;;; Local Variables: *** | |
3404 ;;; mode: C++ *** | |
3405 ;;; End: *** | |
3406 */ |