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