Mercurial > octave
annotate src/DLD-FUNCTIONS/schur.cc @ 10154:40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Wed, 20 Jan 2010 17:33:41 -0500 |
parents | 09da0bd91412 |
children | d0ce5e973937 |
rev | line source |
---|---|
2928 | 1 /* |
2 | |
8920 | 3 Copyright (C) 1996, 1997, 1999, 2000, 2004, 2005, 2006, 2007, 2008, 2009 |
7017 | 4 John W. Eaton |
2928 | 5 |
6 This file is part of Octave. | |
7 | |
8 Octave is free software; you can redistribute it and/or modify it | |
9 under the terms of the GNU General Public License as published by the | |
7016 | 10 Free Software Foundation; either version 3 of the License, or (at your |
11 option) any later version. | |
2928 | 12 |
13 Octave is distributed in the hope that it will be useful, but WITHOUT | |
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
16 for more details. | |
17 | |
18 You should have received a copy of the GNU General Public License | |
7016 | 19 along with Octave; see the file COPYING. If not, see |
20 <http://www.gnu.org/licenses/>. | |
2928 | 21 |
22 */ | |
23 | |
24 #ifdef HAVE_CONFIG_H | |
25 #include <config.h> | |
26 #endif | |
27 | |
28 #include <string> | |
29 | |
30 #include "CmplxSCHUR.h" | |
31 #include "dbleSCHUR.h" | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
32 #include "fCmplxSCHUR.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
33 #include "floatSCHUR.h" |
2928 | 34 |
35 #include "defun-dld.h" | |
36 #include "error.h" | |
37 #include "gripes.h" | |
38 #include "oct-obj.h" | |
39 #include "utils.h" | |
40 | |
41 DEFUN_DLD (schur, args, nargout, | |
3548 | 42 "-*- texinfo -*-\n\ |
3372 | 43 @deftypefn {Loadable Function} {@var{s} =} schur (@var{a})\n\ |
44 @deftypefnx {Loadable Function} {[@var{u}, @var{s}] =} schur (@var{a}, @var{opt})\n\ | |
45 @cindex Schur decomposition\n\ | |
46 The Schur decomposition is used to compute eigenvalues of a\n\ | |
47 square matrix, and has applications in the solution of algebraic\n\ | |
48 Riccati equations in control (see @code{are} and @code{dare}).\n\ | |
49 @code{schur} always returns\n\ | |
50 @tex\n\ | |
51 $S = U^T A U$\n\ | |
52 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
53 @ifnottex\n\ |
3372 | 54 @code{s = u' * a * u}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
55 @end ifnottex\n\ |
3372 | 56 where\n\ |
57 @tex\n\ | |
58 $U$\n\ | |
59 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
60 @ifnottex\n\ |
3372 | 61 @code{u}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
62 @end ifnottex\n\ |
3372 | 63 is a unitary matrix\n\ |
64 @tex\n\ | |
65 ($U^T U$ is identity)\n\ | |
66 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
67 @ifnottex\n\ |
3372 | 68 (@code{u'* u} is identity)\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
69 @end ifnottex\n\ |
3372 | 70 and\n\ |
71 @tex\n\ | |
72 $S$\n\ | |
73 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
74 @ifnottex\n\ |
3372 | 75 @code{s}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
76 @end ifnottex\n\ |
3372 | 77 is upper triangular. The eigenvalues of\n\ |
78 @tex\n\ | |
79 $A$ (and $S$)\n\ | |
80 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
81 @ifnottex\n\ |
3372 | 82 @code{a} (and @code{s})\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
83 @end ifnottex\n\ |
3372 | 84 are the diagonal elements of\n\ |
85 @tex\n\ | |
5555 | 86 $S$.\n\ |
3372 | 87 @end tex\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
88 @ifnottex\n\ |
5555 | 89 @code{s}.\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
90 @end ifnottex\n\ |
3372 | 91 If the matrix\n\ |
92 @tex\n\ | |
93 $A$\n\ | |
94 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
95 @ifnottex\n\ |
3372 | 96 @code{a}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
97 @end ifnottex\n\ |
3372 | 98 is real, then the real Schur decomposition is computed, in which the\n\ |
99 matrix\n\ | |
100 @tex\n\ | |
101 $U$\n\ | |
102 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
103 @ifnottex\n\ |
3372 | 104 @code{u}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
105 @end ifnottex\n\ |
3372 | 106 is orthogonal and\n\ |
107 @tex\n\ | |
108 $S$\n\ | |
109 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
110 @ifnottex\n\ |
3372 | 111 @code{s}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
112 @end ifnottex\n\ |
3372 | 113 is block upper triangular\n\ |
114 with blocks of size at most\n\ | |
115 @tex\n\ | |
116 $2\\times 2$\n\ | |
117 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
118 @ifnottex\n\ |
3372 | 119 @code{2 x 2}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
120 @end ifnottex\n\ |
3600 | 121 along the diagonal. The diagonal elements of\n\ |
3372 | 122 @tex\n\ |
123 $S$\n\ | |
124 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
125 @ifnottex\n\ |
3372 | 126 @code{s}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
127 @end ifnottex\n\ |
3372 | 128 (or the eigenvalues of the\n\ |
129 @tex\n\ | |
130 $2\\times 2$\n\ | |
131 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
132 @ifnottex\n\ |
3372 | 133 @code{2 x 2}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
134 @end ifnottex\n\ |
3372 | 135 blocks, when\n\ |
136 appropriate) are the eigenvalues of\n\ | |
137 @tex\n\ | |
138 $A$\n\ | |
139 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
140 @ifnottex\n\ |
3372 | 141 @code{a}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
142 @end ifnottex\n\ |
3372 | 143 and\n\ |
144 @tex\n\ | |
145 $S$.\n\ | |
146 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
147 @ifnottex\n\ |
3372 | 148 @code{s}.\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
149 @end ifnottex\n\ |
2928 | 150 \n\ |
3372 | 151 The eigenvalues are optionally ordered along the diagonal according to\n\ |
152 the value of @code{opt}. @code{opt = \"a\"} indicates that all\n\ | |
153 eigenvalues with negative real parts should be moved to the leading\n\ | |
154 block of\n\ | |
155 @tex\n\ | |
156 $S$\n\ | |
157 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
158 @ifnottex\n\ |
3372 | 159 @code{s}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
160 @end ifnottex\n\ |
3372 | 161 (used in @code{are}), @code{opt = \"d\"} indicates that all eigenvalues\n\ |
162 with magnitude less than one should be moved to the leading block of\n\ | |
163 @tex\n\ | |
164 $S$\n\ | |
165 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
166 @ifnottex\n\ |
3372 | 167 @code{s}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
168 @end ifnottex\n\ |
3372 | 169 (used in @code{dare}), and @code{opt = \"u\"}, the default, indicates that\n\ |
170 no ordering of eigenvalues should occur. The leading\n\ | |
171 @tex\n\ | |
172 $k$\n\ | |
173 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
174 @ifnottex\n\ |
3372 | 175 @code{k}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
176 @end ifnottex\n\ |
3372 | 177 columns of\n\ |
178 @tex\n\ | |
179 $U$\n\ | |
180 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
181 @ifnottex\n\ |
3372 | 182 @code{u}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
183 @end ifnottex\n\ |
3372 | 184 always span the\n\ |
185 @tex\n\ | |
186 $A$-invariant\n\ | |
187 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
188 @ifnottex\n\ |
3372 | 189 @code{a}-invariant\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
190 @end ifnottex\n\ |
3372 | 191 subspace corresponding to the\n\ |
192 @tex\n\ | |
193 $k$\n\ | |
194 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
195 @ifnottex\n\ |
3372 | 196 @code{k}\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
197 @end ifnottex\n\ |
3372 | 198 leading eigenvalues of\n\ |
199 @tex\n\ | |
200 $S$.\n\ | |
201 @end tex\n\ | |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
202 @ifnottex\n\ |
3372 | 203 @code{s}.\n\ |
8517
81d6ab3ac93c
Allow documentation tobe built for other formats than tex and info
sh@sh-laptop
parents:
7814
diff
changeset
|
204 @end ifnottex\n\ |
3372 | 205 @end deftypefn") |
2928 | 206 { |
207 octave_value_list retval; | |
208 | |
209 int nargin = args.length (); | |
210 | |
211 if (nargin < 1 || nargin > 2 || nargout > 2) | |
212 { | |
5823 | 213 print_usage (); |
2928 | 214 return retval; |
215 } | |
216 | |
217 octave_value arg = args(0); | |
218 | |
3523 | 219 std::string ord; |
2928 | 220 |
221 if (nargin == 2) | |
222 { | |
223 ord = args(1).string_value (); | |
224 | |
225 if (error_state) | |
10154
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
226 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
227 error ("schur: expecting string as second argument"); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
228 return retval; |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
229 } |
2928 | 230 } |
231 | |
232 char ord_char = ord.empty () ? 'U' : ord[0]; | |
233 | |
234 if (ord_char != 'U' && ord_char != 'A' && ord_char != 'D' | |
235 && ord_char != 'u' && ord_char != 'a' && ord_char != 'd') | |
236 { | |
237 warning ("schur: incorrect ordered schur argument `%c'", | |
10154
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
238 ord.c_str ()); |
2928 | 239 return retval; |
240 } | |
241 | |
5275 | 242 octave_idx_type nr = arg.rows (); |
243 octave_idx_type nc = arg.columns (); | |
2928 | 244 |
245 int arg_is_empty = empty_arg ("schur", nr, nc); | |
246 | |
247 if (arg_is_empty < 0) | |
248 return retval; | |
249 else if (arg_is_empty > 0) | |
250 return octave_value_list (2, Matrix ()); | |
251 | |
252 if (nr != nc) | |
253 { | |
254 gripe_square_matrix_required ("schur"); | |
255 return retval; | |
256 } | |
257 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
258 if (arg.is_single_type ()) |
2928 | 259 { |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
260 if (arg.is_real_type ()) |
10154
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
261 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
262 FloatMatrix tmp = arg.float_matrix_value (); |
2928 | 263 |
10154
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
264 if (! error_state) |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
265 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
266 if (nargout == 0 || nargout == 1) |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
267 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
268 FloatSCHUR result (tmp, ord, false); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
269 retval(0) = result.schur_matrix (); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
270 } |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
271 else |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
272 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
273 FloatSCHUR result (tmp, ord, true); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
274 retval(1) = result.schur_matrix (); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
275 retval(0) = result.unitary_matrix (); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
276 } |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
277 } |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
278 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
279 else if (arg.is_complex_type ()) |
10154
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
280 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
281 FloatComplexMatrix ctmp = arg.float_complex_matrix_value (); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
282 |
10154
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
283 if (! error_state) |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
284 { |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
285 |
10154
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
286 if (nargout == 0 || nargout == 1) |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
287 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
288 FloatComplexSCHUR result (ctmp, ord, false); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
289 retval(0) = result.schur_matrix (); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
290 } |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
291 else |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
292 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
293 FloatComplexSCHUR result (ctmp, ord, true); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
294 retval(1) = result.schur_matrix (); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
295 retval(0) = result.unitary_matrix (); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
296 } |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
297 } |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
298 } |
2928 | 299 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
300 else |
2928 | 301 { |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
302 if (arg.is_real_type ()) |
10154
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
303 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
304 Matrix tmp = arg.matrix_value (); |
2928 | 305 |
10154
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
306 if (! error_state) |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
307 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
308 if (nargout == 0 || nargout == 1) |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
309 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
310 SCHUR result (tmp, ord, false); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
311 retval(0) = result.schur_matrix (); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
312 } |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
313 else |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
314 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
315 SCHUR result (tmp, ord, true); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
316 retval(1) = result.schur_matrix (); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
317 retval(0) = result.unitary_matrix (); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
318 } |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
319 } |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
320 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
321 else if (arg.is_complex_type ()) |
10154
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
322 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
323 ComplexMatrix ctmp = arg.complex_matrix_value (); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
324 |
10154
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
325 if (! error_state) |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
326 { |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
327 |
10154
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
328 if (nargout == 0 || nargout == 1) |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
329 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
330 ComplexSCHUR result (ctmp, ord, false); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
331 retval(0) = result.schur_matrix (); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
332 } |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
333 else |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
334 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
335 ComplexSCHUR result (ctmp, ord, true); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
336 retval(1) = result.schur_matrix (); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
337 retval(0) = result.unitary_matrix (); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
338 } |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
339 } |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
340 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7017
diff
changeset
|
341 else |
10154
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
342 { |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
343 gripe_wrong_type_arg ("schur", arg); |
40dfc0c99116
DLD-FUNCTIONS/*.cc: untabify
John W. Eaton <jwe@octave.org>
parents:
9758
diff
changeset
|
344 } |
2928 | 345 } |
346 | |
347 return retval; | |
348 } | |
349 | |
350 /* | |
7814
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
351 |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
352 %!test |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
353 %! a = [1, 2, 3; 4, 5, 9; 7, 8, 6]; |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
354 %! [u, s] = schur (a); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
355 %! assert(u' * a * u, s, sqrt (eps)); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
356 |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
357 %!test |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
358 %! a = single([1, 2, 3; 4, 5, 9; 7, 8, 6]); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
359 %! [u, s] = schur (a); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
360 %! assert(u' * a * u, s, sqrt (eps('single'))); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
361 |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
362 %!test |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
363 %! fail("schur ([1, 2; 3, 4], 2)","warning"); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
364 |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
365 %!error <Invalid call to schur.*> schur (); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
366 %!error schur ([1, 2, 3; 4, 5, 6]); |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
367 |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
368 */ |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
369 |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
370 |
87865ed7405f
Second set of single precision test code and fix of resulting bugs
David Bateman <dbateman@free.fr>
parents:
7789
diff
changeset
|
371 /* |
2928 | 372 ;;; Local Variables: *** |
373 ;;; mode: C++ *** | |
374 ;;; End: *** | |
375 */ |