GNU Octave  9.1.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
CDiagMatrix.cc
Go to the documentation of this file.
1 ////////////////////////////////////////////////////////////////////////
2 //
3 // Copyright (C) 1994-2024 The Octave Project Developers
4 //
5 // See the file COPYRIGHT.md in the top-level directory of this
6 // distribution or <https://octave.org/copyright/>.
7 //
8 // This file is part of Octave.
9 //
10 // Octave is free software: you can redistribute it and/or modify it
11 // under the terms of the GNU General Public License as published by
12 // the Free Software Foundation, either version 3 of the License, or
13 // (at your option) any later version.
14 //
15 // Octave is distributed in the hope that it will be useful, but
16 // WITHOUT ANY WARRANTY; without even the implied warranty of
17 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 // GNU General Public License for more details.
19 //
20 // You should have received a copy of the GNU General Public License
21 // along with Octave; see the file COPYING. If not, see
22 // <https://www.gnu.org/licenses/>.
23 //
24 ////////////////////////////////////////////////////////////////////////
25 
26 #if defined (HAVE_CONFIG_H)
27 # include "config.h"
28 #endif
29 
30 #include <ostream>
31 
32 #include "Array-util.h"
33 #include "lo-error.h"
34 #include "lo-ieee.h"
35 #include "mx-base.h"
36 #include "mx-inlines.cc"
37 #include "oct-cmplx.h"
38 
39 // Complex Diagonal Matrix class
40 
42  : MDiagArray2<Complex> (a.rows (), a.cols ())
43 {
44  for (octave_idx_type i = 0; i < length (); i++)
45  elem (i, i) = a.elem (i, i);
46 }
47 
48 bool
50 {
51  if (rows () != a.rows () || cols () != a.cols ())
52  return 0;
53 
54  return mx_inline_equal (length (), data (), a.data ());
55 }
56 
57 bool
59 {
60  return !(*this == a);
61 }
62 
65 {
66  for (octave_idx_type i = 0; i < length (); i++)
67  elem (i, i) = val;
68  return *this;
69 }
70 
73 {
74  for (octave_idx_type i = 0; i < length (); i++)
75  elem (i, i) = val;
76  return *this;
77 }
78 
81 {
82  if (beg < 0 || end >= length () || end < beg)
83  (*current_liboctave_error_handler) ("range error for fill");
84 
85  for (octave_idx_type i = beg; i <= end; i++)
86  elem (i, i) = val;
87 
88  return *this;
89 }
90 
94 {
95  if (beg < 0 || end >= length () || end < beg)
96  (*current_liboctave_error_handler) ("range error for fill");
97 
98  for (octave_idx_type i = beg; i <= end; i++)
99  elem (i, i) = val;
100 
101  return *this;
102 }
103 
106 {
108  if (a.numel () != len)
109  (*current_liboctave_error_handler) ("range error for fill");
110 
111  for (octave_idx_type i = 0; i < len; i++)
112  elem (i, i) = a.elem (i);
113 
114  return *this;
115 }
116 
119 {
121  if (a.numel () != len)
122  (*current_liboctave_error_handler) ("range error for fill");
123 
124  for (octave_idx_type i = 0; i < len; i++)
125  elem (i, i) = a.elem (i);
126 
127  return *this;
128 }
129 
132 {
134  if (a.numel () != len)
135  (*current_liboctave_error_handler) ("range error for fill");
136 
137  for (octave_idx_type i = 0; i < len; i++)
138  elem (i, i) = a.elem (i);
139 
140  return *this;
141 }
142 
145 {
147  if (a.numel () != len)
148  (*current_liboctave_error_handler) ("range error for fill");
149 
150  for (octave_idx_type i = 0; i < len; i++)
151  elem (i, i) = a.elem (i);
152 
153  return *this;
154 }
155 
158 {
159  octave_idx_type a_len = a.numel ();
160  if (beg < 0 || beg + a_len >= length ())
161  (*current_liboctave_error_handler) ("range error for fill");
162 
163  for (octave_idx_type i = 0; i < a_len; i++)
164  elem (i+beg, i+beg) = a.elem (i);
165 
166  return *this;
167 }
168 
171 {
172  octave_idx_type a_len = a.numel ();
173  if (beg < 0 || beg + a_len >= length ())
174  (*current_liboctave_error_handler) ("range error for fill");
175 
176  for (octave_idx_type i = 0; i < a_len; i++)
177  elem (i+beg, i+beg) = a.elem (i);
178 
179  return *this;
180 }
181 
184 {
185  octave_idx_type a_len = a.numel ();
186  if (beg < 0 || beg + a_len >= length ())
187  (*current_liboctave_error_handler) ("range error for fill");
188 
189  for (octave_idx_type i = 0; i < a_len; i++)
190  elem (i+beg, i+beg) = a.elem (i);
191 
192  return *this;
193 }
194 
197 {
198  octave_idx_type a_len = a.numel ();
199  if (beg < 0 || beg + a_len >= length ())
200  (*current_liboctave_error_handler) ("range error for fill");
201 
202  for (octave_idx_type i = 0; i < a_len; i++)
203  elem (i+beg, i+beg) = a.elem (i);
204 
205  return *this;
206 }
207 
210 {
211  return DiagMatrix (extract_diag ().abs (), rows (), columns ());
212 }
213 
216 {
217  return ComplexDiagMatrix (conj (a.extract_diag ()), a.rows (), a.columns ());
218 }
219 
220 // resize is the destructive analog for this one
221 
224  octave_idx_type r2, octave_idx_type c2) const
225 {
226  if (r1 > r2) { std::swap (r1, r2); }
227  if (c1 > c2) { std::swap (c1, c2); }
228 
229  octave_idx_type new_r = r2 - r1 + 1;
230  octave_idx_type new_c = c2 - c1 + 1;
231 
232  ComplexMatrix result (new_r, new_c);
233 
234  for (octave_idx_type j = 0; j < new_c; j++)
235  for (octave_idx_type i = 0; i < new_r; i++)
236  result.elem (i, j) = elem (r1+i, c1+j);
237 
238  return result;
239 }
240 
241 // extract row or column i.
242 
245 {
246  octave_idx_type r = rows ();
247  octave_idx_type c = cols ();
248  if (i < 0 || i >= r)
249  (*current_liboctave_error_handler) ("invalid row selection");
250 
251  ComplexRowVector retval (c, 0.0);
252  if (r <= c || i < c)
253  retval.elem (i) = elem (i, i);
254 
255  return retval;
256 }
257 
259 ComplexDiagMatrix::row (char *s) const
260 {
261  if (! s)
262  (*current_liboctave_error_handler) ("invalid row selection");
263 
264  char c = s[0];
265  if (c == 'f' || c == 'F')
266  return row (static_cast<octave_idx_type> (0));
267  else if (c == 'l' || c == 'L')
268  return row (rows () - 1);
269  else
270  (*current_liboctave_error_handler) ("invalid row selection");
271 }
272 
275 {
276  octave_idx_type r = rows ();
277  octave_idx_type c = cols ();
278  if (i < 0 || i >= c)
279  (*current_liboctave_error_handler) ("invalid column selection");
280 
281  ComplexColumnVector retval (r, 0.0);
282  if (r >= c || i < r)
283  retval.elem (i) = elem (i, i);
284 
285  return retval;
286 }
287 
290 {
291  if (! s)
292  (*current_liboctave_error_handler) ("invalid column selection");
293 
294  char c = s[0];
295  if (c == 'f' || c == 'F')
296  return column (static_cast<octave_idx_type> (0));
297  else if (c == 'l' || c == 'L')
298  return column (cols () - 1);
299  else
300  (*current_liboctave_error_handler) ("invalid column selection");
301 }
302 
305 {
306  octave_idx_type info;
307  return inverse (info);
308 }
309 
312 {
313  octave_idx_type r = rows ();
314  octave_idx_type c = cols ();
315  if (r != c)
316  (*current_liboctave_error_handler) ("inverse requires square matrix");
317 
318  ComplexDiagMatrix retval (r, c);
319 
320  info = 0;
321  octave_idx_type len = r; // alias for readability
322  octave_idx_type z_count = 0; // zeros
323  octave_idx_type nz_count = 0; // nonzeros
324  for (octave_idx_type i = 0; i < len; i++)
325  {
326  if (xelem (i, i) == 0.0)
327  {
328  z_count++;
329  if (nz_count > 0)
330  break;
331  }
332  else
333  {
334  nz_count++;
335  if (z_count > 0)
336  break;
337  retval.elem (i, i) = 1.0 / xelem (i, i);
338  }
339  }
340  if (nz_count == 0)
341  {
342  (*current_liboctave_error_handler)
343  ("inverse of the null matrix not defined");
344  }
345  else if (z_count > 0)
346  {
347  info = -1;
348  element_type *data = retval.fortran_vec ();
350  }
351 
352  return retval;
353 }
354 
357 {
358  octave_idx_type r = rows ();
359  octave_idx_type c = cols ();
361 
362  ComplexDiagMatrix retval (c, r);
363 
364  for (octave_idx_type i = 0; i < len; i++)
365  {
366  double val = std::abs (elem (i, i));
367  if (val < tol || val == 0.0)
368  retval.elem (i, i) = 0.0;
369  else
370  retval.elem (i, i) = 1.0 / elem (i, i);
371  }
372 
373  return retval;
374 }
375 
376 bool
378 {
379  return mx_inline_all_real (length (), data ());
380 }
381 
382 // diagonal matrix by diagonal matrix -> diagonal matrix operations
383 
386 {
387  octave_idx_type r = rows ();
388  octave_idx_type c = cols ();
389 
390  octave_idx_type a_nr = a.rows ();
391  octave_idx_type a_nc = a.cols ();
392 
393  if (r != a_nr || c != a_nc)
394  octave::err_nonconformant ("operator +=", r, c, a_nr, a_nc);
395 
396  if (r == 0 || c == 0)
397  return *this;
398 
399  Complex *d = fortran_vec (); // Ensures only one reference to my privates!
400 
401  mx_inline_add2 (length (), d, a.data ());
402  return *this;
403 }
404 
407 {
408  octave_idx_type a_nr = a.rows ();
409  octave_idx_type a_nc = a.cols ();
410 
411  octave_idx_type b_nr = b.rows ();
412  octave_idx_type b_nc = b.cols ();
413 
414  if (a_nc != b_nr)
415  octave::err_nonconformant ("operator *", a_nr, a_nc, b_nr, b_nc);
416 
417  ComplexDiagMatrix c (a_nr, b_nc);
418 
419  octave_idx_type len = c.length ();
420  octave_idx_type lenm = (len < a_nc ? len : a_nc);
421 
422  for (octave_idx_type i = 0; i < lenm; i++)
423  c.dgxelem (i) = a.dgelem (i) * b.dgelem (i);
424  for (octave_idx_type i = lenm; i < len; i++)
425  c.dgxelem (i) = 0.0;
426 
427  return c;
428 }
429 
432 {
433  octave_idx_type a_nr = a.rows ();
434  octave_idx_type a_nc = a.cols ();
435 
436  octave_idx_type b_nr = b.rows ();
437  octave_idx_type b_nc = b.cols ();
438 
439  if (a_nc != b_nr)
440  octave::err_nonconformant ("operator *", a_nr, a_nc, b_nr, b_nc);
441 
442  if (a_nr == 0 || a_nc == 0 || b_nc == 0)
443  return ComplexDiagMatrix (a_nr, a_nc, 0.0);
444 
445  ComplexDiagMatrix c (a_nr, b_nc);
446 
447  octave_idx_type len = (a_nr < b_nc ? a_nr : b_nc);
448 
449  for (octave_idx_type i = 0; i < len; i++)
450  {
451  double a_element = a.elem (i, i);
452  Complex b_element = b.elem (i, i);
453 
454  c.elem (i, i) = a_element * b_element;
455  }
456 
457  return c;
458 }
459 
462 {
463  octave_idx_type a_nr = a.rows ();
464  octave_idx_type a_nc = a.cols ();
465 
466  octave_idx_type b_nr = b.rows ();
467  octave_idx_type b_nc = b.cols ();
468 
469  if (a_nc != b_nr)
470  octave::err_nonconformant ("operator *", a_nr, a_nc, b_nr, b_nc);
471 
472  if (a_nr == 0 || a_nc == 0 || b_nc == 0)
473  return ComplexDiagMatrix (a_nr, a_nc, 0.0);
474 
475  ComplexDiagMatrix c (a_nr, b_nc);
476 
477  octave_idx_type len = (a_nr < b_nc ? a_nr : b_nc);
478 
479  for (octave_idx_type i = 0; i < len; i++)
480  {
481  Complex a_element = a.elem (i, i);
482  Complex b_element = b.elem (i, i);
483 
484  c.elem (i, i) = a_element * b_element;
485  }
486 
487  return c;
488 }
489 
490 // other operations
491 
494 {
495  ComplexDET det (1.0);
496  if (rows () != cols ())
497  (*current_liboctave_error_handler) ("determinant requires square matrix");
498 
500  for (octave_idx_type i = 0; i < len; i++)
501  det *= elem (i, i);
502 
503  return det;
504 }
505 
506 double
508 {
509  ColumnVector av = extract_diag (0).map<double> (std::abs);
510  double amx = av.max ();
511  double amn = av.min ();
512  return amx == 0 ? 0.0 : amn / amx;
513 }
514 
515 // i/o
516 
517 std::ostream&
518 operator << (std::ostream& os, const ComplexDiagMatrix& a)
519 {
520  Complex ZERO (0.0);
521 // int field_width = os.precision () + 7;
522  for (octave_idx_type i = 0; i < a.rows (); i++)
523  {
524  for (octave_idx_type j = 0; j < a.cols (); j++)
525  {
526  if (i == j)
527  os << ' ' /* setw (field_width) */ << a.elem (i, i);
528  else
529  os << ' ' /* setw (field_width) */ << ZERO;
530  }
531  os << "\n";
532  }
533  return os;
534 }
ComplexDiagMatrix operator*(const ComplexDiagMatrix &a, const DiagMatrix &b)
Definition: CDiagMatrix.cc:406
std::ostream & operator<<(std::ostream &os, const ComplexDiagMatrix &a)
Definition: CDiagMatrix.cc:518
ComplexDiagMatrix conj(const ComplexDiagMatrix &a)
Definition: CDiagMatrix.cc:215
#define Inf
Definition: Faddeeva.cc:260
T & elem(octave_idx_type n)
Size of the specified dimension.
Definition: Array.h:562
Array< U, A > map(F fcn) const
Apply function fcn to each element of the Array<T, Alloc>.
Definition: Array.h:859
octave_idx_type numel() const
Number of elements in the array.
Definition: Array.h:414
double min() const
Definition: dColVector.cc:245
double max() const
Definition: dColVector.cc:261
ComplexDET determinant() const
Definition: CDiagMatrix.cc:493
bool all_elements_are_real() const
Definition: CDiagMatrix.cc:377
ComplexDiagMatrix & fill(double val)
Definition: CDiagMatrix.cc:64
ComplexDiagMatrix()=default
ComplexRowVector row(octave_idx_type i) const
Definition: CDiagMatrix.cc:244
DiagMatrix abs() const
Definition: CDiagMatrix.cc:209
ComplexDiagMatrix & operator+=(const DiagMatrix &a)
Definition: CDiagMatrix.cc:385
ComplexDiagMatrix inverse() const
Definition: CDiagMatrix.cc:304
bool operator==(const ComplexDiagMatrix &a) const
Definition: CDiagMatrix.cc:49
ComplexMatrix extract(octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2) const
Definition: CDiagMatrix.cc:223
ComplexColumnVector column(octave_idx_type i) const
Definition: CDiagMatrix.cc:274
ComplexDiagMatrix pseudo_inverse(double tol=0.0) const
Definition: CDiagMatrix.cc:356
double rcond() const
Definition: CDiagMatrix.cc:507
Complex element_type
Definition: CDiagMatrix.h:49
bool operator!=(const ComplexDiagMatrix &a) const
Definition: CDiagMatrix.cc:58
ComplexColumnVector extract_diag(octave_idx_type k=0) const
Definition: CDiagMatrix.h:140
T * fortran_vec()
Definition: DiagArray2.h:171
octave_idx_type rows() const
Definition: DiagArray2.h:89
T dgelem(octave_idx_type i) const
Definition: DiagArray2.h:124
octave_idx_type length() const
Definition: DiagArray2.h:95
T elem(octave_idx_type r, octave_idx_type c) const
Definition: DiagArray2.h:117
T & dgxelem(octave_idx_type i)
Definition: DiagArray2.h:152
T xelem(octave_idx_type r, octave_idx_type c) const
Definition: DiagArray2.h:147
octave_idx_type columns() const
Definition: DiagArray2.h:91
octave_idx_type cols() const
Definition: DiagArray2.h:90
const T * data() const
Definition: DiagArray2.h:169
Template for two dimensional diagonal array with math operators.
Definition: MDiagArray2.h:56
Definition: DET.h:39
void err_nonconformant(const char *op, octave_idx_type op1_len, octave_idx_type op2_len)
OCTAVE_NORETURN liboctave_error_handler current_liboctave_error_handler
Definition: lo-error.c:41
F77_RET_T const F77_DBLE const F77_DBLE F77_DBLE * d
void mx_inline_add2(std::size_t n, R *r, const X *x)
Definition: mx-inlines.cc:127
bool mx_inline_all_real(std::size_t n, const std::complex< T > *x)
Definition: mx-inlines.cc:312
bool mx_inline_equal(std::size_t n, const T1 *x, const T2 *y)
Definition: mx-inlines.cc:577
T * r
Definition: mx-inlines.cc:781
std::complex< double > Complex
Definition: oct-cmplx.h:33
F77_RET_T len
Definition: xerbla.cc:61