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