|
529
|
1 // tc-rep.cc -*- C++ -*- |
|
492
|
2 /* |
|
|
3 |
|
|
4 Copyright (C) 1992, 1993, 1994 John W. Eaton |
|
|
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 |
|
|
10 Free Software Foundation; either version 2, or (at your option) any |
|
|
11 later version. |
|
|
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 |
|
|
19 along with Octave; see the file COPYING. If not, write to the Free |
|
|
20 Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
|
|
21 |
|
|
22 */ |
|
|
23 |
|
|
24 #ifdef HAVE_CONFIG_H |
|
|
25 #include "config.h" |
|
|
26 #endif |
|
|
27 |
|
|
28 #if defined (__GNUG__) |
|
|
29 #pragma implementation |
|
|
30 #endif |
|
|
31 |
|
|
32 #include <ctype.h> |
|
|
33 #include <string.h> |
|
|
34 #include <fstream.h> |
|
|
35 #include <iostream.h> |
|
|
36 #include <strstream.h> |
|
|
37 |
|
|
38 #include "mx-base.h" |
|
|
39 #include "Range.h" |
|
|
40 |
|
504
|
41 #include "arith-ops.h" |
|
492
|
42 #include "variables.h" |
|
|
43 #include "error.h" |
|
|
44 #include "gripes.h" |
|
|
45 #include "user-prefs.h" |
|
|
46 #include "utils.h" |
|
|
47 #include "pager.h" |
|
|
48 #include "pr-output.h" |
|
|
49 #include "tree-const.h" |
|
|
50 #include "idx-vector.h" |
|
|
51 |
|
|
52 #include "tc-inlines.cc" |
|
|
53 |
|
|
54 /* |
|
|
55 * How about a few macros? |
|
|
56 */ |
|
|
57 |
|
|
58 #ifndef MAX |
|
|
59 #define MAX(a,b) ((a) > (b) ? (a) : (b)) |
|
|
60 #endif |
|
|
61 |
|
|
62 #ifndef MIN |
|
|
63 #define MIN(a,b) ((a) < (b) ? (a) : (b)) |
|
|
64 #endif |
|
|
65 |
|
|
66 #ifndef ABS |
|
|
67 #define ABS(x) (((x) < 0) ? (-x) : (x)) |
|
|
68 #endif |
|
|
69 |
|
|
70 /* |
|
|
71 * The following are used by some of the functions in the |
|
|
72 * tree_constant_rep class that must deal with real and complex |
|
|
73 * matrices. This was not done with overloaded or virtual functions |
|
|
74 * from the Matrix class because there is no clean way to do that -- |
|
|
75 * the necessary functions (like elem) need to return values of |
|
|
76 * different types... |
|
|
77 */ |
|
|
78 |
|
|
79 // Given a tree_constant, and the names to be used for the real and |
|
|
80 // complex matrix and their dimensions, declare a real or complex |
|
|
81 // matrix, and initialize it from the tree_constant. Note that m, cm, |
|
|
82 // nr, and nc must not be previously declared, and they must not be |
|
|
83 // expressions. Since only one of the matrices will be defined after |
|
|
84 // this macro is used, only one set of dimesions is declared. |
|
|
85 |
|
|
86 // This macro only makes sense inside a friend or member function of |
|
|
87 // the tree_constant_rep class |
|
|
88 |
|
|
89 #define REP_RHS_MATRIX(tc,m,cm,nr,nc) \ |
|
|
90 int nr = 0; \ |
|
|
91 int nc = 0; \ |
|
|
92 Matrix m; \ |
|
|
93 ComplexMatrix cm; \ |
|
|
94 if ((tc).const_type () == tree_constant_rep::complex_matrix_constant) \ |
|
|
95 { \ |
|
|
96 cm = (tc).complex_matrix_value (); \ |
|
|
97 nr = (cm).rows (); \ |
|
|
98 nc = (cm).columns (); \ |
|
|
99 } \ |
|
|
100 else if ((tc).const_type () == tree_constant_rep::matrix_constant) \ |
|
|
101 { \ |
|
|
102 m = (tc).matrix_value (); \ |
|
|
103 nr = (m).rows (); \ |
|
|
104 nc = (m).columns (); \ |
|
|
105 } \ |
|
|
106 else \ |
|
|
107 abort (); |
|
|
108 |
|
|
109 // Assign a real or complex value to a tree_constant. |
|
|
110 // |
|
|
111 // This macro only makes sense inside a friend or member function of |
|
|
112 // the tree_constant_rep class. |
|
|
113 |
|
|
114 #define REP_ELEM_ASSIGN(i,j,rval,cval,real_type) \ |
|
|
115 do \ |
|
|
116 { \ |
|
|
117 if (type_tag == tree_constant_rep::matrix_constant) \ |
|
|
118 { \ |
|
|
119 if (real_type) \ |
|
|
120 matrix->elem ((i), (j)) = (rval); \ |
|
|
121 else \ |
|
|
122 abort (); \ |
|
|
123 } \ |
|
|
124 else \ |
|
|
125 { \ |
|
|
126 if (real_type) \ |
|
|
127 complex_matrix->elem ((i), (j)) = (rval); \ |
|
|
128 else \ |
|
|
129 complex_matrix->elem ((i), (j)) = (cval); \ |
|
|
130 } \ |
|
|
131 } \ |
|
|
132 while (0) |
|
|
133 |
|
|
134 // Given a real and complex matrix and row and column dimensions, |
|
|
135 // declare both and size one of them. Only one of the matrices should |
|
|
136 // be used after this macro has been used. |
|
|
137 |
|
|
138 // This macro only makes sense inside a friend or member function of |
|
|
139 // the tree_constant_rep class. |
|
|
140 |
|
|
141 #define CRMATRIX(m,cm,nr,nc) \ |
|
|
142 Matrix m; \ |
|
|
143 ComplexMatrix cm; \ |
|
|
144 if (type_tag == tree_constant_rep::matrix_constant) \ |
|
|
145 (m).resize ((nr), (nc)); \ |
|
|
146 else if (type_tag == complex_matrix_constant) \ |
|
|
147 (cm).resize ((nr), (nc)); \ |
|
|
148 else \ |
|
|
149 abort (); \ |
|
|
150 |
|
|
151 // Assign a real or complex matrix to a tree constant. |
|
|
152 |
|
|
153 // This macro only makes sense inside a friend or member function of |
|
|
154 // the tree_constant_rep class. |
|
|
155 |
|
|
156 #define ASSIGN_CRMATRIX_TO(tc,m,cm) \ |
|
|
157 do \ |
|
|
158 { \ |
|
|
159 if (type_tag == matrix_constant) \ |
|
|
160 tc = tree_constant (m); \ |
|
|
161 else \ |
|
|
162 tc = tree_constant (cm); \ |
|
|
163 } \ |
|
|
164 while (0) |
|
|
165 |
|
|
166 // Assign an element of this tree_constant_rep's real or complex |
|
|
167 // matrix to another real or complex matrix. |
|
|
168 |
|
|
169 // This macro only makes sense inside a friend or member function of |
|
|
170 // the tree_constant_rep class. |
|
|
171 |
|
|
172 #define CRMATRIX_ASSIGN_REP_ELEM(m,cm,i1,j1,i2,j2) \ |
|
|
173 do \ |
|
|
174 { \ |
|
|
175 if (type_tag == matrix_constant) \ |
|
|
176 (m).elem ((i1), (j1)) = matrix->elem ((i2), (j2)); \ |
|
|
177 else \ |
|
|
178 (cm).elem ((i1), (j1)) = complex_matrix->elem ((i2), (j2)); \ |
|
|
179 } \ |
|
|
180 while (0) |
|
|
181 |
|
|
182 // Assign a value to an element of a real or complex matrix. Assumes |
|
|
183 // that the lhs and rhs are either both real or both complex types. |
|
|
184 |
|
|
185 #define CRMATRIX_ASSIGN_ELEM(m,cm,i,j,rval,cval,real_type) \ |
|
|
186 do \ |
|
|
187 { \ |
|
|
188 if (real_type) \ |
|
|
189 (m).elem ((i), (j)) = (rval); \ |
|
|
190 else \ |
|
|
191 (cm).elem ((i), (j)) = (cval); \ |
|
|
192 } \ |
|
|
193 while (0) |
|
|
194 |
|
|
195 |
|
|
196 // A couple of handy helper functions. |
|
|
197 |
|
|
198 static int |
|
|
199 any_element_less_than (const Matrix& a, double val) |
|
|
200 { |
|
|
201 int nr = a.rows (); |
|
|
202 int nc = a.columns (); |
|
|
203 for (int j = 0; j < nc; j++) |
|
|
204 for (int i = 0; i < nr; i++) |
|
|
205 if (a.elem (i, j) < val) |
|
|
206 return 1; |
|
|
207 return 0; |
|
|
208 } |
|
|
209 |
|
|
210 static int |
|
|
211 any_element_greater_than (const Matrix& a, double val) |
|
|
212 { |
|
|
213 int nr = a.rows (); |
|
|
214 int nc = a.columns (); |
|
|
215 for (int j = 0; j < nc; j++) |
|
|
216 for (int i = 0; i < nr; i++) |
|
|
217 if (a.elem (i, j) > val) |
|
|
218 return 1; |
|
|
219 return 0; |
|
|
220 } |
|
|
221 |
|
|
222 static int |
|
|
223 any_element_is_complex (const ComplexMatrix& a) |
|
|
224 { |
|
|
225 int nr = a.rows (); |
|
|
226 int nc = a.columns (); |
|
|
227 for (int j = 0; j < nc; j++) |
|
|
228 for (int i = 0; i < nr; i++) |
|
|
229 if (imag (a.elem (i, j)) != 0.0) |
|
|
230 return 1; |
|
|
231 return 0; |
|
|
232 } |
|
|
233 |
|
|
234 // Now, the classes. |
|
|
235 |
|
|
236 /* |
|
|
237 * The real representation of constants. |
|
|
238 */ |
|
|
239 tree_constant_rep::tree_constant_rep (void) |
|
|
240 { |
|
|
241 type_tag = unknown_constant; |
|
|
242 } |
|
|
243 |
|
|
244 tree_constant_rep::tree_constant_rep (double d) |
|
|
245 { |
|
|
246 scalar = d; |
|
|
247 type_tag = scalar_constant; |
|
|
248 } |
|
|
249 |
|
|
250 tree_constant_rep::tree_constant_rep (const Matrix& m) |
|
|
251 { |
|
|
252 if (m.rows () == 1 && m.columns () == 1) |
|
|
253 { |
|
|
254 scalar = m.elem (0, 0); |
|
|
255 type_tag = scalar_constant; |
|
|
256 } |
|
|
257 else |
|
|
258 { |
|
|
259 matrix = new Matrix (m); |
|
|
260 type_tag = matrix_constant; |
|
|
261 } |
|
|
262 } |
|
|
263 |
|
|
264 tree_constant_rep::tree_constant_rep (const DiagMatrix& d) |
|
|
265 { |
|
|
266 if (d.rows () == 1 && d.columns () == 1) |
|
|
267 { |
|
|
268 scalar = d.elem (0, 0); |
|
|
269 type_tag = scalar_constant; |
|
|
270 } |
|
|
271 else |
|
|
272 { |
|
|
273 matrix = new Matrix (d); |
|
|
274 type_tag = matrix_constant; |
|
|
275 } |
|
|
276 } |
|
|
277 |
|
|
278 tree_constant_rep::tree_constant_rep (const RowVector& v, int |
|
|
279 prefer_column_vector) |
|
|
280 { |
|
|
281 int len = v.capacity (); |
|
|
282 if (len == 1) |
|
|
283 { |
|
|
284 scalar = v.elem (0); |
|
|
285 type_tag = scalar_constant; |
|
|
286 } |
|
|
287 else |
|
|
288 { |
|
|
289 int pcv = (prefer_column_vector < 0) |
|
|
290 ? user_pref.prefer_column_vectors |
|
|
291 : prefer_column_vector; |
|
|
292 |
|
|
293 if (pcv) |
|
|
294 { |
|
|
295 Matrix m (len, 1); |
|
|
296 for (int i = 0; i < len; i++) |
|
|
297 m.elem (i, 0) = v.elem (i); |
|
|
298 matrix = new Matrix (m); |
|
|
299 type_tag = matrix_constant; |
|
|
300 } |
|
|
301 else |
|
|
302 { |
|
|
303 Matrix m (1, len); |
|
|
304 for (int i = 0; i < len; i++) |
|
|
305 m.elem (0, i) = v.elem (i); |
|
|
306 matrix = new Matrix (m); |
|
|
307 type_tag = matrix_constant; |
|
|
308 } |
|
|
309 } |
|
|
310 } |
|
|
311 |
|
|
312 tree_constant_rep::tree_constant_rep (const ColumnVector& v, |
|
|
313 int prefer_column_vector) |
|
|
314 { |
|
|
315 int len = v.capacity (); |
|
|
316 if (len == 1) |
|
|
317 { |
|
|
318 scalar = v.elem (0); |
|
|
319 type_tag = scalar_constant; |
|
|
320 } |
|
|
321 else |
|
|
322 { |
|
|
323 int pcv = (prefer_column_vector < 0) |
|
|
324 ? user_pref.prefer_column_vectors |
|
|
325 : prefer_column_vector; |
|
|
326 |
|
|
327 if (pcv) |
|
|
328 { |
|
|
329 Matrix m (len, 1); |
|
|
330 for (int i = 0; i < len; i++) |
|
|
331 m.elem (i, 0) = v.elem (i); |
|
|
332 matrix = new Matrix (m); |
|
|
333 type_tag = matrix_constant; |
|
|
334 } |
|
|
335 else |
|
|
336 { |
|
|
337 Matrix m (1, len); |
|
|
338 for (int i = 0; i < len; i++) |
|
|
339 m.elem (0, i) = v.elem (i); |
|
|
340 matrix = new Matrix (m); |
|
|
341 type_tag = matrix_constant; |
|
|
342 } |
|
|
343 } |
|
|
344 } |
|
|
345 |
|
|
346 tree_constant_rep::tree_constant_rep (const Complex& c) |
|
|
347 { |
|
|
348 complex_scalar = new Complex (c); |
|
|
349 type_tag = complex_scalar_constant; |
|
|
350 } |
|
|
351 |
|
|
352 tree_constant_rep::tree_constant_rep (const ComplexMatrix& m) |
|
|
353 { |
|
|
354 if (m.rows () == 1 && m.columns () == 1) |
|
|
355 { |
|
|
356 complex_scalar = new Complex (m.elem (0, 0)); |
|
|
357 type_tag = complex_scalar_constant; |
|
|
358 } |
|
|
359 else |
|
|
360 { |
|
|
361 complex_matrix = new ComplexMatrix (m); |
|
|
362 type_tag = complex_matrix_constant; |
|
|
363 } |
|
|
364 } |
|
|
365 |
|
|
366 tree_constant_rep::tree_constant_rep (const ComplexDiagMatrix& d) |
|
|
367 { |
|
|
368 if (d.rows () == 1 && d.columns () == 1) |
|
|
369 { |
|
|
370 complex_scalar = new Complex (d.elem (0, 0)); |
|
|
371 type_tag = complex_scalar_constant; |
|
|
372 } |
|
|
373 else |
|
|
374 { |
|
|
375 complex_matrix = new ComplexMatrix (d); |
|
|
376 type_tag = complex_matrix_constant; |
|
|
377 } |
|
|
378 } |
|
|
379 |
|
|
380 tree_constant_rep::tree_constant_rep (const ComplexRowVector& v, |
|
|
381 int prefer_column_vector) |
|
|
382 { |
|
|
383 int len = v.capacity (); |
|
|
384 if (len == 1) |
|
|
385 { |
|
|
386 complex_scalar = new Complex (v.elem (0)); |
|
|
387 type_tag = complex_scalar_constant; |
|
|
388 } |
|
|
389 else |
|
|
390 { |
|
|
391 int pcv = (prefer_column_vector < 0) |
|
|
392 ? user_pref.prefer_column_vectors |
|
|
393 : prefer_column_vector; |
|
|
394 |
|
|
395 if (pcv) |
|
|
396 { |
|
|
397 ComplexMatrix m (len, 1); |
|
|
398 for (int i = 0; i < len; i++) |
|
|
399 m.elem (i, 0) = v.elem (i); |
|
|
400 complex_matrix = new ComplexMatrix (m); |
|
|
401 type_tag = complex_matrix_constant; |
|
|
402 } |
|
|
403 else |
|
|
404 { |
|
|
405 ComplexMatrix m (1, len); |
|
|
406 for (int i = 0; i < len; i++) |
|
|
407 m.elem (0, i) = v.elem (i); |
|
|
408 complex_matrix = new ComplexMatrix (m); |
|
|
409 type_tag = complex_matrix_constant; |
|
|
410 } |
|
|
411 } |
|
|
412 } |
|
|
413 |
|
|
414 tree_constant_rep::tree_constant_rep (const ComplexColumnVector& v, |
|
|
415 int prefer_column_vector) |
|
|
416 { |
|
|
417 int len = v.capacity (); |
|
|
418 if (len == 1) |
|
|
419 { |
|
|
420 complex_scalar = new Complex (v.elem (0)); |
|
|
421 type_tag = complex_scalar_constant; |
|
|
422 } |
|
|
423 else |
|
|
424 { |
|
|
425 int pcv = (prefer_column_vector < 0) |
|
|
426 ? user_pref.prefer_column_vectors |
|
|
427 : prefer_column_vector; |
|
|
428 |
|
|
429 if (pcv) |
|
|
430 { |
|
|
431 ComplexMatrix m (len, 1); |
|
|
432 for (int i = 0; i < len; i++) |
|
|
433 m.elem (i, 0) = v.elem (i); |
|
|
434 complex_matrix = new ComplexMatrix (m); |
|
|
435 type_tag = complex_matrix_constant; |
|
|
436 } |
|
|
437 else |
|
|
438 { |
|
|
439 ComplexMatrix m (1, len); |
|
|
440 for (int i = 0; i < len; i++) |
|
|
441 m.elem (0, i) = v.elem (i); |
|
|
442 complex_matrix = new ComplexMatrix (m); |
|
|
443 type_tag = complex_matrix_constant; |
|
|
444 } |
|
|
445 } |
|
|
446 } |
|
|
447 |
|
|
448 tree_constant_rep::tree_constant_rep (const char *s) |
|
|
449 { |
|
|
450 string = strsave (s); |
|
|
451 type_tag = string_constant; |
|
|
452 } |
|
|
453 |
|
|
454 tree_constant_rep::tree_constant_rep (double b, double l, double i) |
|
|
455 { |
|
|
456 range = new Range (b, l, i); |
|
|
457 int nel = range->nelem (); |
|
|
458 if (nel < 0) |
|
|
459 { |
|
|
460 delete range; |
|
|
461 type_tag = unknown_constant; |
|
|
462 if (nel == -1) |
|
|
463 ::error ("number of elements in range exceeds INT_MAX"); |
|
|
464 else |
|
|
465 ::error ("invalid range"); |
|
|
466 } |
|
|
467 else if (nel > 1) |
|
|
468 type_tag = range_constant; |
|
|
469 else |
|
|
470 { |
|
|
471 delete range; |
|
|
472 if (nel == 1) |
|
|
473 { |
|
|
474 scalar = b; |
|
|
475 type_tag = scalar_constant; |
|
|
476 } |
|
|
477 else if (nel == 0) |
|
|
478 { |
|
|
479 matrix = new Matrix (); |
|
|
480 type_tag = matrix_constant; |
|
|
481 } |
|
|
482 else |
|
|
483 panic_impossible (); |
|
|
484 } |
|
|
485 } |
|
|
486 |
|
|
487 tree_constant_rep::tree_constant_rep (const Range& r) |
|
|
488 { |
|
|
489 if (r.nelem () > 1) |
|
|
490 { |
|
|
491 range = new Range (r); |
|
|
492 type_tag = range_constant; |
|
|
493 } |
|
|
494 else if (r.nelem () == 1) |
|
|
495 { |
|
|
496 scalar = r.base (); |
|
|
497 type_tag = scalar_constant; |
|
|
498 } |
|
|
499 else if (r.nelem () == 0) |
|
|
500 { |
|
|
501 matrix = new Matrix (); |
|
|
502 type_tag = matrix_constant; |
|
|
503 } |
|
|
504 else |
|
|
505 panic_impossible (); |
|
|
506 } |
|
|
507 |
|
|
508 tree_constant_rep::tree_constant_rep (tree_constant_rep::constant_type t) |
|
|
509 { |
|
|
510 assert (t == magic_colon); |
|
|
511 |
|
|
512 type_tag = magic_colon; |
|
|
513 } |
|
|
514 |
|
|
515 tree_constant_rep::tree_constant_rep (const tree_constant_rep& t) |
|
|
516 { |
|
|
517 type_tag = t.type_tag; |
|
|
518 |
|
|
519 switch (t.type_tag) |
|
|
520 { |
|
|
521 case unknown_constant: |
|
|
522 break; |
|
|
523 case scalar_constant: |
|
|
524 scalar = t.scalar; |
|
|
525 break; |
|
|
526 case matrix_constant: |
|
|
527 matrix = new Matrix (*(t.matrix)); |
|
|
528 break; |
|
|
529 case string_constant: |
|
|
530 string = strsave (t.string); |
|
|
531 break; |
|
|
532 case complex_matrix_constant: |
|
|
533 complex_matrix = new ComplexMatrix (*(t.complex_matrix)); |
|
|
534 break; |
|
|
535 case complex_scalar_constant: |
|
|
536 complex_scalar = new Complex (*(t.complex_scalar)); |
|
|
537 break; |
|
|
538 case range_constant: |
|
|
539 range = new Range (*(t.range)); |
|
|
540 break; |
|
|
541 case magic_colon: |
|
|
542 break; |
|
|
543 default: |
|
|
544 panic_impossible (); |
|
|
545 break; |
|
|
546 } |
|
|
547 } |
|
|
548 |
|
|
549 tree_constant_rep::~tree_constant_rep (void) |
|
|
550 { |
|
|
551 switch (type_tag) |
|
|
552 { |
|
|
553 case unknown_constant: |
|
|
554 break; |
|
|
555 case scalar_constant: |
|
|
556 break; |
|
|
557 case matrix_constant: |
|
|
558 delete matrix; |
|
|
559 break; |
|
|
560 case complex_scalar_constant: |
|
|
561 delete complex_scalar; |
|
|
562 break; |
|
|
563 case complex_matrix_constant: |
|
|
564 delete complex_matrix; |
|
|
565 break; |
|
|
566 case string_constant: |
|
|
567 delete [] string; |
|
|
568 break; |
|
|
569 case range_constant: |
|
|
570 delete range; |
|
|
571 break; |
|
|
572 case magic_colon: |
|
|
573 break; |
|
|
574 default: |
|
|
575 panic_impossible (); |
|
|
576 break; |
|
|
577 } |
|
|
578 } |
|
|
579 |
|
|
580 #if defined (MDEBUG) |
|
|
581 void * |
|
|
582 tree_constant_rep::operator new (size_t size) |
|
|
583 { |
|
|
584 tree_constant_rep *p = ::new tree_constant_rep; |
|
|
585 cerr << "tree_constant_rep::new(): " << p << "\n"; |
|
|
586 return p; |
|
|
587 } |
|
|
588 |
|
|
589 void |
|
|
590 tree_constant_rep::operator delete (void *p, size_t size) |
|
|
591 { |
|
|
592 cerr << "tree_constant_rep::delete(): " << p << "\n"; |
|
|
593 ::delete p; |
|
|
594 } |
|
|
595 #endif |
|
|
596 |
|
|
597 void |
|
|
598 tree_constant_rep::resize (int i, int j) |
|
|
599 { |
|
|
600 switch (type_tag) |
|
|
601 { |
|
|
602 case matrix_constant: |
|
|
603 matrix->resize (i, j); |
|
|
604 break; |
|
|
605 case complex_matrix_constant: |
|
|
606 complex_matrix->resize (i, j); |
|
|
607 break; |
|
|
608 default: |
|
|
609 panic_impossible (); |
|
|
610 break; |
|
|
611 } |
|
|
612 } |
|
|
613 |
|
|
614 void |
|
|
615 tree_constant_rep::resize (int i, int j, double val) |
|
|
616 { |
|
|
617 switch (type_tag) |
|
|
618 { |
|
|
619 case matrix_constant: |
|
|
620 matrix->resize (i, j, val); |
|
|
621 break; |
|
|
622 case complex_matrix_constant: |
|
|
623 complex_matrix->resize (i, j, val); |
|
|
624 break; |
|
|
625 default: |
|
|
626 panic_impossible (); |
|
|
627 break; |
|
|
628 } |
|
|
629 } |
|
|
630 |
|
|
631 void |
|
|
632 tree_constant_rep::maybe_resize (int i, int j) |
|
|
633 { |
|
|
634 int nr = rows (); |
|
|
635 int nc = columns (); |
|
|
636 |
|
|
637 i++; |
|
|
638 j++; |
|
|
639 |
|
|
640 assert (i > 0 && j > 0); |
|
|
641 |
|
|
642 if (i > nr || j > nc) |
|
|
643 { |
|
|
644 if (user_pref.resize_on_range_error) |
|
|
645 resize (MAX (i, nr), MAX (j, nc), 0.0); |
|
|
646 else |
|
|
647 { |
|
|
648 if (i > nr) |
|
|
649 ::error ("row index = %d exceeds max row dimension = %d", i, nr); |
|
|
650 |
|
|
651 if (j > nc) |
|
|
652 ::error ("column index = %d exceeds max column dimension = %d", |
|
|
653 j, nc); |
|
|
654 } |
|
|
655 } |
|
|
656 } |
|
|
657 |
|
|
658 void |
|
529
|
659 tree_constant_rep::maybe_resize (int i, force_orient f_orient) |
|
492
|
660 { |
|
|
661 int nr = rows (); |
|
|
662 int nc = columns (); |
|
|
663 |
|
|
664 i++; |
|
|
665 |
|
|
666 assert (i >= 0 && (nr <= 1 || nc <= 1)); |
|
|
667 |
|
|
668 // This function never reduces the size of a vector, and all vectors |
|
|
669 // have dimensions of at least 0x0. If i is 0, it is either because |
|
|
670 // a vector has been indexed with a vector of all zeros (in which case |
|
|
671 // the index vector is empty and nothing will happen) or a vector has |
|
|
672 // been indexed with 0 (an error which will be caught elsewhere). |
|
|
673 if (i == 0) |
|
|
674 return; |
|
|
675 |
|
|
676 if (nr <= 1 && nc <= 1 && i >= 1) |
|
|
677 { |
|
|
678 if (user_pref.resize_on_range_error) |
|
|
679 { |
|
|
680 if (f_orient == row_orient) |
|
|
681 resize (1, i, 0.0); |
|
|
682 else if (f_orient == column_orient) |
|
|
683 resize (i, 1, 0.0); |
|
|
684 else if (user_pref.prefer_column_vectors) |
|
|
685 resize (i, 1, 0.0); |
|
|
686 else |
|
|
687 resize (1, i, 0.0); |
|
|
688 } |
|
|
689 else |
|
|
690 ::error ("matrix index = %d exceeds max dimension = %d", i, nc); |
|
|
691 } |
|
|
692 else if (nr == 1 && i > nc) |
|
|
693 { |
|
|
694 if (user_pref.resize_on_range_error) |
|
|
695 resize (1, i, 0.0); |
|
|
696 else |
|
|
697 ::error ("matrix index = %d exceeds max dimension = %d", i, nc); |
|
|
698 } |
|
|
699 else if (nc == 1 && i > nr) |
|
|
700 { |
|
|
701 if (user_pref.resize_on_range_error) |
|
|
702 resize (i, 1, 0.0); |
|
|
703 else |
|
|
704 ::error ("matrix index = %d exceeds max dimension = ", i, nc); |
|
|
705 } |
|
|
706 } |
|
|
707 |
|
|
708 double |
|
|
709 tree_constant_rep::to_scalar (void) const |
|
|
710 { |
|
|
711 tree_constant tmp = make_numeric (); |
|
|
712 |
|
|
713 double retval = 0.0; |
|
|
714 |
|
|
715 switch (tmp.const_type ()) |
|
|
716 { |
|
|
717 case tree_constant_rep::scalar_constant: |
|
|
718 case tree_constant_rep::complex_scalar_constant: |
|
|
719 retval = tmp.double_value (); |
|
|
720 break; |
|
|
721 case tree_constant_rep::matrix_constant: |
|
|
722 if (user_pref.do_fortran_indexing) |
|
|
723 { |
|
|
724 Matrix m = tmp.matrix_value (); |
|
|
725 retval = m (0, 0); |
|
|
726 } |
|
|
727 break; |
|
|
728 case tree_constant_rep::complex_matrix_constant: |
|
|
729 if (user_pref.do_fortran_indexing) |
|
|
730 { |
|
|
731 int flag = user_pref.ok_to_lose_imaginary_part; |
|
|
732 if (flag == -1) |
|
|
733 warning ("implicit conversion of complex value to real value"); |
|
|
734 |
|
|
735 if (flag != 0) |
|
|
736 { |
|
|
737 ComplexMatrix m = tmp.complex_matrix_value (); |
|
|
738 return ::real (m (0, 0)); |
|
|
739 } |
|
|
740 else |
|
|
741 jump_to_top_level (); |
|
|
742 } |
|
|
743 else |
|
|
744 { |
|
|
745 ::error ("complex matrix used in invalid context"); |
|
|
746 jump_to_top_level (); |
|
|
747 } |
|
|
748 break; |
|
|
749 default: |
|
|
750 break; |
|
|
751 } |
|
|
752 return retval; |
|
|
753 } |
|
|
754 |
|
|
755 ColumnVector |
|
|
756 tree_constant_rep::to_vector (void) const |
|
|
757 { |
|
|
758 tree_constant tmp = make_numeric (); |
|
|
759 |
|
|
760 ColumnVector retval; |
|
|
761 |
|
|
762 switch (tmp.const_type ()) |
|
|
763 { |
|
|
764 case tree_constant_rep::scalar_constant: |
|
|
765 case tree_constant_rep::complex_scalar_constant: |
|
|
766 retval.resize (1); |
|
|
767 retval.elem (0) = tmp.double_value (); |
|
|
768 break; |
|
|
769 case tree_constant_rep::complex_matrix_constant: |
|
|
770 case tree_constant_rep::matrix_constant: |
|
|
771 { |
|
|
772 Matrix m = tmp.matrix_value (); |
|
|
773 int nr = m.rows (); |
|
|
774 int nc = m.columns (); |
|
|
775 if (nr == 1) |
|
|
776 { |
|
|
777 retval.resize (nc); |
|
|
778 for (int i = 0; i < nc; i++) |
|
|
779 retval.elem (i) = m (0, i); |
|
|
780 } |
|
|
781 else if (nc == 1) |
|
|
782 { |
|
|
783 retval.resize (nr); |
|
|
784 for (int i = 0; i < nr; i++) |
|
|
785 retval.elem (i) = m.elem (i, 0); |
|
|
786 } |
|
|
787 } |
|
|
788 break; |
|
|
789 default: |
|
|
790 panic_impossible (); |
|
|
791 break; |
|
|
792 } |
|
|
793 return retval; |
|
|
794 } |
|
|
795 |
|
|
796 Matrix |
|
|
797 tree_constant_rep::to_matrix (void) const |
|
|
798 { |
|
|
799 tree_constant tmp = make_numeric (); |
|
|
800 |
|
|
801 Matrix retval; |
|
|
802 |
|
|
803 switch (tmp.const_type ()) |
|
|
804 { |
|
|
805 case tree_constant_rep::scalar_constant: |
|
|
806 retval.resize (1, 1); |
|
|
807 retval.elem (0, 0) = tmp.double_value (); |
|
|
808 break; |
|
|
809 case tree_constant_rep::matrix_constant: |
|
|
810 retval = tmp.matrix_value (); |
|
|
811 break; |
|
|
812 default: |
|
|
813 break; |
|
|
814 } |
|
|
815 return retval; |
|
|
816 } |
|
|
817 |
|
|
818 tree_constant_rep::constant_type |
|
529
|
819 tree_constant_rep::force_numeric (int force_str_conv) |
|
492
|
820 { |
|
|
821 switch (type_tag) |
|
|
822 { |
|
|
823 case scalar_constant: |
|
|
824 case matrix_constant: |
|
|
825 case complex_scalar_constant: |
|
|
826 case complex_matrix_constant: |
|
|
827 break; |
|
|
828 case string_constant: |
|
|
829 { |
|
|
830 if (! force_str_conv && ! user_pref.implicit_str_to_num_ok) |
|
|
831 { |
|
|
832 ::error ("failed to convert `%s' to a numeric type --", string); |
|
|
833 ::error ("default conversion turned off"); |
|
|
834 // Abort! |
|
|
835 jump_to_top_level (); |
|
|
836 } |
|
|
837 |
|
|
838 int len = strlen (string); |
|
|
839 if (len > 1) |
|
|
840 { |
|
|
841 type_tag = matrix_constant; |
|
|
842 Matrix *tm = new Matrix (1, len); |
|
|
843 for (int i = 0; i < len; i++) |
|
|
844 tm->elem (0, i) = toascii ((int) string[i]); |
|
|
845 matrix = tm; |
|
|
846 } |
|
|
847 else if (len == 1) |
|
|
848 { |
|
|
849 type_tag = scalar_constant; |
|
|
850 scalar = toascii ((int) string[0]); |
|
|
851 } |
|
|
852 else if (len == 0) |
|
|
853 { |
|
|
854 type_tag = matrix_constant; |
|
|
855 matrix = new Matrix (0, 0); |
|
|
856 } |
|
|
857 else |
|
|
858 panic_impossible (); |
|
|
859 } |
|
|
860 break; |
|
|
861 case range_constant: |
|
|
862 { |
|
|
863 int len = range->nelem (); |
|
|
864 if (len > 1) |
|
|
865 { |
|
|
866 type_tag = matrix_constant; |
|
|
867 Matrix *tm = new Matrix (1, len); |
|
|
868 double b = range->base (); |
|
|
869 double increment = range->inc (); |
|
|
870 for (int i = 0; i < len; i++) |
|
|
871 tm->elem (0, i) = b + i * increment; |
|
|
872 matrix = tm; |
|
|
873 } |
|
|
874 else if (len == 1) |
|
|
875 { |
|
|
876 type_tag = scalar_constant; |
|
|
877 scalar = range->base (); |
|
|
878 } |
|
|
879 } |
|
|
880 break; |
|
|
881 case magic_colon: |
|
|
882 default: |
|
|
883 panic_impossible (); |
|
|
884 break; |
|
|
885 } |
|
|
886 return type_tag; |
|
|
887 } |
|
|
888 |
|
|
889 tree_constant |
|
529
|
890 tree_constant_rep::make_numeric (int force_str_conv) const |
|
492
|
891 { |
|
|
892 tree_constant retval; |
|
|
893 switch (type_tag) |
|
|
894 { |
|
|
895 case scalar_constant: |
|
|
896 retval = tree_constant (scalar); |
|
|
897 break; |
|
|
898 case matrix_constant: |
|
|
899 retval = tree_constant (*matrix); |
|
|
900 break; |
|
|
901 case complex_scalar_constant: |
|
|
902 retval = tree_constant (*complex_scalar); |
|
|
903 break; |
|
|
904 case complex_matrix_constant: |
|
|
905 retval = tree_constant (*complex_matrix); |
|
|
906 break; |
|
|
907 case string_constant: |
|
|
908 retval = tree_constant (string); |
|
|
909 retval.force_numeric (force_str_conv); |
|
|
910 break; |
|
|
911 case range_constant: |
|
|
912 retval = tree_constant (*range); |
|
|
913 retval.force_numeric (force_str_conv); |
|
|
914 break; |
|
|
915 case magic_colon: |
|
|
916 default: |
|
|
917 panic_impossible (); |
|
|
918 break; |
|
|
919 } |
|
|
920 return retval; |
|
|
921 } |
|
|
922 |
|
|
923 tree_constant |
|
578
|
924 do_binary_op (tree_constant& a, tree_constant& b, tree_expression::type t) |
|
492
|
925 { |
|
|
926 tree_constant ans; |
|
|
927 |
|
|
928 int first_empty = (a.rows () == 0 || a.columns () == 0); |
|
|
929 int second_empty = (b.rows () == 0 || b.columns () == 0); |
|
|
930 |
|
|
931 if (first_empty || second_empty) |
|
|
932 { |
|
|
933 int flag = user_pref.propagate_empty_matrices; |
|
|
934 if (flag < 0) |
|
|
935 warning ("binary operation on empty matrix"); |
|
|
936 else if (flag == 0) |
|
|
937 { |
|
|
938 ::error ("invalid binary operation on empty matrix"); |
|
|
939 return ans; |
|
|
940 } |
|
|
941 } |
|
|
942 |
|
|
943 tree_constant tmp_a = a.make_numeric (); |
|
|
944 tree_constant tmp_b = b.make_numeric (); |
|
|
945 |
|
|
946 tree_constant_rep::constant_type a_type = tmp_a.const_type (); |
|
|
947 tree_constant_rep::constant_type b_type = tmp_b.const_type (); |
|
|
948 |
|
|
949 double d1, d2; |
|
|
950 Matrix m1, m2; |
|
|
951 Complex c1, c2; |
|
|
952 ComplexMatrix cm1, cm2; |
|
|
953 |
|
|
954 switch (a_type) |
|
|
955 { |
|
|
956 case tree_constant_rep::scalar_constant: |
|
|
957 d1 = tmp_a.double_value (); |
|
|
958 switch (b_type) |
|
|
959 { |
|
|
960 case tree_constant_rep::scalar_constant: |
|
|
961 d2 = tmp_b.double_value (); |
|
|
962 ans = do_binary_op (d1, d2, t); |
|
|
963 break; |
|
|
964 case tree_constant_rep::matrix_constant: |
|
|
965 m2 = tmp_b.matrix_value (); |
|
|
966 ans = do_binary_op (d1, m2, t); |
|
|
967 break; |
|
|
968 case tree_constant_rep::complex_scalar_constant: |
|
|
969 c2 = tmp_b.complex_value (); |
|
|
970 ans = do_binary_op (d1, c2, t); |
|
|
971 break; |
|
|
972 case tree_constant_rep::complex_matrix_constant: |
|
|
973 cm2 = tmp_b.complex_matrix_value (); |
|
|
974 ans = do_binary_op (d1, cm2, t); |
|
|
975 break; |
|
|
976 case tree_constant_rep::magic_colon: |
|
|
977 default: |
|
|
978 panic_impossible (); |
|
|
979 break; |
|
|
980 } |
|
|
981 break; |
|
|
982 case tree_constant_rep::matrix_constant: |
|
|
983 m1 = tmp_a.matrix_value (); |
|
|
984 switch (b_type) |
|
|
985 { |
|
|
986 case tree_constant_rep::scalar_constant: |
|
|
987 d2 = tmp_b.double_value (); |
|
|
988 ans = do_binary_op (m1, d2, t); |
|
|
989 break; |
|
|
990 case tree_constant_rep::matrix_constant: |
|
|
991 m2 = tmp_b.matrix_value (); |
|
|
992 ans = do_binary_op (m1, m2, t); |
|
|
993 break; |
|
|
994 case tree_constant_rep::complex_scalar_constant: |
|
|
995 c2 = tmp_b.complex_value (); |
|
|
996 ans = do_binary_op (m1, c2, t); |
|
|
997 break; |
|
|
998 case tree_constant_rep::complex_matrix_constant: |
|
|
999 cm2 = tmp_b.complex_matrix_value (); |
|
|
1000 ans = do_binary_op (m1, cm2, t); |
|
|
1001 break; |
|
|
1002 case tree_constant_rep::magic_colon: |
|
|
1003 default: |
|
|
1004 panic_impossible (); |
|
|
1005 break; |
|
|
1006 } |
|
|
1007 break; |
|
|
1008 case tree_constant_rep::complex_scalar_constant: |
|
|
1009 c1 = tmp_a.complex_value (); |
|
|
1010 switch (b_type) |
|
|
1011 { |
|
|
1012 case tree_constant_rep::scalar_constant: |
|
|
1013 d2 = tmp_b.double_value (); |
|
|
1014 ans = do_binary_op (c1, d2, t); |
|
|
1015 break; |
|
|
1016 case tree_constant_rep::matrix_constant: |
|
|
1017 m2 = tmp_b.matrix_value (); |
|
|
1018 ans = do_binary_op (c1, m2, t); |
|
|
1019 break; |
|
|
1020 case tree_constant_rep::complex_scalar_constant: |
|
|
1021 c2 = tmp_b.complex_value (); |
|
|
1022 ans = do_binary_op (c1, c2, t); |
|
|
1023 break; |
|
|
1024 case tree_constant_rep::complex_matrix_constant: |
|
|
1025 cm2 = tmp_b.complex_matrix_value (); |
|
|
1026 ans = do_binary_op (c1, cm2, t); |
|
|
1027 break; |
|
|
1028 case tree_constant_rep::magic_colon: |
|
|
1029 default: |
|
|
1030 panic_impossible (); |
|
|
1031 break; |
|
|
1032 } |
|
|
1033 break; |
|
|
1034 case tree_constant_rep::complex_matrix_constant: |
|
|
1035 cm1 = tmp_a.complex_matrix_value (); |
|
|
1036 switch (b_type) |
|
|
1037 { |
|
|
1038 case tree_constant_rep::scalar_constant: |
|
|
1039 d2 = tmp_b.double_value (); |
|
|
1040 ans = do_binary_op (cm1, d2, t); |
|
|
1041 break; |
|
|
1042 case tree_constant_rep::matrix_constant: |
|
|
1043 m2 = tmp_b.matrix_value (); |
|
|
1044 ans = do_binary_op (cm1, m2, t); |
|
|
1045 break; |
|
|
1046 case tree_constant_rep::complex_scalar_constant: |
|
|
1047 c2 = tmp_b.complex_value (); |
|
|
1048 ans = do_binary_op (cm1, c2, t); |
|
|
1049 break; |
|
|
1050 case tree_constant_rep::complex_matrix_constant: |
|
|
1051 cm2 = tmp_b.complex_matrix_value (); |
|
|
1052 ans = do_binary_op (cm1, cm2, t); |
|
|
1053 break; |
|
|
1054 case tree_constant_rep::magic_colon: |
|
|
1055 default: |
|
|
1056 panic_impossible (); |
|
|
1057 break; |
|
|
1058 } |
|
|
1059 break; |
|
|
1060 case tree_constant_rep::magic_colon: |
|
|
1061 default: |
|
|
1062 panic_impossible (); |
|
|
1063 break; |
|
|
1064 } |
|
|
1065 return ans; |
|
|
1066 } |
|
|
1067 |
|
|
1068 tree_constant |
|
578
|
1069 do_unary_op (tree_constant& a, tree_expression::type t) |
|
492
|
1070 { |
|
|
1071 tree_constant ans; |
|
|
1072 |
|
|
1073 if (a.rows () == 0 || a.columns () == 0) |
|
|
1074 { |
|
|
1075 int flag = user_pref.propagate_empty_matrices; |
|
|
1076 if (flag < 0) |
|
|
1077 warning ("unary operation on empty matrix"); |
|
|
1078 else if (flag == 0) |
|
|
1079 { |
|
|
1080 ::error ("invalid unary operation on empty matrix"); |
|
|
1081 return ans; |
|
|
1082 } |
|
|
1083 } |
|
|
1084 |
|
|
1085 tree_constant tmp_a = a.make_numeric (); |
|
|
1086 |
|
|
1087 switch (tmp_a.const_type ()) |
|
|
1088 { |
|
|
1089 case tree_constant_rep::scalar_constant: |
|
|
1090 ans = do_unary_op (tmp_a.double_value (), t); |
|
|
1091 break; |
|
|
1092 case tree_constant_rep::matrix_constant: |
|
|
1093 { |
|
|
1094 Matrix m = tmp_a.matrix_value (); |
|
|
1095 ans = do_unary_op (m, t); |
|
|
1096 } |
|
|
1097 break; |
|
|
1098 case tree_constant_rep::complex_scalar_constant: |
|
|
1099 ans = do_unary_op (tmp_a.complex_value (), t); |
|
|
1100 break; |
|
|
1101 case tree_constant_rep::complex_matrix_constant: |
|
|
1102 { |
|
|
1103 ComplexMatrix m = tmp_a.complex_matrix_value (); |
|
|
1104 ans = do_unary_op (m, t); |
|
|
1105 } |
|
|
1106 break; |
|
|
1107 case tree_constant_rep::magic_colon: |
|
|
1108 default: |
|
|
1109 panic_impossible (); |
|
|
1110 break; |
|
|
1111 } |
|
|
1112 return ans; |
|
|
1113 } |
|
|
1114 |
|
|
1115 void |
|
578
|
1116 tree_constant_rep::bump_value (tree_expression::type etype) |
|
492
|
1117 { |
|
|
1118 switch (etype) |
|
|
1119 { |
|
578
|
1120 case tree_expression::increment: |
|
492
|
1121 switch (type_tag) |
|
|
1122 { |
|
|
1123 case scalar_constant: |
|
|
1124 scalar++; |
|
|
1125 break; |
|
|
1126 case matrix_constant: |
|
|
1127 *matrix = *matrix + 1.0; |
|
|
1128 break; |
|
|
1129 case complex_scalar_constant: |
|
|
1130 *complex_scalar = *complex_scalar + 1.0; |
|
|
1131 break; |
|
|
1132 case complex_matrix_constant: |
|
|
1133 *complex_matrix = *complex_matrix + 1.0; |
|
|
1134 break; |
|
|
1135 case string_constant: |
|
|
1136 ::error ("string++ and ++string not implemented yet, ok?"); |
|
|
1137 break; |
|
|
1138 case range_constant: |
|
|
1139 range->set_base (range->base () + 1.0); |
|
|
1140 range->set_limit (range->limit () + 1.0); |
|
|
1141 break; |
|
|
1142 case magic_colon: |
|
|
1143 default: |
|
|
1144 panic_impossible (); |
|
|
1145 break; |
|
|
1146 } |
|
|
1147 break; |
|
578
|
1148 case tree_expression::decrement: |
|
492
|
1149 switch (type_tag) |
|
|
1150 { |
|
|
1151 case scalar_constant: |
|
|
1152 scalar--; |
|
|
1153 break; |
|
|
1154 case matrix_constant: |
|
|
1155 *matrix = *matrix - 1.0; |
|
|
1156 break; |
|
|
1157 case string_constant: |
|
|
1158 ::error ("string-- and -- string not implemented yet, ok?"); |
|
|
1159 break; |
|
|
1160 case range_constant: |
|
|
1161 range->set_base (range->base () - 1.0); |
|
|
1162 range->set_limit (range->limit () - 1.0); |
|
|
1163 break; |
|
|
1164 case magic_colon: |
|
|
1165 default: |
|
|
1166 panic_impossible (); |
|
|
1167 break; |
|
|
1168 } |
|
|
1169 break; |
|
|
1170 default: |
|
|
1171 panic_impossible (); |
|
|
1172 break; |
|
|
1173 } |
|
|
1174 } |
|
|
1175 |
|
|
1176 void |
|
|
1177 tree_constant_rep::maybe_mutate (void) |
|
|
1178 { |
|
|
1179 if (error_state) |
|
|
1180 return; |
|
|
1181 |
|
|
1182 switch (type_tag) |
|
|
1183 { |
|
|
1184 case complex_scalar_constant: |
|
|
1185 if (::imag (*complex_scalar) == 0.0) |
|
|
1186 { |
|
|
1187 double d = ::real (*complex_scalar); |
|
|
1188 delete complex_scalar; |
|
|
1189 scalar = d; |
|
|
1190 type_tag = scalar_constant; |
|
|
1191 } |
|
|
1192 break; |
|
|
1193 case complex_matrix_constant: |
|
|
1194 if (! any_element_is_complex (*complex_matrix)) |
|
|
1195 { |
|
|
1196 Matrix *m = new Matrix (::real (*complex_matrix)); |
|
|
1197 delete complex_matrix; |
|
|
1198 matrix = m; |
|
|
1199 type_tag = matrix_constant; |
|
|
1200 } |
|
|
1201 break; |
|
|
1202 case scalar_constant: |
|
|
1203 case matrix_constant: |
|
|
1204 case string_constant: |
|
|
1205 case range_constant: |
|
|
1206 case magic_colon: |
|
|
1207 break; |
|
|
1208 default: |
|
|
1209 panic_impossible (); |
|
|
1210 break; |
|
|
1211 } |
|
|
1212 |
|
|
1213 // Avoid calling rows() and columns() for things like magic_colon. |
|
|
1214 |
|
|
1215 int nr = 1; |
|
|
1216 int nc = 1; |
|
|
1217 if (type_tag == matrix_constant |
|
|
1218 || type_tag == complex_matrix_constant |
|
|
1219 || type_tag == range_constant) |
|
|
1220 { |
|
|
1221 nr = rows (); |
|
|
1222 nc = columns (); |
|
|
1223 } |
|
|
1224 |
|
|
1225 switch (type_tag) |
|
|
1226 { |
|
|
1227 case matrix_constant: |
|
|
1228 if (nr == 1 && nc == 1) |
|
|
1229 { |
|
|
1230 double d = matrix->elem (0, 0); |
|
|
1231 delete matrix; |
|
|
1232 scalar = d; |
|
|
1233 type_tag = scalar_constant; |
|
|
1234 } |
|
|
1235 break; |
|
|
1236 case complex_matrix_constant: |
|
|
1237 if (nr == 1 && nc == 1) |
|
|
1238 { |
|
|
1239 Complex c = complex_matrix->elem (0, 0); |
|
|
1240 delete complex_matrix; |
|
|
1241 complex_scalar = new Complex (c); |
|
|
1242 type_tag = complex_scalar_constant; |
|
|
1243 } |
|
|
1244 break; |
|
|
1245 case range_constant: |
|
|
1246 if (nr == 1 && nc == 1) |
|
|
1247 { |
|
|
1248 double d = range->base (); |
|
|
1249 delete range; |
|
|
1250 scalar = d; |
|
|
1251 type_tag = scalar_constant; |
|
|
1252 } |
|
|
1253 break; |
|
|
1254 default: |
|
|
1255 break; |
|
|
1256 } |
|
|
1257 } |
|
|
1258 |
|
|
1259 void |
|
|
1260 tree_constant_rep::print (void) |
|
|
1261 { |
|
|
1262 if (error_state) |
|
|
1263 return; |
|
|
1264 |
|
|
1265 int nr = rows (); |
|
|
1266 int nc = columns (); |
|
|
1267 |
|
|
1268 if (print) |
|
|
1269 { |
|
|
1270 ostrstream output_buf; |
|
|
1271 switch (type_tag) |
|
|
1272 { |
|
|
1273 case scalar_constant: |
|
|
1274 octave_print_internal (output_buf, scalar); |
|
|
1275 break; |
|
|
1276 case matrix_constant: |
|
|
1277 if (nr == 0 || nc == 0) |
|
|
1278 { |
|
|
1279 output_buf << "[]"; |
|
|
1280 if (user_pref.print_empty_dimensions) |
|
|
1281 output_buf << "(" << nr << "x" << nc << ")"; |
|
|
1282 output_buf << "\n"; |
|
|
1283 } |
|
|
1284 else |
|
|
1285 octave_print_internal (output_buf, *matrix); |
|
|
1286 break; |
|
|
1287 case complex_scalar_constant: |
|
|
1288 octave_print_internal (output_buf, *complex_scalar); |
|
|
1289 break; |
|
|
1290 case complex_matrix_constant: |
|
|
1291 if (nr == 0 || nc == 0) |
|
|
1292 { |
|
|
1293 output_buf << "[]"; |
|
|
1294 if (user_pref.print_empty_dimensions) |
|
|
1295 output_buf << "(" << nr << "x" << nc << ")"; |
|
|
1296 output_buf << "\n"; |
|
|
1297 } |
|
|
1298 else |
|
|
1299 octave_print_internal (output_buf, *complex_matrix); |
|
|
1300 break; |
|
|
1301 case string_constant: |
|
|
1302 output_buf << string << "\n"; |
|
|
1303 break; |
|
|
1304 case range_constant: |
|
|
1305 octave_print_internal (output_buf, *range); |
|
|
1306 break; |
|
|
1307 case magic_colon: |
|
|
1308 default: |
|
|
1309 panic_impossible (); |
|
|
1310 break; |
|
|
1311 } |
|
|
1312 |
|
|
1313 output_buf << ends; |
|
|
1314 maybe_page_output (output_buf); |
|
|
1315 } |
|
|
1316 } |
|
|
1317 |
|
|
1318 tree_constant |
|
506
|
1319 tree_constant_rep::do_index (const Octave_object& args) |
|
492
|
1320 { |
|
|
1321 tree_constant retval; |
|
|
1322 |
|
|
1323 if (error_state) |
|
|
1324 return retval; |
|
|
1325 |
|
|
1326 if (rows () == 0 || columns () == 0) |
|
|
1327 { |
|
|
1328 ::error ("attempt to index empty matrix"); |
|
|
1329 return retval; |
|
|
1330 } |
|
|
1331 |
|
|
1332 switch (type_tag) |
|
|
1333 { |
|
|
1334 case complex_scalar_constant: |
|
|
1335 case scalar_constant: |
|
506
|
1336 retval = do_scalar_index (args); |
|
492
|
1337 break; |
|
|
1338 case complex_matrix_constant: |
|
|
1339 case matrix_constant: |
|
506
|
1340 retval = do_matrix_index (args); |
|
492
|
1341 break; |
|
|
1342 case string_constant: |
|
|
1343 gripe_string_invalid (); |
|
506
|
1344 // retval = do_string_index (args); |
|
492
|
1345 break; |
|
|
1346 case magic_colon: |
|
|
1347 case range_constant: |
|
|
1348 // This isn\'t great, but it\'s easier than implementing a lot of |
|
|
1349 // range indexing functions. |
|
|
1350 force_numeric (); |
|
|
1351 assert (type_tag != magic_colon && type_tag != range_constant); |
|
506
|
1352 retval = do_index (args); |
|
492
|
1353 break; |
|
|
1354 default: |
|
|
1355 panic_impossible (); |
|
|
1356 break; |
|
|
1357 } |
|
|
1358 |
|
|
1359 return retval; |
|
|
1360 } |
|
|
1361 |
|
|
1362 int |
|
|
1363 tree_constant_rep::save (ostream& os, int mark_as_global, int precision) |
|
|
1364 { |
|
|
1365 switch (type_tag) |
|
|
1366 { |
|
|
1367 case scalar_constant: |
|
|
1368 case matrix_constant: |
|
|
1369 case complex_scalar_constant: |
|
|
1370 case complex_matrix_constant: |
|
|
1371 case string_constant: |
|
|
1372 case range_constant: |
|
|
1373 if (mark_as_global) |
|
|
1374 os << "# type: global "; |
|
|
1375 else |
|
|
1376 os << "# type: "; |
|
|
1377 break; |
|
|
1378 case magic_colon: |
|
|
1379 default: |
|
|
1380 break; |
|
|
1381 } |
|
|
1382 |
|
|
1383 long old_precision = os.precision (); |
|
|
1384 os.precision (precision); |
|
|
1385 |
|
|
1386 switch (type_tag) |
|
|
1387 { |
|
|
1388 case scalar_constant: |
|
|
1389 os << "scalar\n" |
|
|
1390 << scalar << "\n"; |
|
|
1391 break; |
|
|
1392 case matrix_constant: |
|
|
1393 os << "matrix\n" |
|
|
1394 << "# rows: " << rows () << "\n" |
|
|
1395 << "# columns: " << columns () << "\n" |
|
|
1396 << *matrix ; |
|
|
1397 break; |
|
|
1398 case complex_scalar_constant: |
|
|
1399 os << "complex scalar\n" |
|
|
1400 << *complex_scalar << "\n"; |
|
|
1401 break; |
|
|
1402 case complex_matrix_constant: |
|
|
1403 os << "complex matrix\n" |
|
|
1404 << "# rows: " << rows () << "\n" |
|
|
1405 << "# columns: " << columns () << "\n" |
|
|
1406 << *complex_matrix ; |
|
|
1407 break; |
|
|
1408 case string_constant: |
|
|
1409 os << "string\n" |
|
|
1410 << "# length: " << strlen (string) << "\n" |
|
|
1411 << string << "\n"; |
|
|
1412 break; |
|
|
1413 case range_constant: |
|
|
1414 { |
|
|
1415 os << "range\n" |
|
|
1416 << "# base, limit, increment\n" |
|
|
1417 << range->base () << " " |
|
|
1418 << range->limit () << " " |
|
|
1419 << range->inc () << "\n"; |
|
|
1420 } |
|
|
1421 break; |
|
|
1422 case magic_colon: |
|
|
1423 default: |
|
|
1424 panic_impossible (); |
|
|
1425 break; |
|
|
1426 } |
|
|
1427 |
|
|
1428 os.precision (old_precision); |
|
|
1429 |
|
|
1430 // Really want to return 1 only if write is successful. |
|
|
1431 return 1; |
|
|
1432 } |
|
|
1433 |
|
|
1434 int |
|
|
1435 tree_constant_rep::save_three_d (ostream& os, int parametric) |
|
|
1436 { |
|
|
1437 int nr = rows (); |
|
|
1438 int nc = columns (); |
|
|
1439 |
|
|
1440 switch (type_tag) |
|
|
1441 { |
|
|
1442 case matrix_constant: |
|
|
1443 os << "# 3D data...\n" |
|
|
1444 << "# type: matrix\n" |
|
|
1445 << "# total rows: " << nr << "\n" |
|
|
1446 << "# total columns: " << nc << "\n"; |
|
|
1447 |
|
|
1448 if (parametric) |
|
|
1449 { |
|
|
1450 int extras = nc % 3; |
|
|
1451 if (extras) |
|
|
1452 warning ("ignoring last %d columns", extras); |
|
|
1453 |
|
|
1454 for (int i = 0; i < nc-extras; i += 3) |
|
|
1455 { |
|
|
1456 os << matrix->extract (0, i, nr-1, i+2); |
|
|
1457 if (i+3 < nc-extras) |
|
|
1458 os << "\n"; |
|
|
1459 } |
|
|
1460 } |
|
|
1461 else |
|
|
1462 { |
|
|
1463 for (int i = 0; i < nc; i++) |
|
|
1464 { |
|
|
1465 os << matrix->extract (0, i, nr-1, i); |
|
|
1466 if (i+1 < nc) |
|
|
1467 os << "\n"; |
|
|
1468 } |
|
|
1469 } |
|
|
1470 break; |
|
|
1471 default: |
|
|
1472 ::error ("for now, I can only save real matrices in 3D format"); |
|
|
1473 return 0; |
|
|
1474 break; |
|
|
1475 } |
|
|
1476 // Really want to return 1 only if write is successful. |
|
|
1477 return 1; |
|
|
1478 } |
|
|
1479 |
|
|
1480 int |
|
|
1481 tree_constant_rep::load (istream& is) |
|
|
1482 { |
|
|
1483 int is_global = 0; |
|
|
1484 |
|
|
1485 type_tag = unknown_constant; |
|
|
1486 |
|
|
1487 // Look for type keyword |
|
|
1488 |
|
|
1489 char *tag = extract_keyword (is, "type"); |
|
|
1490 |
|
529
|
1491 if (tag && *tag) |
|
492
|
1492 { |
|
|
1493 char *ptr = strchr (tag, ' '); |
|
529
|
1494 if (ptr) |
|
492
|
1495 { |
|
|
1496 *ptr = '\0'; |
|
|
1497 is_global = (strncmp (tag, "global", 6) == 0); |
|
|
1498 *ptr = ' '; |
|
|
1499 if (is_global) |
|
|
1500 ptr++; |
|
|
1501 else |
|
|
1502 ptr = tag; |
|
|
1503 } |
|
|
1504 else |
|
|
1505 ptr = tag; |
|
|
1506 |
|
|
1507 if (strncmp (ptr, "scalar", 6) == 0) |
|
|
1508 type_tag = load (is, scalar_constant); |
|
|
1509 else if (strncmp (ptr, "matrix", 6) == 0) |
|
|
1510 type_tag = load (is, matrix_constant); |
|
|
1511 else if (strncmp (ptr, "complex scalar", 14) == 0) |
|
|
1512 type_tag = load (is, complex_scalar_constant); |
|
|
1513 else if (strncmp (ptr, "complex matrix", 14) == 0) |
|
|
1514 type_tag = load (is, complex_matrix_constant); |
|
|
1515 else if (strncmp (ptr, "string", 6) == 0) |
|
|
1516 type_tag = load (is, string_constant); |
|
|
1517 else if (strncmp (ptr, "range", 5) == 0) |
|
|
1518 type_tag = load (is, range_constant); |
|
|
1519 else |
|
|
1520 ::error ("unknown constant type `%s'", tag); |
|
|
1521 } |
|
|
1522 else |
|
|
1523 ::error ("failed to extract keyword specifying value type"); |
|
|
1524 |
|
|
1525 delete [] tag; |
|
|
1526 |
|
|
1527 return is_global; |
|
|
1528 } |
|
|
1529 |
|
|
1530 tree_constant_rep::constant_type |
|
|
1531 tree_constant_rep::load (istream& is, tree_constant_rep::constant_type t) |
|
|
1532 { |
|
|
1533 tree_constant_rep::constant_type status = unknown_constant; |
|
|
1534 |
|
|
1535 switch (t) |
|
|
1536 { |
|
|
1537 case scalar_constant: |
|
|
1538 is >> scalar; |
|
|
1539 if (is) |
|
|
1540 status = scalar_constant; |
|
|
1541 else |
|
|
1542 ::error ("failed to load scalar constant"); |
|
|
1543 break; |
|
|
1544 case matrix_constant: |
|
|
1545 { |
|
|
1546 int nr = 0, nc = 0; |
|
|
1547 |
|
|
1548 if (extract_keyword (is, "rows", nr) && nr > 0 |
|
|
1549 && extract_keyword (is, "columns", nc) && nc > 0) |
|
|
1550 { |
|
|
1551 matrix = new Matrix (nr, nc); |
|
|
1552 is >> *matrix; |
|
|
1553 if (is) |
|
|
1554 status = matrix_constant; |
|
|
1555 else |
|
|
1556 ::error ("failed to load matrix constant"); |
|
|
1557 } |
|
|
1558 else |
|
|
1559 ::error ("failed to extract number of rows and columns"); |
|
|
1560 } |
|
|
1561 break; |
|
|
1562 case complex_scalar_constant: |
|
|
1563 complex_scalar = new Complex; |
|
|
1564 is >> *complex_scalar; |
|
|
1565 if (is) |
|
|
1566 status = complex_scalar_constant; |
|
|
1567 else |
|
|
1568 ::error ("failed to load complex scalar constant"); |
|
|
1569 break; |
|
|
1570 case complex_matrix_constant: |
|
|
1571 { |
|
|
1572 int nr = 0, nc = 0; |
|
|
1573 |
|
|
1574 if (extract_keyword (is, "rows", nr) && nr > 0 |
|
|
1575 && extract_keyword (is, "columns", nc) && nc > 0) |
|
|
1576 { |
|
|
1577 complex_matrix = new ComplexMatrix (nr, nc); |
|
|
1578 is >> *complex_matrix; |
|
|
1579 if (is) |
|
|
1580 status = complex_matrix_constant; |
|
|
1581 else |
|
|
1582 ::error ("failed to load complex matrix constant"); |
|
|
1583 } |
|
|
1584 else |
|
|
1585 ::error ("failed to extract number of rows and columns"); |
|
|
1586 } |
|
|
1587 break; |
|
|
1588 case string_constant: |
|
|
1589 { |
|
|
1590 int len; |
|
|
1591 if (extract_keyword (is, "length", len) && len > 0) |
|
|
1592 { |
|
|
1593 string = new char [len+1]; |
|
|
1594 is.get (string, len+1, EOF); |
|
|
1595 if (is) |
|
|
1596 status = string_constant; |
|
|
1597 else |
|
|
1598 ::error ("failed to load string constant"); |
|
|
1599 } |
|
|
1600 else |
|
|
1601 ::error ("failed to extract string length"); |
|
|
1602 } |
|
|
1603 break; |
|
|
1604 case range_constant: |
|
|
1605 skip_comments (is); |
|
|
1606 range = new Range (); |
|
|
1607 is >> *range; |
|
|
1608 if (is) |
|
|
1609 status = range_constant; |
|
|
1610 else |
|
|
1611 ::error ("failed to load range constant"); |
|
|
1612 break; |
|
|
1613 default: |
|
|
1614 panic_impossible (); |
|
|
1615 break; |
|
|
1616 } |
|
|
1617 return status; |
|
|
1618 } |
|
|
1619 |
|
|
1620 double |
|
|
1621 tree_constant_rep::double_value (void) const |
|
|
1622 { |
|
|
1623 switch (type_tag) |
|
|
1624 { |
|
|
1625 case scalar_constant: |
|
|
1626 return scalar; |
|
|
1627 case complex_scalar_constant: |
|
|
1628 { |
|
|
1629 int flag = user_pref.ok_to_lose_imaginary_part; |
|
|
1630 if (flag == -1) |
|
|
1631 warning ("implicit conversion of complex value to real value"); |
|
|
1632 |
|
|
1633 if (flag != 0) |
|
|
1634 return ::real (*complex_scalar); |
|
|
1635 |
|
|
1636 ::error ("implicit conversion of complex value to real value"); |
|
|
1637 ::error ("not allowed"); |
|
|
1638 jump_to_top_level (); |
|
|
1639 } |
|
|
1640 default: |
|
|
1641 panic_impossible (); |
|
|
1642 break; |
|
|
1643 } |
|
|
1644 } |
|
|
1645 |
|
|
1646 Matrix |
|
|
1647 tree_constant_rep::matrix_value (void) const |
|
|
1648 { |
|
|
1649 switch (type_tag) |
|
|
1650 { |
|
|
1651 case scalar_constant: |
|
|
1652 return Matrix (1, 1, scalar); |
|
|
1653 case matrix_constant: |
|
|
1654 return *matrix; |
|
|
1655 case complex_scalar_constant: |
|
|
1656 case complex_matrix_constant: |
|
|
1657 { |
|
|
1658 int flag = user_pref.ok_to_lose_imaginary_part; |
|
|
1659 if (flag == -1) |
|
|
1660 warning ("implicit conversion of complex matrix to real matrix"); |
|
|
1661 |
|
|
1662 if (flag != 0) |
|
|
1663 { |
|
|
1664 if (type_tag == complex_scalar_constant) |
|
|
1665 return Matrix (1, 1, ::real (*complex_scalar)); |
|
|
1666 else if (type_tag == complex_matrix_constant) |
|
|
1667 return ::real (*complex_matrix); |
|
|
1668 else |
|
|
1669 panic_impossible (); |
|
|
1670 } |
|
|
1671 else |
|
|
1672 { |
|
|
1673 ::error ("implicit conversion of complex matrix to real matrix"); |
|
|
1674 ::error ("not allowed"); |
|
|
1675 } |
|
|
1676 jump_to_top_level (); |
|
|
1677 } |
|
|
1678 default: |
|
|
1679 panic_impossible (); |
|
|
1680 break; |
|
|
1681 } |
|
|
1682 } |
|
|
1683 |
|
|
1684 Complex |
|
|
1685 tree_constant_rep::complex_value (void) const |
|
|
1686 { |
|
|
1687 switch (type_tag) |
|
|
1688 { |
|
|
1689 case complex_scalar_constant: |
|
|
1690 return *complex_scalar; |
|
|
1691 case scalar_constant: |
|
|
1692 return Complex (scalar); |
|
|
1693 default: |
|
|
1694 panic_impossible (); |
|
|
1695 break; |
|
|
1696 } |
|
|
1697 } |
|
|
1698 |
|
|
1699 ComplexMatrix |
|
|
1700 tree_constant_rep::complex_matrix_value (void) const |
|
|
1701 { |
|
|
1702 switch (type_tag) |
|
|
1703 { |
|
|
1704 case scalar_constant: |
|
|
1705 { |
|
|
1706 return ComplexMatrix (1, 1, Complex (scalar)); |
|
|
1707 } |
|
|
1708 case complex_scalar_constant: |
|
|
1709 { |
|
|
1710 return ComplexMatrix (1, 1, *complex_scalar); |
|
|
1711 } |
|
|
1712 case matrix_constant: |
|
|
1713 { |
|
|
1714 return ComplexMatrix (*matrix); |
|
|
1715 } |
|
|
1716 case complex_matrix_constant: |
|
|
1717 return *complex_matrix; |
|
|
1718 break; |
|
|
1719 default: |
|
|
1720 panic_impossible (); |
|
|
1721 break; |
|
|
1722 } |
|
|
1723 } |
|
|
1724 |
|
|
1725 char * |
|
|
1726 tree_constant_rep::string_value (void) const |
|
|
1727 { |
|
|
1728 assert (type_tag == string_constant); |
|
|
1729 return string; |
|
|
1730 } |
|
|
1731 |
|
|
1732 Range |
|
|
1733 tree_constant_rep::range_value (void) const |
|
|
1734 { |
|
|
1735 assert (type_tag == range_constant); |
|
|
1736 return *range; |
|
|
1737 } |
|
|
1738 |
|
|
1739 int |
|
|
1740 tree_constant_rep::rows (void) const |
|
|
1741 { |
|
|
1742 int retval = -1; |
|
|
1743 switch (type_tag) |
|
|
1744 { |
|
|
1745 case scalar_constant: |
|
|
1746 case complex_scalar_constant: |
|
|
1747 retval = 1; |
|
|
1748 break; |
|
|
1749 case string_constant: |
|
|
1750 case range_constant: |
|
|
1751 retval = (columns () > 0); |
|
|
1752 break; |
|
|
1753 case matrix_constant: |
|
|
1754 retval = matrix->rows (); |
|
|
1755 break; |
|
|
1756 case complex_matrix_constant: |
|
|
1757 retval = complex_matrix->rows (); |
|
|
1758 break; |
|
|
1759 case magic_colon: |
|
|
1760 ::error ("invalid use of colon operator"); |
|
|
1761 break; |
|
|
1762 case unknown_constant: |
|
|
1763 retval = 0; |
|
|
1764 break; |
|
|
1765 default: |
|
|
1766 panic_impossible (); |
|
|
1767 break; |
|
|
1768 } |
|
|
1769 return retval; |
|
|
1770 } |
|
|
1771 |
|
|
1772 int |
|
|
1773 tree_constant_rep::columns (void) const |
|
|
1774 { |
|
|
1775 int retval = -1; |
|
|
1776 switch (type_tag) |
|
|
1777 { |
|
|
1778 case scalar_constant: |
|
|
1779 case complex_scalar_constant: |
|
|
1780 retval = 1; |
|
|
1781 break; |
|
|
1782 case matrix_constant: |
|
|
1783 retval = matrix->columns (); |
|
|
1784 break; |
|
|
1785 case complex_matrix_constant: |
|
|
1786 retval = complex_matrix->columns (); |
|
|
1787 break; |
|
|
1788 case string_constant: |
|
|
1789 retval = strlen (string); |
|
|
1790 break; |
|
|
1791 case range_constant: |
|
|
1792 retval = range->nelem (); |
|
|
1793 break; |
|
|
1794 case magic_colon: |
|
|
1795 ::error ("invalid use of colon operator"); |
|
|
1796 break; |
|
|
1797 case unknown_constant: |
|
|
1798 retval = 0; |
|
|
1799 break; |
|
|
1800 default: |
|
|
1801 panic_impossible (); |
|
|
1802 break; |
|
|
1803 } |
|
|
1804 return retval; |
|
|
1805 } |
|
|
1806 |
|
|
1807 tree_constant |
|
|
1808 tree_constant_rep::all (void) const |
|
|
1809 { |
|
|
1810 if (type_tag == string_constant || type_tag == range_constant) |
|
|
1811 { |
|
|
1812 tree_constant tmp = make_numeric (); |
|
|
1813 return tmp.all (); |
|
|
1814 } |
|
|
1815 |
|
|
1816 tree_constant retval; |
|
|
1817 switch (type_tag) |
|
|
1818 { |
|
|
1819 case scalar_constant: |
|
|
1820 { |
|
|
1821 double status = (scalar != 0.0); |
|
|
1822 retval = tree_constant (status); |
|
|
1823 } |
|
|
1824 break; |
|
|
1825 case matrix_constant: |
|
|
1826 { |
|
|
1827 Matrix m = matrix->all (); |
|
|
1828 retval = tree_constant (m); |
|
|
1829 } |
|
|
1830 break; |
|
|
1831 case complex_scalar_constant: |
|
|
1832 { |
|
|
1833 double status = (*complex_scalar != 0.0); |
|
|
1834 retval = tree_constant (status); |
|
|
1835 } |
|
|
1836 break; |
|
|
1837 case complex_matrix_constant: |
|
|
1838 { |
|
|
1839 Matrix m = complex_matrix->all (); |
|
|
1840 retval = tree_constant (m); |
|
|
1841 } |
|
|
1842 break; |
|
|
1843 case string_constant: |
|
|
1844 case range_constant: |
|
|
1845 case magic_colon: |
|
|
1846 default: |
|
|
1847 panic_impossible (); |
|
|
1848 break; |
|
|
1849 } |
|
|
1850 return retval; |
|
|
1851 } |
|
|
1852 |
|
|
1853 tree_constant |
|
|
1854 tree_constant_rep::any (void) const |
|
|
1855 { |
|
|
1856 if (type_tag == string_constant || type_tag == range_constant) |
|
|
1857 { |
|
|
1858 tree_constant tmp = make_numeric (); |
|
|
1859 return tmp.any (); |
|
|
1860 } |
|
|
1861 |
|
|
1862 tree_constant retval; |
|
|
1863 switch (type_tag) |
|
|
1864 { |
|
|
1865 case scalar_constant: |
|
|
1866 { |
|
|
1867 double status = (scalar != 0.0); |
|
|
1868 retval = tree_constant (status); |
|
|
1869 } |
|
|
1870 break; |
|
|
1871 case matrix_constant: |
|
|
1872 { |
|
|
1873 Matrix m = matrix->any (); |
|
|
1874 retval = tree_constant (m); |
|
|
1875 } |
|
|
1876 break; |
|
|
1877 case complex_scalar_constant: |
|
|
1878 { |
|
|
1879 double status = (*complex_scalar != 0.0); |
|
|
1880 retval = tree_constant (status); |
|
|
1881 } |
|
|
1882 break; |
|
|
1883 case complex_matrix_constant: |
|
|
1884 { |
|
|
1885 Matrix m = complex_matrix->any (); |
|
|
1886 retval = tree_constant (m); |
|
|
1887 } |
|
|
1888 break; |
|
|
1889 case string_constant: |
|
|
1890 case range_constant: |
|
|
1891 case magic_colon: |
|
|
1892 default: |
|
|
1893 panic_impossible (); |
|
|
1894 break; |
|
|
1895 } |
|
|
1896 return retval; |
|
|
1897 } |
|
|
1898 |
|
|
1899 tree_constant |
|
|
1900 tree_constant_rep::isstr (void) const |
|
|
1901 { |
|
|
1902 double status = 0.0; |
|
|
1903 if (type_tag == string_constant) |
|
|
1904 status = 1.0; |
|
|
1905 tree_constant retval (status); |
|
|
1906 return retval; |
|
|
1907 } |
|
|
1908 |
|
|
1909 tree_constant |
|
|
1910 tree_constant_rep::convert_to_str (void) |
|
|
1911 { |
|
|
1912 tree_constant retval; |
|
|
1913 |
|
|
1914 switch (type_tag) |
|
|
1915 { |
|
|
1916 case complex_scalar_constant: |
|
|
1917 case scalar_constant: |
|
|
1918 { |
|
|
1919 double d = double_value (); |
|
|
1920 int i = NINT (d); |
|
|
1921 // Warn about out of range conversions? |
|
|
1922 char s[2]; |
|
|
1923 s[0] = (char) i; |
|
|
1924 s[1] = '\0'; |
|
|
1925 retval = tree_constant (s); |
|
|
1926 } |
|
|
1927 break; |
|
|
1928 case complex_matrix_constant: |
|
|
1929 case matrix_constant: |
|
|
1930 { |
|
|
1931 ColumnVector v = to_vector (); |
|
|
1932 int len = v.length (); |
|
|
1933 if (len == 0) |
|
|
1934 ::error ("can only convert vectors and scalars to strings"); |
|
|
1935 else |
|
|
1936 { |
|
|
1937 char *s = new char [len+1]; |
|
|
1938 s[len] = '\0'; |
|
|
1939 for (int i = 0; i < len; i++) |
|
|
1940 { |
|
|
1941 double d = v.elem (i); |
|
|
1942 int ival = NINT (d); |
|
|
1943 // Warn about out of range conversions? |
|
|
1944 s[i] = (char) ival; |
|
|
1945 } |
|
|
1946 retval = tree_constant (s); |
|
|
1947 delete [] s; |
|
|
1948 } |
|
|
1949 } |
|
|
1950 break; |
|
|
1951 case range_constant: |
|
|
1952 { |
|
|
1953 Range r = range_value (); |
|
|
1954 double b = r.base (); |
|
|
1955 double incr = r.inc (); |
|
|
1956 int nel = r.nelem (); |
|
|
1957 char *s = new char [nel+1]; |
|
|
1958 s[nel] = '\0'; |
|
|
1959 for (int i = 0; i < nel; i++) |
|
|
1960 { |
|
|
1961 double d = b + i * incr; |
|
|
1962 int ival = NINT (d); |
|
|
1963 // Warn about out of range conversions? |
|
|
1964 s[i] = (char) ival; |
|
|
1965 } |
|
|
1966 retval = tree_constant (s); |
|
|
1967 delete [] s; |
|
|
1968 } |
|
|
1969 break; |
|
|
1970 case string_constant: |
|
|
1971 retval = tree_constant (*this); |
|
|
1972 break; |
|
|
1973 case magic_colon: |
|
|
1974 default: |
|
|
1975 panic_impossible (); |
|
|
1976 break; |
|
|
1977 } |
|
|
1978 return retval; |
|
|
1979 } |
|
|
1980 |
|
|
1981 void |
|
|
1982 tree_constant_rep::convert_to_row_or_column_vector (void) |
|
|
1983 { |
|
|
1984 assert (type_tag == matrix_constant || type_tag == complex_matrix_constant); |
|
|
1985 |
|
|
1986 int nr = rows (); |
|
|
1987 int nc = columns (); |
|
|
1988 |
|
509
|
1989 if (nr == 1 || nc == 1) |
|
|
1990 return; |
|
|
1991 |
|
492
|
1992 int len = nr * nc; |
|
|
1993 |
|
|
1994 assert (len > 0); |
|
|
1995 |
|
|
1996 int new_nr = 1; |
|
|
1997 int new_nc = 1; |
|
|
1998 |
|
|
1999 if (user_pref.prefer_column_vectors) |
|
|
2000 new_nr = len; |
|
|
2001 else |
|
|
2002 new_nc = len; |
|
|
2003 |
|
|
2004 if (type_tag == matrix_constant) |
|
|
2005 { |
|
|
2006 Matrix *m = new Matrix (new_nr, new_nc); |
|
|
2007 |
|
|
2008 double *cop_out = matrix->fortran_vec (); |
|
|
2009 |
|
|
2010 for (int i = 0; i < len; i++) |
|
|
2011 { |
|
|
2012 if (new_nr == 1) |
|
|
2013 m->elem (0, i) = *cop_out++; |
|
|
2014 else |
|
|
2015 m->elem (i, 0) = *cop_out++; |
|
|
2016 } |
|
|
2017 |
|
|
2018 delete matrix; |
|
|
2019 matrix = m; |
|
|
2020 } |
|
|
2021 else |
|
|
2022 { |
|
|
2023 ComplexMatrix *cm = new ComplexMatrix (new_nr, new_nc); |
|
|
2024 |
|
|
2025 Complex *cop_out = complex_matrix->fortran_vec (); |
|
|
2026 |
|
|
2027 for (int i = 0; i < len; i++) |
|
|
2028 { |
|
|
2029 if (new_nr == 1) |
|
|
2030 cm->elem (0, i) = *cop_out++; |
|
|
2031 else |
|
|
2032 cm->elem (i, 0) = *cop_out++; |
|
|
2033 } |
|
|
2034 |
|
|
2035 delete complex_matrix; |
|
|
2036 complex_matrix = cm; |
|
|
2037 } |
|
|
2038 } |
|
|
2039 |
|
|
2040 int |
|
|
2041 tree_constant_rep::is_true (void) const |
|
|
2042 { |
|
|
2043 if (type_tag == string_constant || type_tag == range_constant) |
|
|
2044 { |
|
|
2045 tree_constant tmp = make_numeric (); |
|
|
2046 return tmp.is_true (); |
|
|
2047 } |
|
|
2048 |
|
|
2049 int retval; |
|
|
2050 switch (type_tag) |
|
|
2051 { |
|
|
2052 case scalar_constant: |
|
|
2053 retval = (scalar != 0.0); |
|
|
2054 break; |
|
|
2055 case matrix_constant: |
|
|
2056 { |
|
|
2057 Matrix m = (matrix->all ()) . all (); |
|
|
2058 retval = (m.rows () == 1 |
|
|
2059 && m.columns () == 1 |
|
|
2060 && m.elem (0, 0) != 0.0); |
|
|
2061 } |
|
|
2062 break; |
|
|
2063 case complex_scalar_constant: |
|
|
2064 retval = (*complex_scalar != 0.0); |
|
|
2065 break; |
|
|
2066 case complex_matrix_constant: |
|
|
2067 { |
|
|
2068 Matrix m = (complex_matrix->all ()) . all (); |
|
|
2069 retval = (m.rows () == 1 |
|
|
2070 && m.columns () == 1 |
|
|
2071 && m.elem (0, 0) != 0.0); |
|
|
2072 } |
|
|
2073 break; |
|
|
2074 case string_constant: |
|
|
2075 case range_constant: |
|
|
2076 case magic_colon: |
|
|
2077 default: |
|
|
2078 panic_impossible (); |
|
|
2079 break; |
|
|
2080 } |
|
|
2081 return retval; |
|
|
2082 } |
|
|
2083 |
|
|
2084 tree_constant |
|
|
2085 tree_constant_rep::cumprod (void) const |
|
|
2086 { |
|
|
2087 if (type_tag == string_constant || type_tag == range_constant) |
|
|
2088 { |
|
|
2089 tree_constant tmp = make_numeric (); |
|
|
2090 return tmp.cumprod (); |
|
|
2091 } |
|
|
2092 |
|
|
2093 tree_constant retval; |
|
|
2094 switch (type_tag) |
|
|
2095 { |
|
|
2096 case scalar_constant: |
|
|
2097 retval = tree_constant (scalar); |
|
|
2098 break; |
|
|
2099 case matrix_constant: |
|
|
2100 { |
|
|
2101 Matrix m = matrix->cumprod (); |
|
|
2102 retval = tree_constant (m); |
|
|
2103 } |
|
|
2104 break; |
|
|
2105 case complex_scalar_constant: |
|
|
2106 retval = tree_constant (*complex_scalar); |
|
|
2107 break; |
|
|
2108 case complex_matrix_constant: |
|
|
2109 { |
|
|
2110 ComplexMatrix m = complex_matrix->cumprod (); |
|
|
2111 retval = tree_constant (m); |
|
|
2112 } |
|
|
2113 break; |
|
|
2114 case string_constant: |
|
|
2115 case range_constant: |
|
|
2116 case magic_colon: |
|
|
2117 default: |
|
|
2118 panic_impossible (); |
|
|
2119 break; |
|
|
2120 } |
|
|
2121 return retval; |
|
|
2122 } |
|
|
2123 |
|
|
2124 tree_constant |
|
|
2125 tree_constant_rep::cumsum (void) const |
|
|
2126 { |
|
|
2127 if (type_tag == string_constant || type_tag == range_constant) |
|
|
2128 { |
|
|
2129 tree_constant tmp = make_numeric (); |
|
|
2130 return tmp.cumsum (); |
|
|
2131 } |
|
|
2132 |
|
|
2133 tree_constant retval; |
|
|
2134 switch (type_tag) |
|
|
2135 { |
|
|
2136 case scalar_constant: |
|
|
2137 retval = tree_constant (scalar); |
|
|
2138 break; |
|
|
2139 case matrix_constant: |
|
|
2140 { |
|
|
2141 Matrix m = matrix->cumsum (); |
|
|
2142 retval = tree_constant (m); |
|
|
2143 } |
|
|
2144 break; |
|
|
2145 case complex_scalar_constant: |
|
|
2146 retval = tree_constant (*complex_scalar); |
|
|
2147 break; |
|
|
2148 case complex_matrix_constant: |
|
|
2149 { |
|
|
2150 ComplexMatrix m = complex_matrix->cumsum (); |
|
|
2151 retval = tree_constant (m); |
|
|
2152 } |
|
|
2153 break; |
|
|
2154 case string_constant: |
|
|
2155 case range_constant: |
|
|
2156 case magic_colon: |
|
|
2157 default: |
|
|
2158 panic_impossible (); |
|
|
2159 break; |
|
|
2160 } |
|
|
2161 return retval; |
|
|
2162 } |
|
|
2163 |
|
|
2164 tree_constant |
|
|
2165 tree_constant_rep::prod (void) const |
|
|
2166 { |
|
|
2167 if (type_tag == string_constant || type_tag == range_constant) |
|
|
2168 { |
|
|
2169 tree_constant tmp = make_numeric (); |
|
|
2170 return tmp.prod (); |
|
|
2171 } |
|
|
2172 |
|
|
2173 tree_constant retval; |
|
|
2174 switch (type_tag) |
|
|
2175 { |
|
|
2176 case scalar_constant: |
|
|
2177 retval = tree_constant (scalar); |
|
|
2178 break; |
|
|
2179 case matrix_constant: |
|
|
2180 { |
|
|
2181 Matrix m = matrix->prod (); |
|
|
2182 retval = tree_constant (m); |
|
|
2183 } |
|
|
2184 break; |
|
|
2185 case complex_scalar_constant: |
|
|
2186 retval = tree_constant (*complex_scalar); |
|
|
2187 break; |
|
|
2188 case complex_matrix_constant: |
|
|
2189 { |
|
|
2190 ComplexMatrix m = complex_matrix->prod (); |
|
|
2191 retval = tree_constant (m); |
|
|
2192 } |
|
|
2193 break; |
|
|
2194 case string_constant: |
|
|
2195 case range_constant: |
|
|
2196 case magic_colon: |
|
|
2197 default: |
|
|
2198 panic_impossible (); |
|
|
2199 break; |
|
|
2200 } |
|
|
2201 return retval; |
|
|
2202 } |
|
|
2203 |
|
|
2204 tree_constant |
|
|
2205 tree_constant_rep::sum (void) const |
|
|
2206 { |
|
|
2207 if (type_tag == string_constant || type_tag == range_constant) |
|
|
2208 { |
|
|
2209 tree_constant tmp = make_numeric (); |
|
|
2210 return tmp.sum (); |
|
|
2211 } |
|
|
2212 |
|
|
2213 tree_constant retval; |
|
|
2214 switch (type_tag) |
|
|
2215 { |
|
|
2216 case scalar_constant: |
|
|
2217 retval = tree_constant (scalar); |
|
|
2218 break; |
|
|
2219 case matrix_constant: |
|
|
2220 { |
|
|
2221 Matrix m = matrix->sum (); |
|
|
2222 retval = tree_constant (m); |
|
|
2223 } |
|
|
2224 break; |
|
|
2225 case complex_scalar_constant: |
|
|
2226 retval = tree_constant (*complex_scalar); |
|
|
2227 break; |
|
|
2228 case complex_matrix_constant: |
|
|
2229 { |
|
|
2230 ComplexMatrix m = complex_matrix->sum (); |
|
|
2231 retval = tree_constant (m); |
|
|
2232 } |
|
|
2233 break; |
|
|
2234 case string_constant: |
|
|
2235 case range_constant: |
|
|
2236 case magic_colon: |
|
|
2237 default: |
|
|
2238 panic_impossible (); |
|
|
2239 break; |
|
|
2240 } |
|
|
2241 return retval; |
|
|
2242 } |
|
|
2243 |
|
|
2244 tree_constant |
|
|
2245 tree_constant_rep::sumsq (void) const |
|
|
2246 { |
|
|
2247 if (type_tag == string_constant || type_tag == range_constant) |
|
|
2248 { |
|
|
2249 tree_constant tmp = make_numeric (); |
|
|
2250 return tmp.sumsq (); |
|
|
2251 } |
|
|
2252 |
|
|
2253 tree_constant retval; |
|
|
2254 switch (type_tag) |
|
|
2255 { |
|
|
2256 case scalar_constant: |
|
|
2257 retval = tree_constant (scalar * scalar); |
|
|
2258 break; |
|
|
2259 case matrix_constant: |
|
|
2260 { |
|
|
2261 Matrix m = matrix->sumsq (); |
|
|
2262 retval = tree_constant (m); |
|
|
2263 } |
|
|
2264 break; |
|
|
2265 case complex_scalar_constant: |
|
|
2266 { |
|
|
2267 Complex c (*complex_scalar); |
|
|
2268 retval = tree_constant (c * c); |
|
|
2269 } |
|
|
2270 break; |
|
|
2271 case complex_matrix_constant: |
|
|
2272 { |
|
|
2273 ComplexMatrix m = complex_matrix->sumsq (); |
|
|
2274 retval = tree_constant (m); |
|
|
2275 } |
|
|
2276 break; |
|
|
2277 case string_constant: |
|
|
2278 case range_constant: |
|
|
2279 case magic_colon: |
|
|
2280 default: |
|
|
2281 panic_impossible (); |
|
|
2282 break; |
|
|
2283 } |
|
|
2284 return retval; |
|
|
2285 } |
|
|
2286 |
|
|
2287 static tree_constant |
|
|
2288 make_diag (const Matrix& v, int k) |
|
|
2289 { |
|
|
2290 int nr = v.rows (); |
|
|
2291 int nc = v.columns (); |
|
|
2292 assert (nc == 1 || nr == 1); |
|
|
2293 |
|
|
2294 tree_constant retval; |
|
|
2295 |
|
|
2296 int roff = 0; |
|
|
2297 int coff = 0; |
|
|
2298 if (k > 0) |
|
|
2299 { |
|
|
2300 roff = 0; |
|
|
2301 coff = k; |
|
|
2302 } |
|
|
2303 else if (k < 0) |
|
|
2304 { |
|
|
2305 roff = -k; |
|
|
2306 coff = 0; |
|
|
2307 } |
|
|
2308 |
|
|
2309 if (nr == 1) |
|
|
2310 { |
|
|
2311 int n = nc + ABS (k); |
|
|
2312 Matrix m (n, n, 0.0); |
|
|
2313 for (int i = 0; i < nc; i++) |
|
|
2314 m.elem (i+roff, i+coff) = v.elem (0, i); |
|
|
2315 retval = tree_constant (m); |
|
|
2316 } |
|
|
2317 else |
|
|
2318 { |
|
|
2319 int n = nr + ABS (k); |
|
|
2320 Matrix m (n, n, 0.0); |
|
|
2321 for (int i = 0; i < nr; i++) |
|
|
2322 m.elem (i+roff, i+coff) = v.elem (i, 0); |
|
|
2323 retval = tree_constant (m); |
|
|
2324 } |
|
|
2325 |
|
|
2326 return retval; |
|
|
2327 } |
|
|
2328 |
|
|
2329 static tree_constant |
|
|
2330 make_diag (const ComplexMatrix& v, int k) |
|
|
2331 { |
|
|
2332 int nr = v.rows (); |
|
|
2333 int nc = v.columns (); |
|
|
2334 assert (nc == 1 || nr == 1); |
|
|
2335 |
|
|
2336 tree_constant retval; |
|
|
2337 |
|
|
2338 int roff = 0; |
|
|
2339 int coff = 0; |
|
|
2340 if (k > 0) |
|
|
2341 { |
|
|
2342 roff = 0; |
|
|
2343 coff = k; |
|
|
2344 } |
|
|
2345 else if (k < 0) |
|
|
2346 { |
|
|
2347 roff = -k; |
|
|
2348 coff = 0; |
|
|
2349 } |
|
|
2350 |
|
|
2351 if (nr == 1) |
|
|
2352 { |
|
|
2353 int n = nc + ABS (k); |
|
|
2354 ComplexMatrix m (n, n, 0.0); |
|
|
2355 for (int i = 0; i < nc; i++) |
|
|
2356 m.elem (i+roff, i+coff) = v.elem (0, i); |
|
|
2357 retval = tree_constant (m); |
|
|
2358 } |
|
|
2359 else |
|
|
2360 { |
|
|
2361 int n = nr + ABS (k); |
|
|
2362 ComplexMatrix m (n, n, 0.0); |
|
|
2363 for (int i = 0; i < nr; i++) |
|
|
2364 m.elem (i+roff, i+coff) = v.elem (i, 0); |
|
|
2365 retval = tree_constant (m); |
|
|
2366 } |
|
|
2367 |
|
|
2368 return retval; |
|
|
2369 } |
|
|
2370 |
|
|
2371 tree_constant |
|
|
2372 tree_constant_rep::diag (void) const |
|
|
2373 { |
|
|
2374 if (type_tag == string_constant || type_tag == range_constant) |
|
|
2375 { |
|
|
2376 tree_constant tmp = make_numeric (); |
|
|
2377 return tmp.diag (); |
|
|
2378 } |
|
|
2379 |
|
|
2380 tree_constant retval; |
|
|
2381 switch (type_tag) |
|
|
2382 { |
|
|
2383 case scalar_constant: |
|
|
2384 retval = tree_constant (scalar); |
|
|
2385 break; |
|
|
2386 case matrix_constant: |
|
|
2387 { |
|
|
2388 int nr = rows (); |
|
|
2389 int nc = columns (); |
|
|
2390 if (nr == 0 || nc == 0) |
|
|
2391 { |
|
|
2392 Matrix mtmp; |
|
|
2393 retval = tree_constant (mtmp); |
|
|
2394 } |
|
|
2395 else if (nr == 1 || nc == 1) |
|
|
2396 retval = make_diag (matrix_value (), 0); |
|
|
2397 else |
|
|
2398 { |
|
|
2399 ColumnVector v = matrix->diag (); |
|
|
2400 if (v.capacity () > 0) |
|
|
2401 retval = tree_constant (v); |
|
|
2402 } |
|
|
2403 } |
|
|
2404 break; |
|
|
2405 case complex_scalar_constant: |
|
|
2406 retval = tree_constant (*complex_scalar); |
|
|
2407 break; |
|
|
2408 case complex_matrix_constant: |
|
|
2409 { |
|
|
2410 int nr = rows (); |
|
|
2411 int nc = columns (); |
|
|
2412 if (nr == 0 || nc == 0) |
|
|
2413 { |
|
|
2414 Matrix mtmp; |
|
|
2415 retval = tree_constant (mtmp); |
|
|
2416 } |
|
|
2417 else if (nr == 1 || nc == 1) |
|
|
2418 retval = make_diag (complex_matrix_value (), 0); |
|
|
2419 else |
|
|
2420 { |
|
|
2421 ComplexColumnVector v = complex_matrix->diag (); |
|
|
2422 if (v.capacity () > 0) |
|
|
2423 retval = tree_constant (v); |
|
|
2424 } |
|
|
2425 } |
|
|
2426 break; |
|
|
2427 case string_constant: |
|
|
2428 case range_constant: |
|
|
2429 case magic_colon: |
|
|
2430 default: |
|
|
2431 panic_impossible (); |
|
|
2432 break; |
|
|
2433 } |
|
|
2434 return retval; |
|
|
2435 } |
|
|
2436 |
|
|
2437 tree_constant |
|
|
2438 tree_constant_rep::diag (const tree_constant& a) const |
|
|
2439 { |
|
|
2440 if (type_tag == string_constant || type_tag == range_constant) |
|
|
2441 { |
|
|
2442 tree_constant tmp = make_numeric (); |
|
|
2443 return tmp.diag (a); |
|
|
2444 } |
|
|
2445 |
|
|
2446 tree_constant tmp_a = a.make_numeric (); |
|
|
2447 |
|
|
2448 tree_constant_rep::constant_type a_type = tmp_a.const_type (); |
|
|
2449 |
|
|
2450 tree_constant retval; |
|
|
2451 |
|
|
2452 switch (type_tag) |
|
|
2453 { |
|
|
2454 case scalar_constant: |
|
|
2455 if (a_type == scalar_constant) |
|
|
2456 { |
|
|
2457 int k = NINT (tmp_a.double_value ()); |
|
|
2458 int n = ABS (k) + 1; |
|
|
2459 if (k == 0) |
|
|
2460 retval = tree_constant (scalar); |
|
|
2461 else if (k > 0) |
|
|
2462 { |
|
|
2463 Matrix m (n, n, 0.0); |
|
|
2464 m.elem (0, k) = scalar; |
|
|
2465 retval = tree_constant (m); |
|
|
2466 } |
|
|
2467 else if (k < 0) |
|
|
2468 { |
|
|
2469 Matrix m (n, n, 0.0); |
|
|
2470 m.elem (-k, 0) = scalar; |
|
|
2471 retval = tree_constant (m); |
|
|
2472 } |
|
|
2473 } |
|
|
2474 break; |
|
|
2475 case matrix_constant: |
|
|
2476 if (a_type == scalar_constant) |
|
|
2477 { |
|
|
2478 int k = NINT (tmp_a.double_value ()); |
|
|
2479 int nr = rows (); |
|
|
2480 int nc = columns (); |
|
|
2481 if (nr == 0 || nc == 0) |
|
|
2482 { |
|
|
2483 Matrix mtmp; |
|
|
2484 retval = tree_constant (mtmp); |
|
|
2485 } |
|
|
2486 else if (nr == 1 || nc == 1) |
|
|
2487 retval = make_diag (matrix_value (), k); |
|
|
2488 else |
|
|
2489 { |
|
|
2490 ColumnVector d = matrix->diag (k); |
|
|
2491 retval = tree_constant (d); |
|
|
2492 } |
|
|
2493 } |
|
|
2494 else |
|
|
2495 ::error ("diag: invalid second argument"); |
|
|
2496 |
|
|
2497 break; |
|
|
2498 case complex_scalar_constant: |
|
|
2499 if (a_type == scalar_constant) |
|
|
2500 { |
|
|
2501 int k = NINT (tmp_a.double_value ()); |
|
|
2502 int n = ABS (k) + 1; |
|
|
2503 if (k == 0) |
|
|
2504 retval = tree_constant (*complex_scalar); |
|
|
2505 else if (k > 0) |
|
|
2506 { |
|
|
2507 ComplexMatrix m (n, n, 0.0); |
|
|
2508 m.elem (0, k) = *complex_scalar; |
|
|
2509 retval = tree_constant (m); |
|
|
2510 } |
|
|
2511 else if (k < 0) |
|
|
2512 { |
|
|
2513 ComplexMatrix m (n, n, 0.0); |
|
|
2514 m.elem (-k, 0) = *complex_scalar; |
|
|
2515 retval = tree_constant (m); |
|
|
2516 } |
|
|
2517 } |
|
|
2518 break; |
|
|
2519 case complex_matrix_constant: |
|
|
2520 if (a_type == scalar_constant) |
|
|
2521 { |
|
|
2522 int k = NINT (tmp_a.double_value ()); |
|
|
2523 int nr = rows (); |
|
|
2524 int nc = columns (); |
|
|
2525 if (nr == 0 || nc == 0) |
|
|
2526 { |
|
|
2527 Matrix mtmp; |
|
|
2528 retval = tree_constant (mtmp); |
|
|
2529 } |
|
|
2530 else if (nr == 1 || nc == 1) |
|
|
2531 retval = make_diag (complex_matrix_value (), k); |
|
|
2532 else |
|
|
2533 { |
|
|
2534 ComplexColumnVector d = complex_matrix->diag (k); |
|
|
2535 retval = tree_constant (d); |
|
|
2536 } |
|
|
2537 } |
|
|
2538 else |
|
|
2539 ::error ("diag: invalid second argument"); |
|
|
2540 |
|
|
2541 break; |
|
|
2542 case string_constant: |
|
|
2543 case range_constant: |
|
|
2544 case magic_colon: |
|
|
2545 default: |
|
|
2546 panic_impossible (); |
|
|
2547 break; |
|
|
2548 } |
|
|
2549 return retval; |
|
|
2550 } |
|
|
2551 |
|
|
2552 tree_constant |
|
|
2553 tree_constant_rep::mapper (Mapper_fcn& m_fcn, int print) const |
|
|
2554 { |
|
|
2555 tree_constant retval; |
|
|
2556 |
|
|
2557 if (type_tag == string_constant || type_tag == range_constant) |
|
|
2558 { |
|
|
2559 tree_constant tmp = make_numeric (); |
|
|
2560 return tmp.mapper (m_fcn, print); |
|
|
2561 } |
|
|
2562 |
|
|
2563 switch (type_tag) |
|
|
2564 { |
|
|
2565 case scalar_constant: |
|
|
2566 if (m_fcn.can_return_complex_for_real_arg |
|
|
2567 && (scalar < m_fcn.lower_limit |
|
|
2568 || scalar > m_fcn.upper_limit)) |
|
|
2569 { |
|
529
|
2570 if (m_fcn.c_c_mapper) |
|
492
|
2571 { |
|
|
2572 Complex c = m_fcn.c_c_mapper (Complex (scalar)); |
|
|
2573 retval = tree_constant (c); |
|
|
2574 } |
|
|
2575 else |
|
|
2576 panic_impossible (); |
|
|
2577 } |
|
|
2578 else |
|
|
2579 { |
|
529
|
2580 if (m_fcn.d_d_mapper) |
|
492
|
2581 { |
|
|
2582 double d = m_fcn.d_d_mapper (scalar); |
|
|
2583 retval = tree_constant (d); |
|
|
2584 } |
|
|
2585 else |
|
|
2586 panic_impossible (); |
|
|
2587 } |
|
|
2588 break; |
|
|
2589 case matrix_constant: |
|
|
2590 if (m_fcn.can_return_complex_for_real_arg |
|
|
2591 && (any_element_less_than (*matrix, m_fcn.lower_limit) |
|
|
2592 || any_element_greater_than (*matrix, m_fcn.upper_limit))) |
|
|
2593 { |
|
529
|
2594 if (m_fcn.c_c_mapper) |
|
492
|
2595 { |
|
|
2596 ComplexMatrix cm = map (m_fcn.c_c_mapper, |
|
|
2597 ComplexMatrix (*matrix)); |
|
|
2598 retval = tree_constant (cm); |
|
|
2599 } |
|
|
2600 else |
|
|
2601 panic_impossible (); |
|
|
2602 } |
|
|
2603 else |
|
|
2604 { |
|
529
|
2605 if (m_fcn.d_d_mapper) |
|
492
|
2606 { |
|
|
2607 Matrix m = map (m_fcn.d_d_mapper, *matrix); |
|
|
2608 retval = tree_constant (m); |
|
|
2609 } |
|
|
2610 else |
|
|
2611 panic_impossible (); |
|
|
2612 } |
|
|
2613 break; |
|
|
2614 case complex_scalar_constant: |
|
529
|
2615 if (m_fcn.d_c_mapper) |
|
492
|
2616 { |
|
|
2617 double d; |
|
|
2618 d = m_fcn.d_c_mapper (*complex_scalar); |
|
|
2619 retval = tree_constant (d); |
|
|
2620 } |
|
529
|
2621 else if (m_fcn.c_c_mapper) |
|
492
|
2622 { |
|
|
2623 Complex c; |
|
|
2624 c = m_fcn.c_c_mapper (*complex_scalar); |
|
|
2625 retval = tree_constant (c); |
|
|
2626 } |
|
|
2627 else |
|
|
2628 panic_impossible (); |
|
|
2629 break; |
|
|
2630 case complex_matrix_constant: |
|
529
|
2631 if (m_fcn.d_c_mapper) |
|
492
|
2632 { |
|
|
2633 Matrix m; |
|
|
2634 m = map (m_fcn.d_c_mapper, *complex_matrix); |
|
|
2635 retval = tree_constant (m); |
|
|
2636 } |
|
529
|
2637 else if (m_fcn.c_c_mapper) |
|
492
|
2638 { |
|
|
2639 ComplexMatrix cm; |
|
|
2640 cm = map (m_fcn.c_c_mapper, *complex_matrix); |
|
|
2641 retval = tree_constant (cm); |
|
|
2642 } |
|
|
2643 else |
|
|
2644 panic_impossible (); |
|
|
2645 break; |
|
|
2646 case string_constant: |
|
|
2647 case range_constant: |
|
|
2648 case magic_colon: |
|
|
2649 default: |
|
|
2650 panic_impossible (); |
|
|
2651 break; |
|
|
2652 } |
|
|
2653 return retval; |
|
|
2654 } |
|
|
2655 |
|
|
2656 /* |
|
|
2657 * Top-level tree-constant function that handles assignments. Only |
|
|
2658 * decide if the left-hand side is currently a scalar or a matrix and |
|
|
2659 * hand off to other functions to do the real work. |
|
|
2660 */ |
|
|
2661 void |
|
529
|
2662 tree_constant_rep::assign (const tree_constant& rhs, const Octave_object& args) |
|
492
|
2663 { |
|
|
2664 tree_constant rhs_tmp = rhs.make_numeric (); |
|
|
2665 |
|
|
2666 // This is easier than actually handling assignments to strings. |
|
|
2667 // An assignment to a range will normally require a conversion to a |
|
|
2668 // vector since it will normally destroy the equally-spaced property |
|
|
2669 // of the range elements. |
|
|
2670 |
|
|
2671 if (type_tag == string_constant || type_tag == range_constant) |
|
|
2672 force_numeric (); |
|
|
2673 |
|
|
2674 switch (type_tag) |
|
|
2675 { |
|
|
2676 case complex_scalar_constant: |
|
|
2677 case scalar_constant: |
|
|
2678 case unknown_constant: |
|
506
|
2679 do_scalar_assignment (rhs_tmp, args); |
|
492
|
2680 break; |
|
|
2681 case complex_matrix_constant: |
|
|
2682 case matrix_constant: |
|
506
|
2683 do_matrix_assignment (rhs_tmp, args); |
|
492
|
2684 break; |
|
|
2685 case string_constant: |
|
|
2686 ::error ("invalid assignment to string type"); |
|
|
2687 break; |
|
|
2688 case range_constant: |
|
|
2689 case magic_colon: |
|
|
2690 default: |
|
|
2691 panic_impossible (); |
|
|
2692 break; |
|
|
2693 } |
|
|
2694 } |
|
|
2695 |
|
|
2696 /* |
|
|
2697 * Assignments to scalars. If resize_on_range_error is true, |
|
|
2698 * this can convert the left-hand side to a matrix. |
|
|
2699 */ |
|
|
2700 void |
|
529
|
2701 tree_constant_rep::do_scalar_assignment (const tree_constant& rhs, |
|
506
|
2702 const Octave_object& args) |
|
492
|
2703 { |
|
|
2704 assert (type_tag == unknown_constant |
|
|
2705 || type_tag == scalar_constant |
|
|
2706 || type_tag == complex_scalar_constant); |
|
|
2707 |
|
506
|
2708 int nargin = args.length (); |
|
|
2709 |
|
492
|
2710 if ((rhs.is_scalar_type () || rhs.is_zero_by_zero ()) |
|
506
|
2711 && valid_scalar_indices (args)) |
|
492
|
2712 { |
|
|
2713 if (rhs.is_zero_by_zero ()) |
|
|
2714 { |
|
|
2715 if (type_tag == complex_scalar_constant) |
|
|
2716 delete complex_scalar; |
|
|
2717 |
|
|
2718 matrix = new Matrix (0, 0); |
|
|
2719 type_tag = matrix_constant; |
|
|
2720 } |
|
|
2721 else if (type_tag == unknown_constant || type_tag == scalar_constant) |
|
|
2722 { |
|
|
2723 if (rhs.const_type () == scalar_constant) |
|
|
2724 { |
|
|
2725 scalar = rhs.double_value (); |
|
|
2726 type_tag = scalar_constant; |
|
|
2727 } |
|
|
2728 else if (rhs.const_type () == complex_scalar_constant) |
|
|
2729 { |
|
|
2730 complex_scalar = new Complex (rhs.complex_value ()); |
|
|
2731 type_tag = complex_scalar_constant; |
|
|
2732 } |
|
|
2733 else |
|
|
2734 { |
|
|
2735 ::error ("invalid assignment to scalar"); |
|
|
2736 return; |
|
|
2737 } |
|
|
2738 } |
|
|
2739 else |
|
|
2740 { |
|
|
2741 if (rhs.const_type () == scalar_constant) |
|
|
2742 { |
|
|
2743 delete complex_scalar; |
|
|
2744 scalar = rhs.double_value (); |
|
|
2745 type_tag = scalar_constant; |
|
|
2746 } |
|
|
2747 else if (rhs.const_type () == complex_scalar_constant) |
|
|
2748 { |
|
|
2749 *complex_scalar = rhs.complex_value (); |
|
|
2750 type_tag = complex_scalar_constant; |
|
|
2751 } |
|
|
2752 else |
|
|
2753 { |
|
|
2754 ::error ("invalid assignment to scalar"); |
|
|
2755 return; |
|
|
2756 } |
|
|
2757 } |
|
|
2758 } |
|
|
2759 else if (user_pref.resize_on_range_error) |
|
|
2760 { |
|
|
2761 tree_constant_rep::constant_type old_type_tag = type_tag; |
|
|
2762 |
|
|
2763 if (type_tag == complex_scalar_constant) |
|
|
2764 { |
|
|
2765 Complex *old_complex = complex_scalar; |
|
|
2766 complex_matrix = new ComplexMatrix (1, 1, *complex_scalar); |
|
|
2767 type_tag = complex_matrix_constant; |
|
|
2768 delete old_complex; |
|
|
2769 } |
|
|
2770 else if (type_tag == scalar_constant) |
|
|
2771 { |
|
|
2772 matrix = new Matrix (1, 1, scalar); |
|
|
2773 type_tag = matrix_constant; |
|
|
2774 } |
|
|
2775 |
|
|
2776 // If there is an error, the call to do_matrix_assignment should not |
|
|
2777 // destroy the current value. tree_constant_rep::eval(int) will take |
|
|
2778 // care of converting single element matrices back to scalars. |
|
|
2779 |
|
506
|
2780 do_matrix_assignment (rhs, args); |
|
492
|
2781 |
|
|
2782 // I don't think there's any other way to revert back to unknown |
|
|
2783 // constant types, so here it is. |
|
|
2784 |
|
|
2785 if (old_type_tag == unknown_constant && error_state) |
|
|
2786 { |
|
|
2787 if (type_tag == matrix_constant) |
|
|
2788 delete matrix; |
|
|
2789 else if (type_tag == complex_matrix_constant) |
|
|
2790 delete complex_matrix; |
|
|
2791 |
|
|
2792 type_tag = unknown_constant; |
|
|
2793 } |
|
|
2794 } |
|
506
|
2795 else if (nargin > 3 || nargin < 2) |
|
492
|
2796 ::error ("invalid index expression for scalar type"); |
|
|
2797 else |
|
|
2798 ::error ("index invalid or out of range for scalar type"); |
|
|
2799 } |
|
|
2800 |
|
|
2801 /* |
|
|
2802 * Assignments to matrices (and vectors). |
|
|
2803 * |
|
|
2804 * For compatibility with Matlab, we allow assignment of an empty |
|
|
2805 * matrix to an expression with empty indices to do nothing. |
|
|
2806 */ |
|
|
2807 void |
|
529
|
2808 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
506
|
2809 const Octave_object& args) |
|
492
|
2810 { |
|
|
2811 assert (type_tag == unknown_constant |
|
|
2812 || type_tag == matrix_constant |
|
|
2813 || type_tag == complex_matrix_constant); |
|
|
2814 |
|
|
2815 if (type_tag == matrix_constant && rhs.is_complex_type ()) |
|
|
2816 { |
|
|
2817 Matrix *old_matrix = matrix; |
|
|
2818 complex_matrix = new ComplexMatrix (*matrix); |
|
|
2819 type_tag = complex_matrix_constant; |
|
|
2820 delete old_matrix; |
|
|
2821 } |
|
|
2822 else if (type_tag == unknown_constant) |
|
|
2823 { |
|
|
2824 if (rhs.is_complex_type ()) |
|
|
2825 { |
|
|
2826 complex_matrix = new ComplexMatrix (); |
|
|
2827 type_tag = complex_matrix_constant; |
|
|
2828 } |
|
|
2829 else |
|
|
2830 { |
|
|
2831 matrix = new Matrix (); |
|
|
2832 type_tag = matrix_constant; |
|
|
2833 } |
|
|
2834 } |
|
|
2835 |
|
506
|
2836 int nargin = args.length (); |
|
|
2837 |
|
492
|
2838 // The do_matrix_assignment functions can't handle empty matrices, so |
|
|
2839 // don't let any pass through here. |
|
506
|
2840 switch (nargin) |
|
492
|
2841 { |
|
|
2842 case 2: |
|
500
|
2843 if (args.length () <= 0) |
|
492
|
2844 ::error ("matrix index is null"); |
|
500
|
2845 else if (args(1).is_undefined ()) |
|
492
|
2846 ::error ("matrix index is undefined"); |
|
|
2847 else |
|
500
|
2848 do_matrix_assignment (rhs, args(1)); |
|
492
|
2849 break; |
|
|
2850 case 3: |
|
500
|
2851 if (args.length () <= 0) |
|
492
|
2852 ::error ("matrix indices are null"); |
|
500
|
2853 else if (args(1).is_undefined ()) |
|
492
|
2854 ::error ("first matrix index is undefined"); |
|
500
|
2855 else if (args(2).is_undefined ()) |
|
492
|
2856 ::error ("second matrix index is undefined"); |
|
500
|
2857 else if (args(1).is_empty () || args(2).is_empty ()) |
|
492
|
2858 { |
|
|
2859 if (! rhs.is_empty ()) |
|
|
2860 { |
|
|
2861 ::error ("in assignment expression, a matrix index is empty"); |
|
|
2862 ::error ("but hte right hand side is not an empty matrix"); |
|
|
2863 } |
|
|
2864 // XXX FIXME XXX -- to really be correct here, we should probably |
|
|
2865 // check to see if the assignment conforms, but that seems like more |
|
|
2866 // work than it's worth right now... |
|
|
2867 } |
|
|
2868 else |
|
500
|
2869 do_matrix_assignment (rhs, args(1), args(2)); |
|
492
|
2870 break; |
|
|
2871 default: |
|
|
2872 ::error ("too many indices for matrix expression"); |
|
|
2873 break; |
|
|
2874 } |
|
|
2875 } |
|
|
2876 |
|
|
2877 /* |
|
|
2878 * Matrix assignments indexed by a single value. |
|
|
2879 */ |
|
|
2880 void |
|
529
|
2881 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
|
2882 const tree_constant& i_arg) |
|
492
|
2883 { |
|
|
2884 int nr = rows (); |
|
|
2885 int nc = columns (); |
|
|
2886 |
|
|
2887 if (user_pref.do_fortran_indexing || nr <= 1 || nc <= 1) |
|
|
2888 { |
|
|
2889 if (i_arg.is_empty ()) |
|
|
2890 { |
|
|
2891 if (! rhs.is_empty ()) |
|
|
2892 { |
|
|
2893 ::error ("in assignment expression, matrix index is empty but"); |
|
|
2894 ::error ("right hand side is not an empty matrix"); |
|
|
2895 } |
|
|
2896 // XXX FIXME XXX -- to really be correct here, we should probably |
|
|
2897 // check to see if the assignment conforms, but that seems like more |
|
|
2898 // work than it's worth right now... |
|
|
2899 |
|
|
2900 // The assignment functions can't handle empty matrices, so don't let |
|
|
2901 // any pass through here. |
|
|
2902 return; |
|
|
2903 } |
|
|
2904 |
|
|
2905 // We can't handle the case of assigning to a vector first, since even |
|
|
2906 // then, the two operations are not equivalent. For example, the |
|
|
2907 // expression V(:) = M is handled differently depending on whether the |
|
|
2908 // user specified do_fortran_indexing = "true". |
|
|
2909 |
|
|
2910 if (user_pref.do_fortran_indexing) |
|
|
2911 fortran_style_matrix_assignment (rhs, i_arg); |
|
|
2912 else if (nr <= 1 || nc <= 1) |
|
|
2913 vector_assignment (rhs, i_arg); |
|
|
2914 else |
|
|
2915 panic_impossible (); |
|
|
2916 } |
|
|
2917 else |
|
|
2918 ::error ("single index only valid for row or column vector"); |
|
|
2919 } |
|
|
2920 |
|
|
2921 /* |
|
|
2922 * Fortran-style assignments. Matrices are assumed to be stored in |
|
|
2923 * column-major order and it is ok to use a single index for |
|
|
2924 * multi-dimensional matrices. |
|
|
2925 */ |
|
|
2926 void |
|
529
|
2927 tree_constant_rep::fortran_style_matrix_assignment (const tree_constant& rhs, |
|
|
2928 const tree_constant& i_arg) |
|
492
|
2929 { |
|
|
2930 tree_constant tmp_i = i_arg.make_numeric_or_magic (); |
|
|
2931 |
|
|
2932 tree_constant_rep::constant_type itype = tmp_i.const_type (); |
|
|
2933 |
|
|
2934 int nr = rows (); |
|
|
2935 int nc = columns (); |
|
|
2936 |
|
|
2937 int rhs_nr = rhs.rows (); |
|
|
2938 int rhs_nc = rhs.columns (); |
|
|
2939 |
|
|
2940 switch (itype) |
|
|
2941 { |
|
|
2942 case complex_scalar_constant: |
|
|
2943 case scalar_constant: |
|
|
2944 { |
|
|
2945 int i = NINT (tmp_i.double_value ()); |
|
|
2946 int idx = i - 1; |
|
|
2947 |
|
|
2948 if (rhs_nr == 0 && rhs_nc == 0) |
|
|
2949 { |
|
|
2950 if (idx < nr * nc) |
|
|
2951 { |
|
|
2952 convert_to_row_or_column_vector (); |
|
|
2953 |
|
|
2954 nr = rows (); |
|
|
2955 nc = columns (); |
|
|
2956 |
|
|
2957 if (nr == 1) |
|
|
2958 delete_column (idx); |
|
|
2959 else if (nc == 1) |
|
|
2960 delete_row (idx); |
|
|
2961 else |
|
|
2962 panic_impossible (); |
|
|
2963 } |
|
|
2964 return; |
|
|
2965 } |
|
|
2966 |
|
|
2967 if (index_check (idx, "") < 0) |
|
|
2968 return; |
|
|
2969 |
|
|
2970 if (nr <= 1 || nc <= 1) |
|
|
2971 { |
|
|
2972 maybe_resize (idx); |
|
|
2973 if (error_state) |
|
|
2974 return; |
|
|
2975 } |
|
|
2976 else if (range_max_check (idx, nr * nc) < 0) |
|
|
2977 return; |
|
|
2978 |
|
|
2979 nr = rows (); |
|
|
2980 nc = columns (); |
|
|
2981 |
|
|
2982 if (! indexed_assign_conforms (1, 1, rhs_nr, rhs_nc)) |
|
|
2983 { |
|
|
2984 ::error ("for A(int) = X: X must be a scalar"); |
|
|
2985 return; |
|
|
2986 } |
|
|
2987 int ii = fortran_row (i, nr) - 1; |
|
|
2988 int jj = fortran_column (i, nr) - 1; |
|
|
2989 do_matrix_assignment (rhs, ii, jj); |
|
|
2990 } |
|
|
2991 break; |
|
|
2992 case complex_matrix_constant: |
|
|
2993 case matrix_constant: |
|
|
2994 { |
|
|
2995 Matrix mi = tmp_i.matrix_value (); |
|
|
2996 int len = nr * nc; |
|
|
2997 idx_vector ii (mi, 1, "", len); // Always do fortran indexing here... |
|
|
2998 if (! ii) |
|
|
2999 return; |
|
|
3000 |
|
|
3001 if (rhs_nr == 0 && rhs_nc == 0) |
|
|
3002 { |
|
|
3003 ii.sort_uniq (); |
|
|
3004 int num_to_delete = 0; |
|
|
3005 for (int i = 0; i < ii.length (); i++) |
|
|
3006 { |
|
|
3007 if (ii.elem (i) < len) |
|
|
3008 num_to_delete++; |
|
|
3009 else |
|
|
3010 break; |
|
|
3011 } |
|
|
3012 |
|
|
3013 if (num_to_delete > 0) |
|
|
3014 { |
|
|
3015 if (num_to_delete != ii.length ()) |
|
|
3016 ii.shorten (num_to_delete); |
|
|
3017 |
|
|
3018 convert_to_row_or_column_vector (); |
|
|
3019 |
|
|
3020 nr = rows (); |
|
|
3021 nc = columns (); |
|
|
3022 |
|
|
3023 if (nr == 1) |
|
|
3024 delete_columns (ii); |
|
|
3025 else if (nc == 1) |
|
|
3026 delete_rows (ii); |
|
|
3027 else |
|
|
3028 panic_impossible (); |
|
|
3029 } |
|
|
3030 return; |
|
|
3031 } |
|
|
3032 |
|
|
3033 if (nr <= 1 || nc <= 1) |
|
|
3034 { |
|
|
3035 maybe_resize (ii.max ()); |
|
|
3036 if (error_state) |
|
|
3037 return; |
|
|
3038 } |
|
|
3039 else if (range_max_check (ii.max (), len) < 0) |
|
|
3040 return; |
|
|
3041 |
|
|
3042 int ilen = ii.capacity (); |
|
|
3043 |
|
|
3044 if (ilen != rhs_nr * rhs_nc) |
|
|
3045 { |
|
|
3046 ::error ("A(matrix) = X: X and matrix must have the same number"); |
|
|
3047 ::error ("of elements"); |
|
|
3048 } |
|
|
3049 else if (ilen == 1 && rhs.is_scalar_type ()) |
|
|
3050 { |
|
|
3051 int nr = rows (); |
|
|
3052 int idx = ii.elem (0); |
|
|
3053 int ii = fortran_row (idx + 1, nr) - 1; |
|
|
3054 int jj = fortran_column (idx + 1, nr) - 1; |
|
|
3055 |
|
|
3056 if (rhs.const_type () == scalar_constant) |
|
|
3057 matrix->elem (ii, jj) = rhs.double_value (); |
|
|
3058 else if (rhs.const_type () == complex_scalar_constant) |
|
|
3059 complex_matrix->elem (ii, jj) = rhs.complex_value (); |
|
|
3060 else |
|
|
3061 panic_impossible (); |
|
|
3062 } |
|
|
3063 else |
|
|
3064 fortran_style_matrix_assignment (rhs, ii); |
|
|
3065 } |
|
|
3066 break; |
|
|
3067 case string_constant: |
|
|
3068 gripe_string_invalid (); |
|
|
3069 break; |
|
|
3070 case range_constant: |
|
|
3071 gripe_range_invalid (); |
|
|
3072 break; |
|
|
3073 case magic_colon: |
|
|
3074 // a(:) = [] is equivalent to a(:,:) = []. |
|
|
3075 if (rhs_nr == 0 && rhs_nc == 0) |
|
|
3076 do_matrix_assignment (rhs, magic_colon, magic_colon); |
|
|
3077 else |
|
|
3078 fortran_style_matrix_assignment (rhs, magic_colon); |
|
|
3079 break; |
|
|
3080 default: |
|
|
3081 panic_impossible (); |
|
|
3082 break; |
|
|
3083 } |
|
|
3084 } |
|
|
3085 |
|
|
3086 /* |
|
|
3087 * Fortran-style assignment for vector index. |
|
|
3088 */ |
|
|
3089 void |
|
529
|
3090 tree_constant_rep::fortran_style_matrix_assignment (const tree_constant& rhs, |
|
492
|
3091 idx_vector& i) |
|
|
3092 { |
|
|
3093 assert (rhs.is_matrix_type ()); |
|
|
3094 |
|
|
3095 int ilen = i.capacity (); |
|
|
3096 |
|
|
3097 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
3098 |
|
|
3099 int len = rhs_nr * rhs_nc; |
|
|
3100 |
|
|
3101 if (len == ilen) |
|
|
3102 { |
|
|
3103 int nr = rows (); |
|
|
3104 if (rhs.const_type () == matrix_constant) |
|
|
3105 { |
|
|
3106 double *cop_out = rhs_m.fortran_vec (); |
|
|
3107 for (int k = 0; k < len; k++) |
|
|
3108 { |
|
|
3109 int ii = fortran_row (i.elem (k) + 1, nr) - 1; |
|
|
3110 int jj = fortran_column (i.elem (k) + 1, nr) - 1; |
|
|
3111 |
|
|
3112 matrix->elem (ii, jj) = *cop_out++; |
|
|
3113 } |
|
|
3114 } |
|
|
3115 else |
|
|
3116 { |
|
|
3117 Complex *cop_out = rhs_cm.fortran_vec (); |
|
|
3118 for (int k = 0; k < len; k++) |
|
|
3119 { |
|
|
3120 int ii = fortran_row (i.elem (k) + 1, nr) - 1; |
|
|
3121 int jj = fortran_column (i.elem (k) + 1, nr) - 1; |
|
|
3122 |
|
|
3123 complex_matrix->elem (ii, jj) = *cop_out++; |
|
|
3124 } |
|
|
3125 } |
|
|
3126 } |
|
|
3127 else |
|
|
3128 ::error ("number of rows and columns must match for indexed assignment"); |
|
|
3129 } |
|
|
3130 |
|
|
3131 /* |
|
|
3132 * Fortran-style assignment for colon index. |
|
|
3133 */ |
|
|
3134 void |
|
|
3135 tree_constant_rep::fortran_style_matrix_assignment |
|
529
|
3136 (const tree_constant& rhs, tree_constant_rep::constant_type mci) |
|
492
|
3137 { |
|
|
3138 assert (rhs.is_matrix_type () && mci == tree_constant_rep::magic_colon); |
|
|
3139 |
|
|
3140 int nr = rows (); |
|
|
3141 int nc = columns (); |
|
|
3142 |
|
|
3143 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
3144 |
|
|
3145 int rhs_size = rhs_nr * rhs_nc; |
|
|
3146 if (rhs_size == 0) |
|
|
3147 { |
|
|
3148 if (rhs.const_type () == matrix_constant) |
|
|
3149 { |
|
|
3150 delete matrix; |
|
|
3151 matrix = new Matrix (0, 0); |
|
|
3152 return; |
|
|
3153 } |
|
|
3154 else |
|
|
3155 panic_impossible (); |
|
|
3156 } |
|
|
3157 else if (nr*nc != rhs_size) |
|
|
3158 { |
|
|
3159 ::error ("A(:) = X: X and A must have the same number of elements"); |
|
|
3160 return; |
|
|
3161 } |
|
|
3162 |
|
|
3163 if (rhs.const_type () == matrix_constant) |
|
|
3164 { |
|
|
3165 double *cop_out = rhs_m.fortran_vec (); |
|
|
3166 for (int j = 0; j < nc; j++) |
|
|
3167 for (int i = 0; i < nr; i++) |
|
|
3168 matrix->elem (i, j) = *cop_out++; |
|
|
3169 } |
|
|
3170 else |
|
|
3171 { |
|
|
3172 Complex *cop_out = rhs_cm.fortran_vec (); |
|
|
3173 for (int j = 0; j < nc; j++) |
|
|
3174 for (int i = 0; i < nr; i++) |
|
|
3175 complex_matrix->elem (i, j) = *cop_out++; |
|
|
3176 } |
|
|
3177 } |
|
|
3178 |
|
|
3179 /* |
|
|
3180 * Assignments to vectors. Hand off to other functions once we know |
|
|
3181 * what kind of index we have. For a colon, it is the same as |
|
|
3182 * assignment to a matrix indexed by two colons. |
|
|
3183 */ |
|
|
3184 void |
|
529
|
3185 tree_constant_rep::vector_assignment (const tree_constant& rhs, |
|
|
3186 const tree_constant& i_arg) |
|
492
|
3187 { |
|
|
3188 int nr = rows (); |
|
|
3189 int nc = columns (); |
|
|
3190 |
|
|
3191 assert ((nr == 1 || nc == 1 || (nr == 0 && nc == 0)) |
|
|
3192 && ! user_pref.do_fortran_indexing); |
|
|
3193 |
|
|
3194 tree_constant tmp_i = i_arg.make_numeric_or_range_or_magic (); |
|
|
3195 |
|
|
3196 tree_constant_rep::constant_type itype = tmp_i.const_type (); |
|
|
3197 |
|
|
3198 switch (itype) |
|
|
3199 { |
|
|
3200 case complex_scalar_constant: |
|
|
3201 case scalar_constant: |
|
|
3202 { |
|
|
3203 int i = tree_to_mat_idx (tmp_i.double_value ()); |
|
|
3204 if (index_check (i, "") < 0) |
|
|
3205 return; |
|
|
3206 do_vector_assign (rhs, i); |
|
|
3207 } |
|
|
3208 break; |
|
|
3209 case complex_matrix_constant: |
|
|
3210 case matrix_constant: |
|
|
3211 { |
|
|
3212 Matrix mi = tmp_i.matrix_value (); |
|
|
3213 int len = nr * nc; |
|
|
3214 idx_vector iv (mi, user_pref.do_fortran_indexing, "", len); |
|
|
3215 if (! iv) |
|
|
3216 return; |
|
|
3217 |
|
|
3218 do_vector_assign (rhs, iv); |
|
|
3219 } |
|
|
3220 break; |
|
|
3221 case string_constant: |
|
|
3222 gripe_string_invalid (); |
|
|
3223 break; |
|
|
3224 case range_constant: |
|
|
3225 { |
|
|
3226 Range ri = tmp_i.range_value (); |
|
|
3227 int len = nr * nc; |
|
|
3228 if (len == 2 && is_zero_one (ri)) |
|
|
3229 { |
|
|
3230 do_vector_assign (rhs, 1); |
|
|
3231 } |
|
|
3232 else if (len == 2 && is_one_zero (ri)) |
|
|
3233 { |
|
|
3234 do_vector_assign (rhs, 0); |
|
|
3235 } |
|
|
3236 else |
|
|
3237 { |
|
|
3238 if (index_check (ri, "") < 0) |
|
|
3239 return; |
|
|
3240 do_vector_assign (rhs, ri); |
|
|
3241 } |
|
|
3242 } |
|
|
3243 break; |
|
|
3244 case magic_colon: |
|
|
3245 { |
|
|
3246 int rhs_nr = rhs.rows (); |
|
|
3247 int rhs_nc = rhs.columns (); |
|
|
3248 |
|
|
3249 if (! indexed_assign_conforms (nr, nc, rhs_nr, rhs_nc)) |
|
|
3250 { |
|
|
3251 ::error ("A(:) = X: X and A must have the same dimensions"); |
|
|
3252 return; |
|
|
3253 } |
|
|
3254 do_matrix_assignment (rhs, magic_colon, magic_colon); |
|
|
3255 } |
|
|
3256 break; |
|
|
3257 default: |
|
|
3258 panic_impossible (); |
|
|
3259 break; |
|
|
3260 } |
|
|
3261 } |
|
|
3262 |
|
|
3263 /* |
|
|
3264 * Check whether an indexed assignment to a vector is valid. |
|
|
3265 */ |
|
|
3266 void |
|
|
3267 tree_constant_rep::check_vector_assign (int rhs_nr, int rhs_nc, |
|
|
3268 int ilen, const char *rm) |
|
|
3269 { |
|
|
3270 int nr = rows (); |
|
|
3271 int nc = columns (); |
|
|
3272 |
|
|
3273 if ((nr == 1 && nc == 1) || nr == 0 || nc == 0) // No orientation. |
|
|
3274 { |
|
|
3275 if (! (ilen == rhs_nr || ilen == rhs_nc)) |
|
|
3276 { |
|
|
3277 ::error ("A(%s) = X: X and %s must have the same number of elements", |
|
|
3278 rm, rm); |
|
|
3279 } |
|
|
3280 } |
|
|
3281 else if (nr == 1) // Preserve current row orientation. |
|
|
3282 { |
|
|
3283 if (! (rhs_nr == 1 && rhs_nc == ilen)) |
|
|
3284 { |
|
|
3285 ::error ("A(%s) = X: where A is a row vector, X must also be a", rm); |
|
|
3286 ::error ("row vector with the same number of elements as %s", rm); |
|
|
3287 } |
|
|
3288 } |
|
|
3289 else if (nc == 1) // Preserve current column orientation. |
|
|
3290 { |
|
|
3291 if (! (rhs_nc == 1 && rhs_nr == ilen)) |
|
|
3292 { |
|
|
3293 ::error ("A(%s) = X: where A is a column vector, X must also be", rm); |
|
|
3294 ::error ("a column vector with the same number of elements as %s", rm); |
|
|
3295 } |
|
|
3296 } |
|
|
3297 else |
|
|
3298 panic_impossible (); |
|
|
3299 } |
|
|
3300 |
|
|
3301 /* |
|
|
3302 * Assignment to a vector with an integer index. |
|
|
3303 */ |
|
|
3304 void |
|
529
|
3305 tree_constant_rep::do_vector_assign (const tree_constant& rhs, int i) |
|
492
|
3306 { |
|
|
3307 int rhs_nr = rhs.rows (); |
|
|
3308 int rhs_nc = rhs.columns (); |
|
|
3309 |
|
|
3310 if (indexed_assign_conforms (1, 1, rhs_nr, rhs_nc)) |
|
|
3311 { |
|
|
3312 maybe_resize (i); |
|
|
3313 if (error_state) |
|
|
3314 return; |
|
|
3315 |
|
|
3316 int nr = rows (); |
|
|
3317 int nc = columns (); |
|
|
3318 |
|
|
3319 if (nr == 1) |
|
|
3320 { |
|
|
3321 REP_ELEM_ASSIGN (0, i, rhs.double_value (), rhs.complex_value (), |
|
|
3322 rhs.is_real_type ()); |
|
|
3323 } |
|
|
3324 else if (nc == 1) |
|
|
3325 { |
|
|
3326 REP_ELEM_ASSIGN (i, 0, rhs.double_value (), rhs.complex_value (), |
|
|
3327 rhs.is_real_type ()); |
|
|
3328 } |
|
|
3329 else |
|
|
3330 panic_impossible (); |
|
|
3331 } |
|
|
3332 else if (rhs_nr == 0 && rhs_nc == 0) |
|
|
3333 { |
|
|
3334 int nr = rows (); |
|
|
3335 int nc = columns (); |
|
|
3336 |
|
|
3337 int len = MAX (nr, nc); |
|
|
3338 |
|
|
3339 if (i < 0 || i >= len) |
|
|
3340 { |
|
|
3341 ::error ("A(int) = []: index out of range"); |
|
|
3342 return; |
|
|
3343 } |
|
|
3344 |
|
|
3345 if (nr == 1) |
|
|
3346 delete_column (i); |
|
|
3347 else if (nc == 1) |
|
|
3348 delete_row (i); |
|
|
3349 else |
|
|
3350 panic_impossible (); |
|
|
3351 } |
|
|
3352 else |
|
|
3353 { |
|
|
3354 ::error ("for A(int) = X: X must be a scalar"); |
|
|
3355 return; |
|
|
3356 } |
|
|
3357 } |
|
|
3358 |
|
|
3359 /* |
|
|
3360 * Assignment to a vector with a vector index. |
|
|
3361 */ |
|
|
3362 void |
|
529
|
3363 tree_constant_rep::do_vector_assign (const tree_constant& rhs, |
|
|
3364 idx_vector& iv) |
|
492
|
3365 { |
|
|
3366 if (rhs.is_zero_by_zero ()) |
|
|
3367 { |
|
|
3368 int nr = rows (); |
|
|
3369 int nc = columns (); |
|
|
3370 |
|
|
3371 int len = MAX (nr, nc); |
|
|
3372 |
|
|
3373 if (iv.max () >= len) |
|
|
3374 { |
|
|
3375 ::error ("A(matrix) = []: index out of range"); |
|
|
3376 return; |
|
|
3377 } |
|
|
3378 |
|
|
3379 if (nr == 1) |
|
|
3380 delete_columns (iv); |
|
|
3381 else if (nc == 1) |
|
|
3382 delete_rows (iv); |
|
|
3383 else |
|
|
3384 panic_impossible (); |
|
|
3385 } |
|
|
3386 else if (rhs.is_scalar_type ()) |
|
|
3387 { |
|
|
3388 int nr = rows (); |
|
|
3389 int nc = columns (); |
|
|
3390 |
|
|
3391 if (iv.capacity () == 1) |
|
|
3392 { |
|
|
3393 int idx = iv.elem (0); |
|
|
3394 |
|
|
3395 if (nr == 1) |
|
|
3396 { |
|
|
3397 REP_ELEM_ASSIGN (0, idx, rhs.double_value (), |
|
|
3398 rhs.complex_value (), rhs.is_real_type ()); |
|
|
3399 } |
|
|
3400 else if (nc == 1) |
|
|
3401 { |
|
|
3402 REP_ELEM_ASSIGN (idx, 0, rhs.double_value (), |
|
|
3403 rhs.complex_value (), rhs.is_real_type ()); |
|
|
3404 } |
|
|
3405 else |
|
|
3406 panic_impossible (); |
|
|
3407 } |
|
|
3408 else |
|
|
3409 { |
|
|
3410 if (nr == 1) |
|
|
3411 { |
|
|
3412 ::error ("A(matrix) = X: where A is a row vector, X must also be a"); |
|
|
3413 ::error ("row vector with the same number of elements as matrix"); |
|
|
3414 } |
|
|
3415 else if (nc == 1) |
|
|
3416 { |
|
|
3417 ::error ("A(matrix) = X: where A is a column vector, X must also be a"); |
|
|
3418 ::error ("column vector with the same number of elements as matrix"); |
|
|
3419 } |
|
|
3420 else |
|
|
3421 panic_impossible (); |
|
|
3422 } |
|
|
3423 } |
|
|
3424 else if (rhs.is_matrix_type ()) |
|
|
3425 { |
|
|
3426 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
3427 |
|
|
3428 int ilen = iv.capacity (); |
|
|
3429 check_vector_assign (rhs_nr, rhs_nc, ilen, "matrix"); |
|
|
3430 if (error_state) |
|
|
3431 return; |
|
|
3432 |
|
|
3433 force_orient f_orient = no_orient; |
|
|
3434 if (rhs_nr == 1 && rhs_nc != 1) |
|
|
3435 f_orient = row_orient; |
|
|
3436 else if (rhs_nc == 1 && rhs_nr != 1) |
|
|
3437 f_orient = column_orient; |
|
|
3438 |
|
|
3439 maybe_resize (iv.max (), f_orient); |
|
|
3440 if (error_state) |
|
|
3441 return; |
|
|
3442 |
|
|
3443 int nr = rows (); |
|
|
3444 int nc = columns (); |
|
|
3445 |
|
|
3446 if (nr == 1) |
|
|
3447 { |
|
|
3448 for (int i = 0; i < iv.capacity (); i++) |
|
|
3449 REP_ELEM_ASSIGN (0, iv.elem (i), rhs_m.elem (0, i), |
|
|
3450 rhs_cm.elem (0, i), rhs.is_real_type ()); |
|
|
3451 } |
|
|
3452 else if (nc == 1) |
|
|
3453 { |
|
|
3454 for (int i = 0; i < iv.capacity (); i++) |
|
|
3455 REP_ELEM_ASSIGN (iv.elem (i), 0, rhs_m.elem (i, 0), |
|
|
3456 rhs_cm.elem (i, 0), rhs.is_real_type ()); |
|
|
3457 } |
|
|
3458 else |
|
|
3459 panic_impossible (); |
|
|
3460 } |
|
|
3461 else |
|
|
3462 panic_impossible (); |
|
|
3463 } |
|
|
3464 |
|
|
3465 /* |
|
|
3466 * Assignment to a vector with a range index. |
|
|
3467 */ |
|
|
3468 void |
|
529
|
3469 tree_constant_rep::do_vector_assign (const tree_constant& rhs, |
|
|
3470 Range& ri) |
|
492
|
3471 { |
|
|
3472 if (rhs.is_zero_by_zero ()) |
|
|
3473 { |
|
|
3474 int nr = rows (); |
|
|
3475 int nc = columns (); |
|
|
3476 |
|
|
3477 int len = MAX (nr, nc); |
|
|
3478 |
|
|
3479 int b = tree_to_mat_idx (ri.min ()); |
|
|
3480 int l = tree_to_mat_idx (ri.max ()); |
|
|
3481 if (b < 0 || l >= len) |
|
|
3482 { |
|
|
3483 ::error ("A(range) = []: index out of range"); |
|
|
3484 return; |
|
|
3485 } |
|
|
3486 |
|
|
3487 if (nr == 1) |
|
|
3488 delete_columns (ri); |
|
|
3489 else if (nc == 1) |
|
|
3490 delete_rows (ri); |
|
|
3491 else |
|
|
3492 panic_impossible (); |
|
|
3493 } |
|
|
3494 else if (rhs.is_scalar_type ()) |
|
|
3495 { |
|
|
3496 int nr = rows (); |
|
|
3497 int nc = columns (); |
|
|
3498 |
|
|
3499 if (nr == 1) |
|
|
3500 { |
|
|
3501 ::error ("A(range) = X: where A is a row vector, X must also be a"); |
|
|
3502 ::error ("row vector with the same number of elements as range"); |
|
|
3503 } |
|
|
3504 else if (nc == 1) |
|
|
3505 { |
|
|
3506 ::error ("A(range) = X: where A is a column vector, X must also be a"); |
|
|
3507 ::error ("column vector with the same number of elements as range"); |
|
|
3508 } |
|
|
3509 else |
|
|
3510 panic_impossible (); |
|
|
3511 } |
|
|
3512 else if (rhs.is_matrix_type ()) |
|
|
3513 { |
|
|
3514 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
3515 |
|
|
3516 int ilen = ri.nelem (); |
|
|
3517 check_vector_assign (rhs_nr, rhs_nc, ilen, "range"); |
|
|
3518 if (error_state) |
|
|
3519 return; |
|
|
3520 |
|
|
3521 force_orient f_orient = no_orient; |
|
|
3522 if (rhs_nr == 1 && rhs_nc != 1) |
|
|
3523 f_orient = row_orient; |
|
|
3524 else if (rhs_nc == 1 && rhs_nr != 1) |
|
|
3525 f_orient = column_orient; |
|
|
3526 |
|
|
3527 maybe_resize (tree_to_mat_idx (ri.max ()), f_orient); |
|
|
3528 if (error_state) |
|
|
3529 return; |
|
|
3530 |
|
|
3531 int nr = rows (); |
|
|
3532 int nc = columns (); |
|
|
3533 |
|
|
3534 double b = ri.base (); |
|
|
3535 double increment = ri.inc (); |
|
|
3536 |
|
|
3537 if (nr == 1) |
|
|
3538 { |
|
|
3539 for (int i = 0; i < ri.nelem (); i++) |
|
|
3540 { |
|
|
3541 double tmp = b + i * increment; |
|
|
3542 int col = tree_to_mat_idx (tmp); |
|
|
3543 REP_ELEM_ASSIGN (0, col, rhs_m.elem (0, i), rhs_cm.elem (0, i), |
|
|
3544 rhs.is_real_type ()); |
|
|
3545 } |
|
|
3546 } |
|
|
3547 else if (nc == 1) |
|
|
3548 { |
|
|
3549 for (int i = 0; i < ri.nelem (); i++) |
|
|
3550 { |
|
|
3551 double tmp = b + i * increment; |
|
|
3552 int row = tree_to_mat_idx (tmp); |
|
|
3553 REP_ELEM_ASSIGN (row, 0, rhs_m.elem (i, 0), rhs_cm.elem (i, 0), |
|
|
3554 rhs.is_real_type ()); |
|
|
3555 } |
|
|
3556 } |
|
|
3557 else |
|
|
3558 panic_impossible (); |
|
|
3559 } |
|
|
3560 else |
|
|
3561 panic_impossible (); |
|
|
3562 } |
|
|
3563 |
|
|
3564 /* |
|
|
3565 * Matrix assignment indexed by two values. This function determines |
|
|
3566 * the type of the first arugment, checks as much as possible, and |
|
|
3567 * then calls one of a set of functions to handle the specific cases: |
|
|
3568 * |
|
|
3569 * M (integer, arg2) = RHS (MA1) |
|
|
3570 * M (vector, arg2) = RHS (MA2) |
|
|
3571 * M (range, arg2) = RHS (MA3) |
|
|
3572 * M (colon, arg2) = RHS (MA4) |
|
|
3573 * |
|
|
3574 * Each of those functions determines the type of the second argument |
|
|
3575 * and calls another function to handle the real work of doing the |
|
|
3576 * assignment. |
|
|
3577 */ |
|
|
3578 void |
|
529
|
3579 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
|
3580 const tree_constant& i_arg, |
|
|
3581 const tree_constant& j_arg) |
|
492
|
3582 { |
|
|
3583 tree_constant tmp_i = i_arg.make_numeric_or_range_or_magic (); |
|
|
3584 |
|
|
3585 tree_constant_rep::constant_type itype = tmp_i.const_type (); |
|
|
3586 |
|
|
3587 switch (itype) |
|
|
3588 { |
|
|
3589 case complex_scalar_constant: |
|
|
3590 case scalar_constant: |
|
|
3591 { |
|
|
3592 int i = tree_to_mat_idx (tmp_i.double_value ()); |
|
|
3593 if (index_check (i, "row") < 0) |
|
|
3594 return; |
|
|
3595 do_matrix_assignment (rhs, i, j_arg); |
|
|
3596 } |
|
|
3597 break; |
|
|
3598 case complex_matrix_constant: |
|
|
3599 case matrix_constant: |
|
|
3600 { |
|
|
3601 Matrix mi = tmp_i.matrix_value (); |
|
|
3602 idx_vector iv (mi, user_pref.do_fortran_indexing, "row", rows ()); |
|
|
3603 if (! iv) |
|
|
3604 return; |
|
|
3605 |
|
|
3606 do_matrix_assignment (rhs, iv, j_arg); |
|
|
3607 } |
|
|
3608 break; |
|
|
3609 case string_constant: |
|
|
3610 gripe_string_invalid (); |
|
|
3611 break; |
|
|
3612 case range_constant: |
|
|
3613 { |
|
|
3614 Range ri = tmp_i.range_value (); |
|
|
3615 int nr = rows (); |
|
|
3616 if (nr == 2 && is_zero_one (ri)) |
|
|
3617 { |
|
|
3618 do_matrix_assignment (rhs, 1, j_arg); |
|
|
3619 } |
|
|
3620 else if (nr == 2 && is_one_zero (ri)) |
|
|
3621 { |
|
|
3622 do_matrix_assignment (rhs, 0, j_arg); |
|
|
3623 } |
|
|
3624 else |
|
|
3625 { |
|
|
3626 if (index_check (ri, "row") < 0) |
|
|
3627 return; |
|
|
3628 do_matrix_assignment (rhs, ri, j_arg); |
|
|
3629 } |
|
|
3630 } |
|
|
3631 break; |
|
|
3632 case magic_colon: |
|
|
3633 do_matrix_assignment (rhs, magic_colon, j_arg); |
|
|
3634 break; |
|
|
3635 default: |
|
|
3636 panic_impossible (); |
|
|
3637 break; |
|
|
3638 } |
|
|
3639 } |
|
|
3640 |
|
|
3641 /* MA1 */ |
|
|
3642 void |
|
529
|
3643 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, int i, |
|
|
3644 const tree_constant& j_arg) |
|
492
|
3645 { |
|
|
3646 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
3647 |
|
|
3648 tree_constant_rep::constant_type jtype = tmp_j.const_type (); |
|
|
3649 |
|
|
3650 int rhs_nr = rhs.rows (); |
|
|
3651 int rhs_nc = rhs.columns (); |
|
|
3652 |
|
|
3653 switch (jtype) |
|
|
3654 { |
|
|
3655 case complex_scalar_constant: |
|
|
3656 case scalar_constant: |
|
|
3657 { |
|
|
3658 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
3659 if (index_check (j, "column") < 0) |
|
|
3660 return; |
|
|
3661 if (! indexed_assign_conforms (1, 1, rhs_nr, rhs_nc)) |
|
|
3662 { |
|
|
3663 ::error ("A(int,int) = X, X must be a scalar"); |
|
|
3664 return; |
|
|
3665 } |
|
|
3666 maybe_resize (i, j); |
|
|
3667 if (error_state) |
|
|
3668 return; |
|
|
3669 |
|
|
3670 do_matrix_assignment (rhs, i, j); |
|
|
3671 } |
|
|
3672 break; |
|
|
3673 case complex_matrix_constant: |
|
|
3674 case matrix_constant: |
|
|
3675 { |
|
|
3676 Matrix mj = tmp_j.matrix_value (); |
|
|
3677 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", |
|
|
3678 columns ()); |
|
|
3679 if (! jv) |
|
|
3680 return; |
|
|
3681 |
|
|
3682 if (! indexed_assign_conforms (1, jv.capacity (), rhs_nr, rhs_nc)) |
|
|
3683 { |
|
|
3684 ::error ("A(int,matrix) = X: X must be a row vector with the same"); |
|
|
3685 ::error ("number of elements as matrix"); |
|
|
3686 return; |
|
|
3687 } |
|
|
3688 maybe_resize (i, jv.max ()); |
|
|
3689 if (error_state) |
|
|
3690 return; |
|
|
3691 |
|
|
3692 do_matrix_assignment (rhs, i, jv); |
|
|
3693 } |
|
|
3694 break; |
|
|
3695 case string_constant: |
|
|
3696 gripe_string_invalid (); |
|
|
3697 break; |
|
|
3698 case range_constant: |
|
|
3699 { |
|
|
3700 Range rj = tmp_j.range_value (); |
|
|
3701 if (! indexed_assign_conforms (1, rj.nelem (), rhs_nr, rhs_nc)) |
|
|
3702 { |
|
|
3703 ::error ("A(int,range) = X: X must be a row vector with the same"); |
|
|
3704 ::error ("number of elements as range"); |
|
|
3705 return; |
|
|
3706 } |
|
|
3707 |
|
|
3708 int nc = columns (); |
|
|
3709 if (nc == 2 && is_zero_one (rj) && rhs_nc == 1) |
|
|
3710 { |
|
|
3711 do_matrix_assignment (rhs, i, 1); |
|
|
3712 } |
|
|
3713 else if (nc == 2 && is_one_zero (rj) && rhs_nc == 1) |
|
|
3714 { |
|
|
3715 do_matrix_assignment (rhs, i, 0); |
|
|
3716 } |
|
|
3717 else |
|
|
3718 { |
|
|
3719 if (index_check (rj, "column") < 0) |
|
|
3720 return; |
|
|
3721 maybe_resize (i, tree_to_mat_idx (rj.max ())); |
|
|
3722 if (error_state) |
|
|
3723 return; |
|
|
3724 |
|
|
3725 do_matrix_assignment (rhs, i, rj); |
|
|
3726 } |
|
|
3727 } |
|
|
3728 break; |
|
|
3729 case magic_colon: |
|
|
3730 { |
|
|
3731 int nc = columns (); |
|
|
3732 int nr = rows (); |
|
|
3733 if (nc == 0 && nr == 0 && rhs_nr == 1) |
|
|
3734 { |
|
|
3735 if (rhs.is_complex_type ()) |
|
|
3736 { |
|
|
3737 complex_matrix = new ComplexMatrix (); |
|
|
3738 type_tag = complex_matrix_constant; |
|
|
3739 } |
|
|
3740 else |
|
|
3741 { |
|
|
3742 matrix = new Matrix (); |
|
|
3743 type_tag = matrix_constant; |
|
|
3744 } |
|
|
3745 maybe_resize (i, rhs_nc-1); |
|
|
3746 if (error_state) |
|
|
3747 return; |
|
|
3748 } |
|
|
3749 else if (indexed_assign_conforms (1, nc, rhs_nr, rhs_nc)) |
|
|
3750 { |
|
|
3751 maybe_resize (i, nc-1); |
|
|
3752 if (error_state) |
|
|
3753 return; |
|
|
3754 } |
|
|
3755 else if (rhs_nr == 0 && rhs_nc == 0) |
|
|
3756 { |
|
|
3757 if (i < 0 || i >= nr) |
|
|
3758 { |
|
|
3759 ::error ("A(int,:) = []: row index out of range"); |
|
|
3760 return; |
|
|
3761 } |
|
|
3762 } |
|
|
3763 else |
|
|
3764 { |
|
|
3765 ::error ("A(int,:) = X: X must be a row vector with the same"); |
|
|
3766 ::error ("number of columns as A"); |
|
|
3767 return; |
|
|
3768 } |
|
|
3769 |
|
|
3770 do_matrix_assignment (rhs, i, magic_colon); |
|
|
3771 } |
|
|
3772 break; |
|
|
3773 default: |
|
|
3774 panic_impossible (); |
|
|
3775 break; |
|
|
3776 } |
|
|
3777 } |
|
|
3778 |
|
|
3779 /* MA2 */ |
|
|
3780 void |
|
529
|
3781 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
|
3782 idx_vector& iv, |
|
|
3783 const tree_constant& j_arg) |
|
492
|
3784 { |
|
|
3785 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
3786 |
|
|
3787 tree_constant_rep::constant_type jtype = tmp_j.const_type (); |
|
|
3788 |
|
|
3789 int rhs_nr = rhs.rows (); |
|
|
3790 int rhs_nc = rhs.columns (); |
|
|
3791 |
|
|
3792 switch (jtype) |
|
|
3793 { |
|
|
3794 case complex_scalar_constant: |
|
|
3795 case scalar_constant: |
|
|
3796 { |
|
|
3797 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
3798 if (index_check (j, "column") < 0) |
|
|
3799 return; |
|
|
3800 if (! indexed_assign_conforms (iv.capacity (), 1, rhs_nr, rhs_nc)) |
|
|
3801 { |
|
|
3802 ::error ("A(matrix,int) = X: X must be a column vector with the"); |
|
|
3803 ::error ("same number of elements as matrix"); |
|
|
3804 return; |
|
|
3805 } |
|
|
3806 maybe_resize (iv.max (), j); |
|
|
3807 if (error_state) |
|
|
3808 return; |
|
|
3809 |
|
|
3810 do_matrix_assignment (rhs, iv, j); |
|
|
3811 } |
|
|
3812 break; |
|
|
3813 case complex_matrix_constant: |
|
|
3814 case matrix_constant: |
|
|
3815 { |
|
|
3816 Matrix mj = tmp_j.matrix_value (); |
|
|
3817 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", |
|
|
3818 columns ()); |
|
|
3819 if (! jv) |
|
|
3820 return; |
|
|
3821 |
|
|
3822 if (! indexed_assign_conforms (iv.capacity (), jv.capacity (), |
|
|
3823 rhs_nr, rhs_nc)) |
|
|
3824 { |
|
|
3825 ::error ("A(r_mat,c_mat) = X: the number of rows in X must match"); |
|
|
3826 ::error ("the number of elements in r_mat and the number of"); |
|
|
3827 ::error ("columns in X must match the number of elements in c_mat"); |
|
|
3828 return; |
|
|
3829 } |
|
|
3830 maybe_resize (iv.max (), jv.max ()); |
|
|
3831 if (error_state) |
|
|
3832 return; |
|
|
3833 |
|
|
3834 do_matrix_assignment (rhs, iv, jv); |
|
|
3835 } |
|
|
3836 break; |
|
|
3837 case string_constant: |
|
|
3838 gripe_string_invalid (); |
|
|
3839 break; |
|
|
3840 case range_constant: |
|
|
3841 { |
|
|
3842 Range rj = tmp_j.range_value (); |
|
|
3843 if (! indexed_assign_conforms (iv.capacity (), rj.nelem (), |
|
|
3844 rhs_nr, rhs_nc)) |
|
|
3845 { |
|
|
3846 ::error ("A(matrix,range) = X: the number of rows in X must match"); |
|
|
3847 ::error ("the number of elements in matrix and the number of"); |
|
|
3848 ::error ("columns in X must match the number of elements in range"); |
|
|
3849 return; |
|
|
3850 } |
|
|
3851 |
|
|
3852 int nc = columns (); |
|
|
3853 if (nc == 2 && is_zero_one (rj) && rhs_nc == 1) |
|
|
3854 { |
|
|
3855 do_matrix_assignment (rhs, iv, 1); |
|
|
3856 } |
|
|
3857 else if (nc == 2 && is_one_zero (rj) && rhs_nc == 1) |
|
|
3858 { |
|
|
3859 do_matrix_assignment (rhs, iv, 0); |
|
|
3860 } |
|
|
3861 else |
|
|
3862 { |
|
|
3863 if (index_check (rj, "column") < 0) |
|
|
3864 return; |
|
|
3865 maybe_resize (iv.max (), tree_to_mat_idx (rj.max ())); |
|
|
3866 if (error_state) |
|
|
3867 return; |
|
|
3868 |
|
|
3869 do_matrix_assignment (rhs, iv, rj); |
|
|
3870 } |
|
|
3871 } |
|
|
3872 break; |
|
|
3873 case magic_colon: |
|
|
3874 { |
|
|
3875 int nc = columns (); |
|
|
3876 int new_nc = nc; |
|
|
3877 if (nc == 0) |
|
|
3878 new_nc = rhs_nc; |
|
|
3879 |
|
|
3880 if (indexed_assign_conforms (iv.capacity (), new_nc, |
|
|
3881 rhs_nr, rhs_nc)) |
|
|
3882 { |
|
|
3883 maybe_resize (iv.max (), new_nc-1); |
|
|
3884 if (error_state) |
|
|
3885 return; |
|
|
3886 } |
|
|
3887 else if (rhs_nr == 0 && rhs_nc == 0) |
|
|
3888 { |
|
|
3889 if (iv.max () >= rows ()) |
|
|
3890 { |
|
|
3891 ::error ("A(matrix,:) = []: row index out of range"); |
|
|
3892 return; |
|
|
3893 } |
|
|
3894 } |
|
|
3895 else |
|
|
3896 { |
|
|
3897 ::error ("A(matrix,:) = X: the number of rows in X must match the"); |
|
|
3898 ::error ("number of elements in matrix, and the number of columns"); |
|
|
3899 ::error ("in X must match the number of columns in A"); |
|
|
3900 return; |
|
|
3901 } |
|
|
3902 |
|
|
3903 do_matrix_assignment (rhs, iv, magic_colon); |
|
|
3904 } |
|
|
3905 break; |
|
|
3906 default: |
|
|
3907 panic_impossible (); |
|
|
3908 break; |
|
|
3909 } |
|
|
3910 } |
|
|
3911 |
|
|
3912 /* MA3 */ |
|
|
3913 void |
|
529
|
3914 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
|
3915 Range& ri, |
|
|
3916 const tree_constant& j_arg) |
|
492
|
3917 { |
|
|
3918 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
3919 |
|
|
3920 tree_constant_rep::constant_type jtype = tmp_j.const_type (); |
|
|
3921 |
|
|
3922 int rhs_nr = rhs.rows (); |
|
|
3923 int rhs_nc = rhs.columns (); |
|
|
3924 |
|
|
3925 switch (jtype) |
|
|
3926 { |
|
|
3927 case complex_scalar_constant: |
|
|
3928 case scalar_constant: |
|
|
3929 { |
|
|
3930 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
3931 if (index_check (j, "column") < 0) |
|
|
3932 return; |
|
|
3933 if (! indexed_assign_conforms (ri.nelem (), 1, rhs_nr, rhs_nc)) |
|
|
3934 { |
|
|
3935 ::error ("A(range,int) = X: X must be a column vector with the"); |
|
|
3936 ::error ("same number of elements as range"); |
|
|
3937 return; |
|
|
3938 } |
|
|
3939 maybe_resize (tree_to_mat_idx (ri.max ()), j); |
|
|
3940 if (error_state) |
|
|
3941 return; |
|
|
3942 |
|
|
3943 do_matrix_assignment (rhs, ri, j); |
|
|
3944 } |
|
|
3945 break; |
|
|
3946 case complex_matrix_constant: |
|
|
3947 case matrix_constant: |
|
|
3948 { |
|
|
3949 Matrix mj = tmp_j.matrix_value (); |
|
|
3950 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", |
|
|
3951 columns ()); |
|
|
3952 if (! jv) |
|
|
3953 return; |
|
|
3954 |
|
|
3955 if (! indexed_assign_conforms (ri.nelem (), jv.capacity (), |
|
|
3956 rhs_nr, rhs_nc)) |
|
|
3957 { |
|
|
3958 ::error ("A(range,matrix) = X: the number of rows in X must match"); |
|
|
3959 ::error ("the number of elements in range and the number of"); |
|
|
3960 ::error ("columns in X must match the number of elements in matrix"); |
|
|
3961 return; |
|
|
3962 } |
|
|
3963 maybe_resize (tree_to_mat_idx (ri.max ()), jv.max ()); |
|
|
3964 if (error_state) |
|
|
3965 return; |
|
|
3966 |
|
|
3967 do_matrix_assignment (rhs, ri, jv); |
|
|
3968 } |
|
|
3969 break; |
|
|
3970 case string_constant: |
|
|
3971 gripe_string_invalid (); |
|
|
3972 break; |
|
|
3973 case range_constant: |
|
|
3974 { |
|
|
3975 Range rj = tmp_j.range_value (); |
|
|
3976 if (! indexed_assign_conforms (ri.nelem (), rj.nelem (), |
|
|
3977 rhs_nr, rhs_nc)) |
|
|
3978 { |
|
|
3979 ::error ("A(r_range,c_range) = X: the number of rows in X must"); |
|
|
3980 ::error ("match the number of elements in r_range and the number"); |
|
|
3981 ::error ("of columns in X must match the number of elements in"); |
|
|
3982 ::error ("c_range"); |
|
|
3983 return; |
|
|
3984 } |
|
|
3985 |
|
|
3986 int nc = columns (); |
|
|
3987 if (nc == 2 && is_zero_one (rj) && rhs_nc == 1) |
|
|
3988 { |
|
|
3989 do_matrix_assignment (rhs, ri, 1); |
|
|
3990 } |
|
|
3991 else if (nc == 2 && is_one_zero (rj) && rhs_nc == 1) |
|
|
3992 { |
|
|
3993 do_matrix_assignment (rhs, ri, 0); |
|
|
3994 } |
|
|
3995 else |
|
|
3996 { |
|
|
3997 if (index_check (rj, "column") < 0) |
|
|
3998 return; |
|
|
3999 |
|
|
4000 maybe_resize (tree_to_mat_idx (ri.max ()), |
|
|
4001 tree_to_mat_idx (rj.max ())); |
|
|
4002 |
|
|
4003 if (error_state) |
|
|
4004 return; |
|
|
4005 |
|
|
4006 do_matrix_assignment (rhs, ri, rj); |
|
|
4007 } |
|
|
4008 } |
|
|
4009 break; |
|
|
4010 case magic_colon: |
|
|
4011 { |
|
|
4012 int nc = columns (); |
|
|
4013 int new_nc = nc; |
|
|
4014 if (nc == 0) |
|
|
4015 new_nc = rhs_nc; |
|
|
4016 |
|
|
4017 if (indexed_assign_conforms (ri.nelem (), new_nc, rhs_nr, rhs_nc)) |
|
|
4018 { |
|
|
4019 maybe_resize (tree_to_mat_idx (ri.max ()), new_nc-1); |
|
|
4020 if (error_state) |
|
|
4021 return; |
|
|
4022 } |
|
|
4023 else if (rhs_nr == 0 && rhs_nc == 0) |
|
|
4024 { |
|
|
4025 int b = tree_to_mat_idx (ri.min ()); |
|
|
4026 int l = tree_to_mat_idx (ri.max ()); |
|
|
4027 if (b < 0 || l >= rows ()) |
|
|
4028 { |
|
|
4029 ::error ("A(range,:) = []: row index out of range"); |
|
|
4030 return; |
|
|
4031 } |
|
|
4032 } |
|
|
4033 else |
|
|
4034 { |
|
|
4035 ::error ("A(range,:) = X: the number of rows in X must match the"); |
|
|
4036 ::error ("number of elements in range, and the number of columns"); |
|
|
4037 ::error ("in X must match the number of columns in A"); |
|
|
4038 return; |
|
|
4039 } |
|
|
4040 |
|
|
4041 do_matrix_assignment (rhs, ri, magic_colon); |
|
|
4042 } |
|
|
4043 break; |
|
|
4044 default: |
|
|
4045 panic_impossible (); |
|
|
4046 break; |
|
|
4047 } |
|
|
4048 } |
|
|
4049 |
|
|
4050 /* MA4 */ |
|
|
4051 void |
|
529
|
4052 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
492
|
4053 tree_constant_rep::constant_type i, |
|
529
|
4054 const tree_constant& j_arg) |
|
492
|
4055 { |
|
|
4056 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
4057 |
|
|
4058 tree_constant_rep::constant_type jtype = tmp_j.const_type (); |
|
|
4059 |
|
|
4060 int rhs_nr = rhs.rows (); |
|
|
4061 int rhs_nc = rhs.columns (); |
|
|
4062 |
|
|
4063 switch (jtype) |
|
|
4064 { |
|
|
4065 case complex_scalar_constant: |
|
|
4066 case scalar_constant: |
|
|
4067 { |
|
|
4068 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
4069 if (index_check (j, "column") < 0) |
|
|
4070 return; |
|
|
4071 int nr = rows (); |
|
|
4072 int nc = columns (); |
|
|
4073 if (nr == 0 && nc == 0 && rhs_nc == 1) |
|
|
4074 { |
|
|
4075 if (rhs.is_complex_type ()) |
|
|
4076 { |
|
|
4077 complex_matrix = new ComplexMatrix (); |
|
|
4078 type_tag = complex_matrix_constant; |
|
|
4079 } |
|
|
4080 else |
|
|
4081 { |
|
|
4082 matrix = new Matrix (); |
|
|
4083 type_tag = matrix_constant; |
|
|
4084 } |
|
|
4085 maybe_resize (rhs_nr-1, j); |
|
|
4086 if (error_state) |
|
|
4087 return; |
|
|
4088 } |
|
|
4089 else if (indexed_assign_conforms (nr, 1, rhs_nr, rhs_nc)) |
|
|
4090 { |
|
|
4091 maybe_resize (nr-1, j); |
|
|
4092 if (error_state) |
|
|
4093 return; |
|
|
4094 } |
|
|
4095 else if (rhs_nr == 0 && rhs_nc == 0) |
|
|
4096 { |
|
|
4097 if (j < 0 || j >= nc) |
|
|
4098 { |
|
|
4099 ::error ("A(:,int) = []: column index out of range"); |
|
|
4100 return; |
|
|
4101 } |
|
|
4102 } |
|
|
4103 else |
|
|
4104 { |
|
|
4105 ::error ("A(:,int) = X: X must be a column vector with the same"); |
|
|
4106 ::error ("number of rows as A"); |
|
|
4107 return; |
|
|
4108 } |
|
|
4109 |
|
|
4110 do_matrix_assignment (rhs, magic_colon, j); |
|
|
4111 } |
|
|
4112 break; |
|
|
4113 case complex_matrix_constant: |
|
|
4114 case matrix_constant: |
|
|
4115 { |
|
|
4116 Matrix mj = tmp_j.matrix_value (); |
|
|
4117 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", |
|
|
4118 columns ()); |
|
|
4119 if (! jv) |
|
|
4120 return; |
|
|
4121 |
|
|
4122 int nr = rows (); |
|
|
4123 int new_nr = nr; |
|
|
4124 if (nr == 0) |
|
|
4125 new_nr = rhs_nr; |
|
|
4126 |
|
|
4127 if (indexed_assign_conforms (new_nr, jv.capacity (), |
|
|
4128 rhs_nr, rhs_nc)) |
|
|
4129 { |
|
|
4130 maybe_resize (new_nr-1, jv.max ()); |
|
|
4131 if (error_state) |
|
|
4132 return; |
|
|
4133 } |
|
|
4134 else if (rhs_nr == 0 && rhs_nc == 0) |
|
|
4135 { |
|
|
4136 if (jv.max () >= columns ()) |
|
|
4137 { |
|
|
4138 ::error ("A(:,matrix) = []: column index out of range"); |
|
|
4139 return; |
|
|
4140 } |
|
|
4141 } |
|
|
4142 else |
|
|
4143 { |
|
|
4144 ::error ("A(:,matrix) = X: the number of rows in X must match the"); |
|
|
4145 ::error ("number of rows in A, and the number of columns in X must"); |
|
|
4146 ::error ("match the number of elements in matrix"); |
|
|
4147 return; |
|
|
4148 } |
|
|
4149 |
|
|
4150 do_matrix_assignment (rhs, magic_colon, jv); |
|
|
4151 } |
|
|
4152 break; |
|
|
4153 case string_constant: |
|
|
4154 gripe_string_invalid (); |
|
|
4155 break; |
|
|
4156 case range_constant: |
|
|
4157 { |
|
|
4158 Range rj = tmp_j.range_value (); |
|
|
4159 int nr = rows (); |
|
|
4160 int new_nr = nr; |
|
|
4161 if (nr == 0) |
|
|
4162 new_nr = rhs_nr; |
|
|
4163 |
|
|
4164 if (indexed_assign_conforms (new_nr, rj.nelem (), rhs_nr, rhs_nc)) |
|
|
4165 { |
|
|
4166 int nc = columns (); |
|
|
4167 if (nc == 2 && is_zero_one (rj) && rhs_nc == 1) |
|
|
4168 { |
|
|
4169 do_matrix_assignment (rhs, magic_colon, 1); |
|
|
4170 } |
|
|
4171 else if (nc == 2 && is_one_zero (rj) && rhs_nc == 1) |
|
|
4172 { |
|
|
4173 do_matrix_assignment (rhs, magic_colon, 0); |
|
|
4174 } |
|
|
4175 else |
|
|
4176 { |
|
|
4177 if (index_check (rj, "column") < 0) |
|
|
4178 return; |
|
|
4179 maybe_resize (new_nr-1, tree_to_mat_idx (rj.max ())); |
|
|
4180 if (error_state) |
|
|
4181 return; |
|
|
4182 } |
|
|
4183 } |
|
|
4184 else if (rhs_nr == 0 && rhs_nc == 0) |
|
|
4185 { |
|
|
4186 int b = tree_to_mat_idx (rj.min ()); |
|
|
4187 int l = tree_to_mat_idx (rj.max ()); |
|
|
4188 if (b < 0 || l >= columns ()) |
|
|
4189 { |
|
|
4190 ::error ("A(:,range) = []: column index out of range"); |
|
|
4191 return; |
|
|
4192 } |
|
|
4193 } |
|
|
4194 else |
|
|
4195 { |
|
|
4196 ::error ("A(:,range) = X: the number of rows in X must match the"); |
|
|
4197 ::error ("number of rows in A, and the number of columns in X"); |
|
|
4198 ::error ("must match the number of elements in range"); |
|
|
4199 return; |
|
|
4200 } |
|
|
4201 |
|
|
4202 do_matrix_assignment (rhs, magic_colon, rj); |
|
|
4203 } |
|
|
4204 break; |
|
|
4205 case magic_colon: |
|
|
4206 // a(:,:) = foo is equivalent to a = foo. |
|
|
4207 do_matrix_assignment (rhs, magic_colon, magic_colon); |
|
|
4208 break; |
|
|
4209 default: |
|
|
4210 panic_impossible (); |
|
|
4211 break; |
|
|
4212 } |
|
|
4213 } |
|
|
4214 |
|
|
4215 /* |
|
|
4216 * Functions that actually handle assignment to a matrix using two |
|
|
4217 * index values. |
|
|
4218 * |
|
|
4219 * idx2 |
|
|
4220 * +---+---+----+----+ |
|
|
4221 * idx1 | i | v | r | c | |
|
|
4222 * ---------+---+---+----+----+ |
|
|
4223 * integer | 1 | 5 | 9 | 13 | |
|
|
4224 * ---------+---+---+----+----+ |
|
|
4225 * vector | 2 | 6 | 10 | 14 | |
|
|
4226 * ---------+---+---+----+----+ |
|
|
4227 * range | 3 | 7 | 11 | 15 | |
|
|
4228 * ---------+---+---+----+----+ |
|
|
4229 * colon | 4 | 8 | 12 | 16 | |
|
|
4230 * ---------+---+---+----+----+ |
|
|
4231 */ |
|
|
4232 |
|
|
4233 /* 1 */ |
|
|
4234 void |
|
529
|
4235 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
|
4236 int i, int j) |
|
492
|
4237 { |
|
|
4238 REP_ELEM_ASSIGN (i, j, rhs.double_value (), rhs.complex_value (), |
|
|
4239 rhs.is_real_type ()); |
|
|
4240 } |
|
|
4241 |
|
|
4242 /* 2 */ |
|
|
4243 void |
|
529
|
4244 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, int i, |
|
492
|
4245 idx_vector& jv) |
|
|
4246 { |
|
|
4247 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4248 |
|
|
4249 for (int j = 0; j < jv.capacity (); j++) |
|
|
4250 REP_ELEM_ASSIGN (i, jv.elem (j), rhs_m.elem (0, j), |
|
|
4251 rhs_cm.elem (0, j), rhs.is_real_type ()); |
|
|
4252 } |
|
|
4253 |
|
|
4254 /* 3 */ |
|
|
4255 void |
|
529
|
4256 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
|
4257 int i, Range& rj) |
|
492
|
4258 { |
|
|
4259 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4260 |
|
|
4261 double b = rj.base (); |
|
|
4262 double increment = rj.inc (); |
|
|
4263 |
|
|
4264 for (int j = 0; j < rj.nelem (); j++) |
|
|
4265 { |
|
|
4266 double tmp = b + j * increment; |
|
|
4267 int col = tree_to_mat_idx (tmp); |
|
|
4268 REP_ELEM_ASSIGN (i, col, rhs_m.elem (0, j), rhs_cm.elem (0, j), |
|
|
4269 rhs.is_real_type ()); |
|
|
4270 } |
|
|
4271 } |
|
|
4272 |
|
|
4273 /* 4 */ |
|
|
4274 void |
|
529
|
4275 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, int i, |
|
492
|
4276 tree_constant_rep::constant_type mcj) |
|
|
4277 { |
|
|
4278 assert (mcj == magic_colon); |
|
|
4279 |
|
|
4280 int nc = columns (); |
|
|
4281 |
|
|
4282 if (rhs.is_zero_by_zero ()) |
|
|
4283 { |
|
|
4284 delete_row (i); |
|
|
4285 } |
|
|
4286 else if (rhs.is_matrix_type ()) |
|
|
4287 { |
|
|
4288 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4289 |
|
|
4290 for (int j = 0; j < nc; j++) |
|
|
4291 REP_ELEM_ASSIGN (i, j, rhs_m.elem (0, j), rhs_cm.elem (0, j), |
|
|
4292 rhs.is_real_type ()); |
|
|
4293 } |
|
|
4294 else if (rhs.is_scalar_type () && nc == 1) |
|
|
4295 { |
|
|
4296 REP_ELEM_ASSIGN (i, 0, rhs.double_value (), |
|
|
4297 rhs.complex_value (), rhs.is_real_type ()); |
|
|
4298 } |
|
|
4299 else |
|
|
4300 panic_impossible (); |
|
|
4301 } |
|
|
4302 |
|
|
4303 /* 5 */ |
|
|
4304 void |
|
529
|
4305 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
492
|
4306 idx_vector& iv, int j) |
|
|
4307 { |
|
|
4308 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4309 |
|
|
4310 for (int i = 0; i < iv.capacity (); i++) |
|
|
4311 { |
|
|
4312 int row = iv.elem (i); |
|
|
4313 REP_ELEM_ASSIGN (row, j, rhs_m.elem (i, 0), |
|
|
4314 rhs_cm.elem (i, 0), rhs.is_real_type ()); |
|
|
4315 } |
|
|
4316 } |
|
|
4317 |
|
|
4318 /* 6 */ |
|
|
4319 void |
|
529
|
4320 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
|
4321 idx_vector& iv, |
|
|
4322 idx_vector& jv) |
|
492
|
4323 { |
|
|
4324 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4325 |
|
|
4326 for (int i = 0; i < iv.capacity (); i++) |
|
|
4327 { |
|
|
4328 int row = iv.elem (i); |
|
|
4329 for (int j = 0; j < jv.capacity (); j++) |
|
|
4330 { |
|
|
4331 int col = jv.elem (j); |
|
|
4332 REP_ELEM_ASSIGN (row, col, rhs_m.elem (i, j), |
|
|
4333 rhs_cm.elem (i, j), rhs.is_real_type ()); |
|
|
4334 } |
|
|
4335 } |
|
|
4336 } |
|
|
4337 |
|
|
4338 /* 7 */ |
|
|
4339 void |
|
529
|
4340 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
|
4341 idx_vector& iv, |
|
|
4342 Range& rj) |
|
492
|
4343 { |
|
|
4344 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4345 |
|
|
4346 double b = rj.base (); |
|
|
4347 double increment = rj.inc (); |
|
|
4348 |
|
|
4349 for (int i = 0; i < iv.capacity (); i++) |
|
|
4350 { |
|
|
4351 int row = iv.elem (i); |
|
|
4352 for (int j = 0; j < rj.nelem (); j++) |
|
|
4353 { |
|
|
4354 double tmp = b + j * increment; |
|
|
4355 int col = tree_to_mat_idx (tmp); |
|
|
4356 REP_ELEM_ASSIGN (row, col, rhs_m.elem (i, j), |
|
|
4357 rhs_cm.elem (i, j), rhs.is_real_type ()); |
|
|
4358 } |
|
|
4359 } |
|
|
4360 } |
|
|
4361 |
|
|
4362 /* 8 */ |
|
|
4363 void |
|
529
|
4364 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
|
4365 idx_vector& iv, |
|
492
|
4366 tree_constant_rep::constant_type mcj) |
|
|
4367 { |
|
|
4368 assert (mcj == magic_colon); |
|
|
4369 |
|
|
4370 if (rhs.is_zero_by_zero ()) |
|
|
4371 { |
|
|
4372 delete_rows (iv); |
|
|
4373 } |
|
|
4374 else |
|
|
4375 { |
|
|
4376 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4377 |
|
|
4378 int nc = columns (); |
|
|
4379 |
|
|
4380 for (int j = 0; j < nc; j++) |
|
|
4381 { |
|
|
4382 for (int i = 0; i < iv.capacity (); i++) |
|
|
4383 { |
|
|
4384 int row = iv.elem (i); |
|
|
4385 REP_ELEM_ASSIGN (row, j, rhs_m.elem (i, j), |
|
|
4386 rhs_cm.elem (i, j), rhs.is_real_type ()); |
|
|
4387 } |
|
|
4388 } |
|
|
4389 } |
|
|
4390 } |
|
|
4391 |
|
|
4392 /* 9 */ |
|
|
4393 void |
|
529
|
4394 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
|
4395 Range& ri, int j) |
|
492
|
4396 { |
|
|
4397 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4398 |
|
|
4399 double b = ri.base (); |
|
|
4400 double increment = ri.inc (); |
|
|
4401 |
|
|
4402 for (int i = 0; i < ri.nelem (); i++) |
|
|
4403 { |
|
|
4404 double tmp = b + i * increment; |
|
|
4405 int row = tree_to_mat_idx (tmp); |
|
|
4406 REP_ELEM_ASSIGN (row, j, rhs_m.elem (i, 0), |
|
|
4407 rhs_cm.elem (i, 0), rhs.is_real_type ()); |
|
|
4408 } |
|
|
4409 } |
|
|
4410 |
|
|
4411 /* 10 */ |
|
|
4412 void |
|
529
|
4413 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
|
4414 Range& ri, |
|
492
|
4415 idx_vector& jv) |
|
|
4416 { |
|
|
4417 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4418 |
|
|
4419 double b = ri.base (); |
|
|
4420 double increment = ri.inc (); |
|
|
4421 |
|
|
4422 for (int j = 0; j < jv.capacity (); j++) |
|
|
4423 { |
|
|
4424 int col = jv.elem (j); |
|
|
4425 for (int i = 0; i < ri.nelem (); i++) |
|
|
4426 { |
|
|
4427 double tmp = b + i * increment; |
|
|
4428 int row = tree_to_mat_idx (tmp); |
|
|
4429 REP_ELEM_ASSIGN (row, col, rhs_m.elem (i, j), |
|
|
4430 rhs_m.elem (i, j), rhs.is_real_type ()); |
|
|
4431 } |
|
|
4432 } |
|
|
4433 } |
|
|
4434 |
|
|
4435 /* 11 */ |
|
|
4436 void |
|
529
|
4437 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
|
4438 Range& ri, |
|
492
|
4439 Range& rj) |
|
|
4440 { |
|
|
4441 double ib = ri.base (); |
|
|
4442 double iinc = ri.inc (); |
|
|
4443 double jb = rj.base (); |
|
|
4444 double jinc = rj.inc (); |
|
|
4445 |
|
|
4446 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4447 |
|
|
4448 for (int i = 0; i < ri.nelem (); i++) |
|
|
4449 { |
|
|
4450 double itmp = ib + i * iinc; |
|
|
4451 int row = tree_to_mat_idx (itmp); |
|
|
4452 for (int j = 0; j < rj.nelem (); j++) |
|
|
4453 { |
|
|
4454 double jtmp = jb + j * jinc; |
|
|
4455 int col = tree_to_mat_idx (jtmp); |
|
|
4456 REP_ELEM_ASSIGN (row, col, rhs_m.elem (i, j), |
|
|
4457 rhs_cm.elem (i, j), rhs.is_real_type ()); |
|
|
4458 } |
|
|
4459 } |
|
|
4460 } |
|
|
4461 |
|
|
4462 /* 12 */ |
|
|
4463 void |
|
529
|
4464 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
|
4465 Range& ri, |
|
492
|
4466 tree_constant_rep::constant_type mcj) |
|
|
4467 { |
|
|
4468 assert (mcj == magic_colon); |
|
|
4469 |
|
|
4470 if (rhs.is_zero_by_zero ()) |
|
|
4471 { |
|
|
4472 delete_rows (ri); |
|
|
4473 } |
|
|
4474 else |
|
|
4475 { |
|
|
4476 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4477 |
|
|
4478 double ib = ri.base (); |
|
|
4479 double iinc = ri.inc (); |
|
|
4480 |
|
|
4481 int nc = columns (); |
|
|
4482 |
|
|
4483 for (int i = 0; i < ri.nelem (); i++) |
|
|
4484 { |
|
|
4485 double itmp = ib + i * iinc; |
|
|
4486 int row = tree_to_mat_idx (itmp); |
|
|
4487 for (int j = 0; j < nc; j++) |
|
|
4488 REP_ELEM_ASSIGN (row, j, rhs_m.elem (i, j), |
|
|
4489 rhs_cm.elem (i, j), rhs.is_real_type ()); |
|
|
4490 } |
|
|
4491 } |
|
|
4492 } |
|
|
4493 |
|
|
4494 /* 13 */ |
|
|
4495 void |
|
529
|
4496 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
492
|
4497 tree_constant_rep::constant_type mci, |
|
|
4498 int j) |
|
|
4499 { |
|
|
4500 assert (mci == magic_colon); |
|
|
4501 |
|
|
4502 int nr = rows (); |
|
|
4503 |
|
|
4504 if (rhs.is_zero_by_zero ()) |
|
|
4505 { |
|
|
4506 delete_column (j); |
|
|
4507 } |
|
|
4508 else if (rhs.is_matrix_type ()) |
|
|
4509 { |
|
|
4510 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4511 |
|
|
4512 for (int i = 0; i < nr; i++) |
|
|
4513 REP_ELEM_ASSIGN (i, j, rhs_m.elem (i, 0), |
|
|
4514 rhs_cm.elem (i, 0), rhs.is_real_type ()); |
|
|
4515 } |
|
|
4516 else if (rhs.is_scalar_type () && nr == 1) |
|
|
4517 { |
|
|
4518 REP_ELEM_ASSIGN (0, j, rhs.double_value (), |
|
|
4519 rhs.complex_value (), rhs.is_real_type ()); |
|
|
4520 } |
|
|
4521 else |
|
|
4522 panic_impossible (); |
|
|
4523 } |
|
|
4524 |
|
|
4525 /* 14 */ |
|
|
4526 void |
|
529
|
4527 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
492
|
4528 tree_constant_rep::constant_type mci, |
|
|
4529 idx_vector& jv) |
|
|
4530 { |
|
|
4531 assert (mci == magic_colon); |
|
|
4532 |
|
|
4533 if (rhs.is_zero_by_zero ()) |
|
|
4534 { |
|
|
4535 delete_columns (jv); |
|
|
4536 } |
|
|
4537 else |
|
|
4538 { |
|
|
4539 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4540 |
|
|
4541 int nr = rows (); |
|
|
4542 |
|
|
4543 for (int i = 0; i < nr; i++) |
|
|
4544 { |
|
|
4545 for (int j = 0; j < jv.capacity (); j++) |
|
|
4546 { |
|
|
4547 int col = jv.elem (j); |
|
|
4548 REP_ELEM_ASSIGN (i, col, rhs_m.elem (i, j), |
|
|
4549 rhs_cm.elem (i, j), rhs.is_real_type ()); |
|
|
4550 } |
|
|
4551 } |
|
|
4552 } |
|
|
4553 } |
|
|
4554 |
|
|
4555 /* 15 */ |
|
|
4556 void |
|
529
|
4557 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
492
|
4558 tree_constant_rep::constant_type mci, |
|
|
4559 Range& rj) |
|
|
4560 { |
|
|
4561 assert (mci == magic_colon); |
|
|
4562 |
|
|
4563 if (rhs.is_zero_by_zero ()) |
|
|
4564 { |
|
|
4565 delete_columns (rj); |
|
|
4566 } |
|
|
4567 else |
|
|
4568 { |
|
|
4569 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4570 |
|
|
4571 int nr = rows (); |
|
|
4572 |
|
|
4573 double jb = rj.base (); |
|
|
4574 double jinc = rj.inc (); |
|
|
4575 |
|
|
4576 for (int j = 0; j < rj.nelem (); j++) |
|
|
4577 { |
|
|
4578 double jtmp = jb + j * jinc; |
|
|
4579 int col = tree_to_mat_idx (jtmp); |
|
|
4580 for (int i = 0; i < nr; i++) |
|
|
4581 { |
|
|
4582 REP_ELEM_ASSIGN (i, col, rhs_m.elem (i, j), |
|
|
4583 rhs_cm.elem (i, j), rhs.is_real_type ()); |
|
|
4584 } |
|
|
4585 } |
|
|
4586 } |
|
|
4587 } |
|
|
4588 |
|
|
4589 /* 16 */ |
|
|
4590 void |
|
529
|
4591 tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, |
|
492
|
4592 tree_constant_rep::constant_type mci, |
|
|
4593 tree_constant_rep::constant_type mcj) |
|
|
4594 { |
|
|
4595 assert (mci == magic_colon && mcj == magic_colon); |
|
|
4596 |
|
|
4597 switch (type_tag) |
|
|
4598 { |
|
|
4599 case scalar_constant: |
|
|
4600 break; |
|
|
4601 case matrix_constant: |
|
|
4602 delete matrix; |
|
|
4603 break; |
|
|
4604 case complex_scalar_constant: |
|
|
4605 delete complex_scalar; |
|
|
4606 break; |
|
|
4607 case complex_matrix_constant: |
|
|
4608 delete complex_matrix; |
|
|
4609 break; |
|
|
4610 case string_constant: |
|
|
4611 delete [] string; |
|
|
4612 break; |
|
|
4613 case range_constant: |
|
|
4614 delete range; |
|
|
4615 break; |
|
|
4616 case magic_colon: |
|
|
4617 default: |
|
|
4618 panic_impossible (); |
|
|
4619 break; |
|
|
4620 } |
|
|
4621 |
|
|
4622 type_tag = rhs.const_type (); |
|
|
4623 |
|
|
4624 switch (type_tag) |
|
|
4625 { |
|
|
4626 case scalar_constant: |
|
|
4627 scalar = rhs.double_value (); |
|
|
4628 break; |
|
|
4629 case matrix_constant: |
|
|
4630 matrix = new Matrix (rhs.matrix_value ()); |
|
|
4631 break; |
|
|
4632 case string_constant: |
|
|
4633 string = strsave (rhs.string_value ()); |
|
|
4634 break; |
|
|
4635 case complex_matrix_constant: |
|
|
4636 complex_matrix = new ComplexMatrix (rhs.complex_matrix_value ()); |
|
|
4637 break; |
|
|
4638 case complex_scalar_constant: |
|
|
4639 complex_scalar = new Complex (rhs.complex_value ()); |
|
|
4640 break; |
|
|
4641 case range_constant: |
|
|
4642 range = new Range (rhs.range_value ()); |
|
|
4643 break; |
|
|
4644 case magic_colon: |
|
|
4645 default: |
|
|
4646 panic_impossible (); |
|
|
4647 break; |
|
|
4648 } |
|
|
4649 } |
|
|
4650 |
|
|
4651 /* |
|
|
4652 * Functions for deleting rows or columns of a matrix. These are used |
|
|
4653 * to handle statements like |
|
|
4654 * |
|
|
4655 * M (i, j) = [] |
|
|
4656 */ |
|
|
4657 void |
|
|
4658 tree_constant_rep::delete_row (int idx) |
|
|
4659 { |
|
|
4660 if (type_tag == matrix_constant) |
|
|
4661 { |
|
|
4662 int nr = matrix->rows (); |
|
|
4663 int nc = matrix->columns (); |
|
|
4664 Matrix *new_matrix = new Matrix (nr-1, nc); |
|
|
4665 int ii = 0; |
|
|
4666 for (int i = 0; i < nr; i++) |
|
|
4667 { |
|
|
4668 if (i != idx) |
|
|
4669 { |
|
|
4670 for (int j = 0; j < nc; j++) |
|
|
4671 new_matrix->elem (ii, j) = matrix->elem (i, j); |
|
|
4672 ii++; |
|
|
4673 } |
|
|
4674 } |
|
|
4675 delete matrix; |
|
|
4676 matrix = new_matrix; |
|
|
4677 } |
|
|
4678 else if (type_tag == complex_matrix_constant) |
|
|
4679 { |
|
|
4680 int nr = complex_matrix->rows (); |
|
|
4681 int nc = complex_matrix->columns (); |
|
|
4682 ComplexMatrix *new_matrix = new ComplexMatrix (nr-1, nc); |
|
|
4683 int ii = 0; |
|
|
4684 for (int i = 0; i < nr; i++) |
|
|
4685 { |
|
|
4686 if (i != idx) |
|
|
4687 { |
|
|
4688 for (int j = 0; j < nc; j++) |
|
|
4689 new_matrix->elem (ii, j) = complex_matrix->elem (i, j); |
|
|
4690 ii++; |
|
|
4691 } |
|
|
4692 } |
|
|
4693 delete complex_matrix; |
|
|
4694 complex_matrix = new_matrix; |
|
|
4695 } |
|
|
4696 else |
|
|
4697 panic_impossible (); |
|
|
4698 } |
|
|
4699 |
|
|
4700 void |
|
|
4701 tree_constant_rep::delete_rows (idx_vector& iv) |
|
|
4702 { |
|
|
4703 iv.sort_uniq (); |
|
|
4704 int num_to_delete = iv.length (); |
|
|
4705 |
|
|
4706 int nr = rows (); |
|
|
4707 int nc = columns (); |
|
|
4708 |
|
|
4709 // If deleting all rows of a column vector, make result 0x0. |
|
|
4710 if (nc == 1 && num_to_delete == nr) |
|
|
4711 nc = 0; |
|
|
4712 |
|
|
4713 if (type_tag == matrix_constant) |
|
|
4714 { |
|
|
4715 Matrix *new_matrix = new Matrix (nr-num_to_delete, nc); |
|
|
4716 if (nr > num_to_delete) |
|
|
4717 { |
|
|
4718 int ii = 0; |
|
|
4719 int idx = 0; |
|
|
4720 for (int i = 0; i < nr; i++) |
|
|
4721 { |
|
|
4722 if (i == iv.elem (idx)) |
|
|
4723 idx++; |
|
|
4724 else |
|
|
4725 { |
|
|
4726 for (int j = 0; j < nc; j++) |
|
|
4727 new_matrix->elem (ii, j) = matrix->elem (i, j); |
|
|
4728 ii++; |
|
|
4729 } |
|
|
4730 } |
|
|
4731 } |
|
|
4732 delete matrix; |
|
|
4733 matrix = new_matrix; |
|
|
4734 } |
|
|
4735 else if (type_tag == complex_matrix_constant) |
|
|
4736 { |
|
|
4737 ComplexMatrix *new_matrix = new ComplexMatrix (nr-num_to_delete, nc); |
|
|
4738 if (nr > num_to_delete) |
|
|
4739 { |
|
|
4740 int ii = 0; |
|
|
4741 int idx = 0; |
|
|
4742 for (int i = 0; i < nr; i++) |
|
|
4743 { |
|
|
4744 if (i == iv.elem (idx)) |
|
|
4745 idx++; |
|
|
4746 else |
|
|
4747 { |
|
|
4748 for (int j = 0; j < nc; j++) |
|
|
4749 new_matrix->elem (ii, j) = complex_matrix->elem (i, j); |
|
|
4750 ii++; |
|
|
4751 } |
|
|
4752 } |
|
|
4753 } |
|
|
4754 delete complex_matrix; |
|
|
4755 complex_matrix = new_matrix; |
|
|
4756 } |
|
|
4757 else |
|
|
4758 panic_impossible (); |
|
|
4759 } |
|
|
4760 |
|
|
4761 void |
|
|
4762 tree_constant_rep::delete_rows (Range& ri) |
|
|
4763 { |
|
|
4764 ri.sort (); |
|
|
4765 int num_to_delete = ri.nelem (); |
|
|
4766 |
|
|
4767 int nr = rows (); |
|
|
4768 int nc = columns (); |
|
|
4769 |
|
|
4770 // If deleting all rows of a column vector, make result 0x0. |
|
|
4771 if (nc == 1 && num_to_delete == nr) |
|
|
4772 nc = 0; |
|
|
4773 |
|
|
4774 double ib = ri.base (); |
|
|
4775 double iinc = ri.inc (); |
|
|
4776 |
|
|
4777 int max_idx = tree_to_mat_idx (ri.max ()); |
|
|
4778 |
|
|
4779 if (type_tag == matrix_constant) |
|
|
4780 { |
|
|
4781 Matrix *new_matrix = new Matrix (nr-num_to_delete, nc); |
|
|
4782 if (nr > num_to_delete) |
|
|
4783 { |
|
|
4784 int ii = 0; |
|
|
4785 int idx = 0; |
|
|
4786 for (int i = 0; i < nr; i++) |
|
|
4787 { |
|
|
4788 double itmp = ib + idx * iinc; |
|
|
4789 int row = tree_to_mat_idx (itmp); |
|
|
4790 |
|
|
4791 if (i == row && row <= max_idx) |
|
|
4792 idx++; |
|
|
4793 else |
|
|
4794 { |
|
|
4795 for (int j = 0; j < nc; j++) |
|
|
4796 new_matrix->elem (ii, j) = matrix->elem (i, j); |
|
|
4797 ii++; |
|
|
4798 } |
|
|
4799 } |
|
|
4800 } |
|
|
4801 delete matrix; |
|
|
4802 matrix = new_matrix; |
|
|
4803 } |
|
|
4804 else if (type_tag == complex_matrix_constant) |
|
|
4805 { |
|
|
4806 ComplexMatrix *new_matrix = new ComplexMatrix (nr-num_to_delete, nc); |
|
|
4807 if (nr > num_to_delete) |
|
|
4808 { |
|
|
4809 int ii = 0; |
|
|
4810 int idx = 0; |
|
|
4811 for (int i = 0; i < nr; i++) |
|
|
4812 { |
|
|
4813 double itmp = ib + idx * iinc; |
|
|
4814 int row = tree_to_mat_idx (itmp); |
|
|
4815 |
|
|
4816 if (i == row && row <= max_idx) |
|
|
4817 idx++; |
|
|
4818 else |
|
|
4819 { |
|
|
4820 for (int j = 0; j < nc; j++) |
|
|
4821 new_matrix->elem (ii, j) = complex_matrix->elem (i, j); |
|
|
4822 ii++; |
|
|
4823 } |
|
|
4824 } |
|
|
4825 } |
|
|
4826 delete complex_matrix; |
|
|
4827 complex_matrix = new_matrix; |
|
|
4828 } |
|
|
4829 else |
|
|
4830 panic_impossible (); |
|
|
4831 } |
|
|
4832 |
|
|
4833 void |
|
|
4834 tree_constant_rep::delete_column (int idx) |
|
|
4835 { |
|
|
4836 if (type_tag == matrix_constant) |
|
|
4837 { |
|
|
4838 int nr = matrix->rows (); |
|
|
4839 int nc = matrix->columns (); |
|
|
4840 Matrix *new_matrix = new Matrix (nr, nc-1); |
|
|
4841 int jj = 0; |
|
|
4842 for (int j = 0; j < nc; j++) |
|
|
4843 { |
|
|
4844 if (j != idx) |
|
|
4845 { |
|
|
4846 for (int i = 0; i < nr; i++) |
|
|
4847 new_matrix->elem (i, jj) = matrix->elem (i, j); |
|
|
4848 jj++; |
|
|
4849 } |
|
|
4850 } |
|
|
4851 delete matrix; |
|
|
4852 matrix = new_matrix; |
|
|
4853 } |
|
|
4854 else if (type_tag == complex_matrix_constant) |
|
|
4855 { |
|
|
4856 int nr = complex_matrix->rows (); |
|
|
4857 int nc = complex_matrix->columns (); |
|
|
4858 ComplexMatrix *new_matrix = new ComplexMatrix (nr, nc-1); |
|
|
4859 int jj = 0; |
|
|
4860 for (int j = 0; j < nc; j++) |
|
|
4861 { |
|
|
4862 if (j != idx) |
|
|
4863 { |
|
|
4864 for (int i = 0; i < nr; i++) |
|
|
4865 new_matrix->elem (i, jj) = complex_matrix->elem (i, j); |
|
|
4866 jj++; |
|
|
4867 } |
|
|
4868 } |
|
|
4869 delete complex_matrix; |
|
|
4870 complex_matrix = new_matrix; |
|
|
4871 } |
|
|
4872 else |
|
|
4873 panic_impossible (); |
|
|
4874 } |
|
|
4875 |
|
|
4876 void |
|
|
4877 tree_constant_rep::delete_columns (idx_vector& jv) |
|
|
4878 { |
|
|
4879 jv.sort_uniq (); |
|
|
4880 int num_to_delete = jv.length (); |
|
|
4881 |
|
|
4882 int nr = rows (); |
|
|
4883 int nc = columns (); |
|
|
4884 |
|
|
4885 // If deleting all columns of a row vector, make result 0x0. |
|
|
4886 if (nr == 1 && num_to_delete == nc) |
|
|
4887 nr = 0; |
|
|
4888 |
|
|
4889 if (type_tag == matrix_constant) |
|
|
4890 { |
|
|
4891 Matrix *new_matrix = new Matrix (nr, nc-num_to_delete); |
|
|
4892 if (nc > num_to_delete) |
|
|
4893 { |
|
|
4894 int jj = 0; |
|
|
4895 int idx = 0; |
|
|
4896 for (int j = 0; j < nc; j++) |
|
|
4897 { |
|
|
4898 if (j == jv.elem (idx)) |
|
|
4899 idx++; |
|
|
4900 else |
|
|
4901 { |
|
|
4902 for (int i = 0; i < nr; i++) |
|
|
4903 new_matrix->elem (i, jj) = matrix->elem (i, j); |
|
|
4904 jj++; |
|
|
4905 } |
|
|
4906 } |
|
|
4907 } |
|
|
4908 delete matrix; |
|
|
4909 matrix = new_matrix; |
|
|
4910 } |
|
|
4911 else if (type_tag == complex_matrix_constant) |
|
|
4912 { |
|
|
4913 ComplexMatrix *new_matrix = new ComplexMatrix (nr, nc-num_to_delete); |
|
|
4914 if (nc > num_to_delete) |
|
|
4915 { |
|
|
4916 int jj = 0; |
|
|
4917 int idx = 0; |
|
|
4918 for (int j = 0; j < nc; j++) |
|
|
4919 { |
|
|
4920 if (j == jv.elem (idx)) |
|
|
4921 idx++; |
|
|
4922 else |
|
|
4923 { |
|
|
4924 for (int i = 0; i < nr; i++) |
|
|
4925 new_matrix->elem (i, jj) = complex_matrix->elem (i, j); |
|
|
4926 jj++; |
|
|
4927 } |
|
|
4928 } |
|
|
4929 } |
|
|
4930 delete complex_matrix; |
|
|
4931 complex_matrix = new_matrix; |
|
|
4932 } |
|
|
4933 else |
|
|
4934 panic_impossible (); |
|
|
4935 } |
|
|
4936 |
|
|
4937 void |
|
|
4938 tree_constant_rep::delete_columns (Range& rj) |
|
|
4939 { |
|
|
4940 rj.sort (); |
|
|
4941 int num_to_delete = rj.nelem (); |
|
|
4942 |
|
|
4943 int nr = rows (); |
|
|
4944 int nc = columns (); |
|
|
4945 |
|
|
4946 // If deleting all columns of a row vector, make result 0x0. |
|
|
4947 if (nr == 1 && num_to_delete == nc) |
|
|
4948 nr = 0; |
|
|
4949 |
|
|
4950 double jb = rj.base (); |
|
|
4951 double jinc = rj.inc (); |
|
|
4952 |
|
|
4953 int max_idx = tree_to_mat_idx (rj.max ()); |
|
|
4954 |
|
|
4955 if (type_tag == matrix_constant) |
|
|
4956 { |
|
|
4957 Matrix *new_matrix = new Matrix (nr, nc-num_to_delete); |
|
|
4958 if (nc > num_to_delete) |
|
|
4959 { |
|
|
4960 int jj = 0; |
|
|
4961 int idx = 0; |
|
|
4962 for (int j = 0; j < nc; j++) |
|
|
4963 { |
|
|
4964 double jtmp = jb + idx * jinc; |
|
|
4965 int col = tree_to_mat_idx (jtmp); |
|
|
4966 |
|
|
4967 if (j == col && col <= max_idx) |
|
|
4968 idx++; |
|
|
4969 else |
|
|
4970 { |
|
|
4971 for (int i = 0; i < nr; i++) |
|
|
4972 new_matrix->elem (i, jj) = matrix->elem (i, j); |
|
|
4973 jj++; |
|
|
4974 } |
|
|
4975 } |
|
|
4976 } |
|
|
4977 delete matrix; |
|
|
4978 matrix = new_matrix; |
|
|
4979 } |
|
|
4980 else if (type_tag == complex_matrix_constant) |
|
|
4981 { |
|
|
4982 ComplexMatrix *new_matrix = new ComplexMatrix (nr, nc-num_to_delete); |
|
|
4983 if (nc > num_to_delete) |
|
|
4984 { |
|
|
4985 int jj = 0; |
|
|
4986 int idx = 0; |
|
|
4987 for (int j = 0; j < nc; j++) |
|
|
4988 { |
|
|
4989 double jtmp = jb + idx * jinc; |
|
|
4990 int col = tree_to_mat_idx (jtmp); |
|
|
4991 |
|
|
4992 if (j == col && col <= max_idx) |
|
|
4993 idx++; |
|
|
4994 else |
|
|
4995 { |
|
|
4996 for (int i = 0; i < nr; i++) |
|
|
4997 new_matrix->elem (i, jj) = complex_matrix->elem (i, j); |
|
|
4998 jj++; |
|
|
4999 } |
|
|
5000 } |
|
|
5001 } |
|
|
5002 delete complex_matrix; |
|
|
5003 complex_matrix = new_matrix; |
|
|
5004 } |
|
|
5005 else |
|
|
5006 panic_impossible (); |
|
|
5007 } |
|
|
5008 |
|
|
5009 /* |
|
|
5010 * Indexing functions. |
|
|
5011 */ |
|
|
5012 int |
|
|
5013 tree_constant_rep::valid_as_scalar_index (void) const |
|
|
5014 { |
|
|
5015 int valid = type_tag == magic_colon |
|
|
5016 || (type_tag == scalar_constant && NINT (scalar) == 1) |
|
|
5017 || (type_tag == range_constant |
|
|
5018 && range->nelem () == 1 && NINT (range->base ()) == 1); |
|
|
5019 |
|
|
5020 return valid; |
|
|
5021 } |
|
|
5022 |
|
|
5023 tree_constant |
|
506
|
5024 tree_constant_rep::do_scalar_index (const Octave_object& args) const |
|
492
|
5025 { |
|
506
|
5026 if (valid_scalar_indices (args)) |
|
492
|
5027 { |
|
|
5028 if (type_tag == scalar_constant) |
|
|
5029 return tree_constant (scalar); |
|
|
5030 else if (type_tag == complex_scalar_constant) |
|
|
5031 return tree_constant (*complex_scalar); |
|
|
5032 else |
|
|
5033 panic_impossible (); |
|
|
5034 } |
|
|
5035 else |
|
|
5036 { |
|
|
5037 int rows = 0; |
|
|
5038 int cols = 0; |
|
|
5039 |
|
506
|
5040 int nargin = args.length (); |
|
|
5041 |
|
|
5042 switch (nargin) |
|
492
|
5043 { |
|
|
5044 case 3: |
|
|
5045 { |
|
500
|
5046 if (args(2).is_matrix_type ()) |
|
492
|
5047 { |
|
500
|
5048 Matrix mj = args(2).matrix_value (); |
|
492
|
5049 |
|
|
5050 idx_vector j (mj, user_pref.do_fortran_indexing, ""); |
|
|
5051 if (! j) |
|
|
5052 return tree_constant (); |
|
|
5053 |
|
|
5054 int len = j.length (); |
|
|
5055 if (len == j.ones_count ()) |
|
|
5056 cols = len; |
|
|
5057 } |
|
500
|
5058 else if (args(2).const_type () == magic_colon |
|
|
5059 || (args(2).is_scalar_type () |
|
|
5060 && NINT (args(2).double_value ()) == 1)) |
|
492
|
5061 { |
|
|
5062 cols = 1; |
|
|
5063 } |
|
|
5064 else |
|
|
5065 break; |
|
|
5066 } |
|
|
5067 // Fall through... |
|
|
5068 case 2: |
|
|
5069 { |
|
500
|
5070 if (args(1).is_matrix_type ()) |
|
492
|
5071 { |
|
500
|
5072 Matrix mi = args(1).matrix_value (); |
|
492
|
5073 |
|
|
5074 idx_vector i (mi, user_pref.do_fortran_indexing, ""); |
|
|
5075 if (! i) |
|
|
5076 return tree_constant (); |
|
|
5077 |
|
|
5078 int len = i.length (); |
|
|
5079 if (len == i.ones_count ()) |
|
|
5080 rows = len; |
|
|
5081 } |
|
500
|
5082 else if (args(1).const_type () == magic_colon |
|
|
5083 || (args(1).is_scalar_type () |
|
|
5084 && NINT (args(1).double_value ()) == 1)) |
|
492
|
5085 { |
|
|
5086 rows = 1; |
|
|
5087 } |
|
500
|
5088 else if (args(1).is_scalar_type () |
|
|
5089 && NINT (args(1).double_value ()) == 0) |
|
492
|
5090 { |
|
|
5091 Matrix m (0, 0); |
|
|
5092 return tree_constant (m); |
|
|
5093 } |
|
|
5094 else |
|
|
5095 break; |
|
|
5096 |
|
|
5097 if (cols == 0) |
|
|
5098 { |
|
|
5099 if (user_pref.prefer_column_vectors) |
|
|
5100 cols = 1; |
|
|
5101 else |
|
|
5102 { |
|
|
5103 cols = rows; |
|
|
5104 rows = 1; |
|
|
5105 } |
|
|
5106 } |
|
|
5107 |
|
|
5108 if (type_tag == scalar_constant) |
|
|
5109 { |
|
|
5110 Matrix m (rows, cols, scalar); |
|
|
5111 return tree_constant (m); |
|
|
5112 } |
|
|
5113 else if (type_tag == complex_scalar_constant) |
|
|
5114 { |
|
|
5115 ComplexMatrix cm (rows, cols, *complex_scalar); |
|
|
5116 return tree_constant (cm); |
|
|
5117 } |
|
|
5118 else |
|
|
5119 panic_impossible (); |
|
|
5120 } |
|
|
5121 break; |
|
|
5122 default: |
|
504
|
5123 ::error ("invalid number of arguments for scalar type"); |
|
492
|
5124 return tree_constant (); |
|
|
5125 break; |
|
|
5126 } |
|
|
5127 } |
|
|
5128 |
|
|
5129 ::error ("index invalid or out of range for scalar type"); |
|
|
5130 return tree_constant (); |
|
|
5131 } |
|
|
5132 |
|
|
5133 tree_constant |
|
506
|
5134 tree_constant_rep::do_matrix_index (const Octave_object& args) const |
|
492
|
5135 { |
|
|
5136 tree_constant retval; |
|
|
5137 |
|
506
|
5138 int nargin = args.length (); |
|
|
5139 |
|
492
|
5140 switch (nargin) |
|
|
5141 { |
|
|
5142 case 2: |
|
500
|
5143 if (args.length () <= 0) |
|
492
|
5144 ::error ("matrix index is null"); |
|
500
|
5145 else if (args(1).is_undefined ()) |
|
492
|
5146 ::error ("matrix index is a null expression"); |
|
|
5147 else |
|
500
|
5148 retval = do_matrix_index (args(1)); |
|
492
|
5149 break; |
|
|
5150 case 3: |
|
500
|
5151 if (args.length () <= 0) |
|
492
|
5152 ::error ("matrix indices are null"); |
|
500
|
5153 else if (args(1).is_undefined ()) |
|
492
|
5154 ::error ("first matrix index is a null expression"); |
|
500
|
5155 else if (args(2).is_undefined ()) |
|
492
|
5156 ::error ("second matrix index is a null expression"); |
|
|
5157 else |
|
500
|
5158 retval = do_matrix_index (args(1), args(2)); |
|
492
|
5159 break; |
|
|
5160 default: |
|
|
5161 ::error ("too many indices for matrix expression"); |
|
|
5162 break; |
|
|
5163 } |
|
|
5164 |
|
|
5165 return retval; |
|
|
5166 } |
|
|
5167 |
|
|
5168 tree_constant |
|
|
5169 tree_constant_rep::do_matrix_index (const tree_constant& i_arg) const |
|
|
5170 { |
|
|
5171 tree_constant retval; |
|
|
5172 |
|
|
5173 int nr = rows (); |
|
|
5174 int nc = columns (); |
|
|
5175 |
|
|
5176 if (user_pref.do_fortran_indexing) |
|
|
5177 retval = fortran_style_matrix_index (i_arg); |
|
|
5178 else if (nr <= 1 || nc <= 1) |
|
|
5179 retval = do_vector_index (i_arg); |
|
|
5180 else |
|
|
5181 ::error ("single index only valid for row or column vector"); |
|
|
5182 |
|
|
5183 return retval; |
|
|
5184 } |
|
|
5185 |
|
|
5186 tree_constant |
|
|
5187 tree_constant_rep::fortran_style_matrix_index |
|
|
5188 (const tree_constant& i_arg) const |
|
|
5189 { |
|
|
5190 tree_constant retval; |
|
|
5191 |
|
|
5192 tree_constant tmp_i = i_arg.make_numeric_or_magic (); |
|
|
5193 |
|
|
5194 tree_constant_rep::constant_type itype = tmp_i.const_type (); |
|
|
5195 |
|
|
5196 int nr = rows (); |
|
|
5197 int nc = columns (); |
|
|
5198 |
|
|
5199 switch (itype) |
|
|
5200 { |
|
|
5201 case complex_scalar_constant: |
|
|
5202 case scalar_constant: |
|
|
5203 { |
|
|
5204 int i = NINT (tmp_i.double_value ()); |
|
|
5205 int ii = fortran_row (i, nr) - 1; |
|
|
5206 int jj = fortran_column (i, nr) - 1; |
|
|
5207 if (index_check (i-1, "") < 0) |
|
|
5208 return tree_constant (); |
|
|
5209 if (range_max_check (i-1, nr * nc) < 0) |
|
|
5210 return tree_constant (); |
|
|
5211 retval = do_matrix_index (ii, jj); |
|
|
5212 } |
|
|
5213 break; |
|
|
5214 case complex_matrix_constant: |
|
|
5215 case matrix_constant: |
|
|
5216 { |
|
|
5217 Matrix mi = tmp_i.matrix_value (); |
|
|
5218 if (mi.rows () == 0 || mi.columns () == 0) |
|
|
5219 { |
|
|
5220 Matrix mtmp; |
|
|
5221 retval = tree_constant (mtmp); |
|
|
5222 } |
|
|
5223 else |
|
|
5224 { |
|
|
5225 // Yes, we really do want to call this with mi. |
|
|
5226 retval = fortran_style_matrix_index (mi); |
|
|
5227 } |
|
|
5228 } |
|
|
5229 break; |
|
|
5230 case string_constant: |
|
|
5231 gripe_string_invalid (); |
|
|
5232 break; |
|
|
5233 case range_constant: |
|
|
5234 gripe_range_invalid (); |
|
|
5235 break; |
|
|
5236 case magic_colon: |
|
|
5237 retval = do_matrix_index (magic_colon); |
|
|
5238 break; |
|
|
5239 default: |
|
|
5240 panic_impossible (); |
|
|
5241 break; |
|
|
5242 } |
|
|
5243 |
|
|
5244 return retval; |
|
|
5245 } |
|
|
5246 |
|
|
5247 tree_constant |
|
|
5248 tree_constant_rep::fortran_style_matrix_index (const Matrix& mi) const |
|
|
5249 { |
|
|
5250 assert (is_matrix_type ()); |
|
|
5251 |
|
|
5252 tree_constant retval; |
|
|
5253 |
|
|
5254 int nr = rows (); |
|
|
5255 int nc = columns (); |
|
|
5256 |
|
|
5257 int len = nr * nc; |
|
|
5258 |
|
|
5259 int index_nr = mi.rows (); |
|
|
5260 int index_nc = mi.columns (); |
|
|
5261 |
|
|
5262 if (index_nr >= 1 && index_nc >= 1) |
|
|
5263 { |
|
529
|
5264 const double *cop_out = 0; |
|
|
5265 const Complex *c_cop_out = 0; |
|
492
|
5266 int real_type = type_tag == matrix_constant; |
|
|
5267 if (real_type) |
|
|
5268 cop_out = matrix->data (); |
|
|
5269 else |
|
|
5270 c_cop_out = complex_matrix->data (); |
|
|
5271 |
|
|
5272 const double *cop_out_index = mi.data (); |
|
|
5273 |
|
|
5274 idx_vector iv (mi, 1, "", len); |
|
|
5275 if (! iv) |
|
|
5276 return tree_constant (); |
|
|
5277 |
|
|
5278 int result_size = iv.length (); |
|
|
5279 |
|
|
5280 if (nc == 1 || (nr != 1 && iv.one_zero_only ())) |
|
|
5281 { |
|
|
5282 CRMATRIX (m, cm, result_size, 1); |
|
|
5283 |
|
|
5284 for (int i = 0; i < result_size; i++) |
|
|
5285 { |
|
|
5286 int idx = iv.elem (i); |
|
|
5287 CRMATRIX_ASSIGN_ELEM (m, cm, i, 0, cop_out [idx], |
|
|
5288 c_cop_out [idx], real_type); |
|
|
5289 } |
|
|
5290 |
|
|
5291 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
5292 } |
|
|
5293 else if (nr == 1) |
|
|
5294 { |
|
|
5295 CRMATRIX (m, cm, 1, result_size); |
|
|
5296 |
|
|
5297 for (int i = 0; i < result_size; i++) |
|
|
5298 { |
|
|
5299 int idx = iv.elem (i); |
|
|
5300 CRMATRIX_ASSIGN_ELEM (m, cm, 0, i, cop_out [idx], |
|
|
5301 c_cop_out [idx], real_type); |
|
|
5302 } |
|
|
5303 |
|
|
5304 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
5305 } |
|
|
5306 else |
|
|
5307 { |
|
|
5308 CRMATRIX (m, cm, index_nr, index_nc); |
|
|
5309 |
|
|
5310 for (int j = 0; j < index_nc; j++) |
|
|
5311 for (int i = 0; i < index_nr; i++) |
|
|
5312 { |
|
|
5313 double tmp = *cop_out_index++; |
|
|
5314 int idx = tree_to_mat_idx (tmp); |
|
|
5315 CRMATRIX_ASSIGN_ELEM (m, cm, i, j, cop_out [idx], |
|
|
5316 c_cop_out [idx], real_type); |
|
|
5317 } |
|
|
5318 |
|
|
5319 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
5320 } |
|
|
5321 } |
|
|
5322 else |
|
|
5323 { |
|
|
5324 if (index_nr == 0 || index_nc == 0) |
|
|
5325 ::error ("empty matrix invalid as index"); |
|
|
5326 else |
|
|
5327 ::error ("invalid matrix index"); |
|
|
5328 return tree_constant (); |
|
|
5329 } |
|
|
5330 |
|
|
5331 return retval; |
|
|
5332 } |
|
|
5333 |
|
|
5334 tree_constant |
|
|
5335 tree_constant_rep::do_vector_index (const tree_constant& i_arg) const |
|
|
5336 { |
|
|
5337 tree_constant retval; |
|
|
5338 |
|
|
5339 tree_constant tmp_i = i_arg.make_numeric_or_range_or_magic (); |
|
|
5340 |
|
|
5341 tree_constant_rep::constant_type itype = tmp_i.const_type (); |
|
|
5342 |
|
|
5343 int nr = rows (); |
|
|
5344 int nc = columns (); |
|
|
5345 |
|
|
5346 int len = MAX (nr, nc); |
|
|
5347 |
|
|
5348 assert ((nr == 1 || nc == 1) && ! user_pref.do_fortran_indexing); |
|
|
5349 |
|
|
5350 int swap_indices = (nr == 1); |
|
|
5351 |
|
|
5352 switch (itype) |
|
|
5353 { |
|
|
5354 case complex_scalar_constant: |
|
|
5355 case scalar_constant: |
|
|
5356 { |
|
|
5357 int i = tree_to_mat_idx (tmp_i.double_value ()); |
|
|
5358 if (index_check (i, "") < 0) |
|
|
5359 return tree_constant (); |
|
|
5360 if (swap_indices) |
|
|
5361 { |
|
|
5362 if (range_max_check (i, nc) < 0) |
|
|
5363 return tree_constant (); |
|
|
5364 retval = do_matrix_index (0, i); |
|
|
5365 } |
|
|
5366 else |
|
|
5367 { |
|
|
5368 if (range_max_check (i, nr) < 0) |
|
|
5369 return tree_constant (); |
|
|
5370 retval = do_matrix_index (i, 0); |
|
|
5371 } |
|
|
5372 } |
|
|
5373 break; |
|
|
5374 case complex_matrix_constant: |
|
|
5375 case matrix_constant: |
|
|
5376 { |
|
|
5377 Matrix mi = tmp_i.matrix_value (); |
|
|
5378 if (mi.rows () == 0 || mi.columns () == 0) |
|
|
5379 { |
|
|
5380 Matrix mtmp; |
|
|
5381 retval = tree_constant (mtmp); |
|
|
5382 } |
|
|
5383 else |
|
|
5384 { |
|
|
5385 idx_vector iv (mi, user_pref.do_fortran_indexing, "", len); |
|
|
5386 if (! iv) |
|
|
5387 return tree_constant (); |
|
|
5388 |
|
|
5389 if (swap_indices) |
|
|
5390 { |
|
|
5391 if (range_max_check (iv.max (), nc) < 0) |
|
|
5392 return tree_constant (); |
|
|
5393 retval = do_matrix_index (0, iv); |
|
|
5394 } |
|
|
5395 else |
|
|
5396 { |
|
|
5397 if (range_max_check (iv.max (), nr) < 0) |
|
|
5398 return tree_constant (); |
|
|
5399 retval = do_matrix_index (iv, 0); |
|
|
5400 } |
|
|
5401 } |
|
|
5402 } |
|
|
5403 break; |
|
|
5404 case string_constant: |
|
|
5405 gripe_string_invalid (); |
|
|
5406 break; |
|
|
5407 case range_constant: |
|
|
5408 { |
|
|
5409 Range ri = tmp_i.range_value (); |
|
|
5410 if (len == 2 && is_zero_one (ri)) |
|
|
5411 { |
|
|
5412 if (swap_indices) |
|
|
5413 retval = do_matrix_index (0, 1); |
|
|
5414 else |
|
|
5415 retval = do_matrix_index (1, 0); |
|
|
5416 } |
|
|
5417 else if (len == 2 && is_one_zero (ri)) |
|
|
5418 { |
|
|
5419 retval = do_matrix_index (0, 0); |
|
|
5420 } |
|
|
5421 else |
|
|
5422 { |
|
|
5423 if (index_check (ri, "") < 0) |
|
|
5424 return tree_constant (); |
|
|
5425 if (swap_indices) |
|
|
5426 { |
|
|
5427 if (range_max_check (tree_to_mat_idx (ri.max ()), nc) < 0) |
|
|
5428 return tree_constant (); |
|
|
5429 retval = do_matrix_index (0, ri); |
|
|
5430 } |
|
|
5431 else |
|
|
5432 { |
|
|
5433 if (range_max_check (tree_to_mat_idx (ri.max ()), nr) < 0) |
|
|
5434 return tree_constant (); |
|
|
5435 retval = do_matrix_index (ri, 0); |
|
|
5436 } |
|
|
5437 } |
|
|
5438 } |
|
|
5439 break; |
|
|
5440 case magic_colon: |
|
|
5441 if (swap_indices) |
|
|
5442 retval = do_matrix_index (0, magic_colon); |
|
|
5443 else |
|
|
5444 retval = do_matrix_index (magic_colon, 0); |
|
|
5445 break; |
|
|
5446 default: |
|
|
5447 panic_impossible (); |
|
|
5448 break; |
|
|
5449 } |
|
|
5450 |
|
|
5451 return retval; |
|
|
5452 } |
|
|
5453 |
|
|
5454 tree_constant |
|
|
5455 tree_constant_rep::do_matrix_index (const tree_constant& i_arg, |
|
|
5456 const tree_constant& j_arg) const |
|
|
5457 { |
|
|
5458 tree_constant retval; |
|
|
5459 |
|
|
5460 tree_constant tmp_i = i_arg.make_numeric_or_range_or_magic (); |
|
|
5461 |
|
|
5462 tree_constant_rep::constant_type itype = tmp_i.const_type (); |
|
|
5463 |
|
|
5464 switch (itype) |
|
|
5465 { |
|
|
5466 case complex_scalar_constant: |
|
|
5467 case scalar_constant: |
|
|
5468 { |
|
|
5469 int i = tree_to_mat_idx (tmp_i.double_value ()); |
|
|
5470 if (index_check (i, "row") < 0) |
|
|
5471 return tree_constant (); |
|
|
5472 retval = do_matrix_index (i, j_arg); |
|
|
5473 } |
|
|
5474 break; |
|
|
5475 case complex_matrix_constant: |
|
|
5476 case matrix_constant: |
|
|
5477 { |
|
|
5478 Matrix mi = tmp_i.matrix_value (); |
|
|
5479 idx_vector iv (mi, user_pref.do_fortran_indexing, "row", rows ()); |
|
|
5480 if (! iv) |
|
|
5481 return tree_constant (); |
|
|
5482 |
|
|
5483 if (iv.length () == 0) |
|
|
5484 { |
|
|
5485 Matrix mtmp; |
|
|
5486 retval = tree_constant (mtmp); |
|
|
5487 } |
|
|
5488 else |
|
|
5489 retval = do_matrix_index (iv, j_arg); |
|
|
5490 } |
|
|
5491 break; |
|
|
5492 case string_constant: |
|
|
5493 gripe_string_invalid (); |
|
|
5494 break; |
|
|
5495 case range_constant: |
|
|
5496 { |
|
|
5497 Range ri = tmp_i.range_value (); |
|
|
5498 int nr = rows (); |
|
|
5499 if (nr == 2 && is_zero_one (ri)) |
|
|
5500 { |
|
|
5501 retval = do_matrix_index (1, j_arg); |
|
|
5502 } |
|
|
5503 else if (nr == 2 && is_one_zero (ri)) |
|
|
5504 { |
|
|
5505 retval = do_matrix_index (0, j_arg); |
|
|
5506 } |
|
|
5507 else |
|
|
5508 { |
|
|
5509 if (index_check (ri, "row") < 0) |
|
|
5510 return tree_constant (); |
|
|
5511 retval = do_matrix_index (ri, j_arg); |
|
|
5512 } |
|
|
5513 } |
|
|
5514 break; |
|
|
5515 case magic_colon: |
|
|
5516 retval = do_matrix_index (magic_colon, j_arg); |
|
|
5517 break; |
|
|
5518 default: |
|
|
5519 panic_impossible (); |
|
|
5520 break; |
|
|
5521 } |
|
|
5522 |
|
|
5523 return retval; |
|
|
5524 } |
|
|
5525 |
|
|
5526 tree_constant |
|
|
5527 tree_constant_rep::do_matrix_index (int i, const tree_constant& j_arg) const |
|
|
5528 { |
|
|
5529 tree_constant retval; |
|
|
5530 |
|
|
5531 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
5532 |
|
|
5533 tree_constant_rep::constant_type jtype = tmp_j.const_type (); |
|
|
5534 |
|
|
5535 int nr = rows (); |
|
|
5536 int nc = columns (); |
|
|
5537 |
|
|
5538 switch (jtype) |
|
|
5539 { |
|
|
5540 case complex_scalar_constant: |
|
|
5541 case scalar_constant: |
|
|
5542 { |
|
|
5543 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
5544 if (index_check (j, "column") < 0) |
|
|
5545 return tree_constant (); |
|
|
5546 if (range_max_check (i, j, nr, nc) < 0) |
|
|
5547 return tree_constant (); |
|
|
5548 retval = do_matrix_index (i, j); |
|
|
5549 } |
|
|
5550 break; |
|
|
5551 case complex_matrix_constant: |
|
|
5552 case matrix_constant: |
|
|
5553 { |
|
|
5554 Matrix mj = tmp_j.matrix_value (); |
|
|
5555 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", nc); |
|
|
5556 if (! jv) |
|
|
5557 return tree_constant (); |
|
|
5558 |
|
|
5559 if (jv.length () == 0) |
|
|
5560 { |
|
|
5561 Matrix mtmp; |
|
|
5562 retval = tree_constant (mtmp); |
|
|
5563 } |
|
|
5564 else |
|
|
5565 { |
|
|
5566 if (range_max_check (i, jv.max (), nr, nc) < 0) |
|
|
5567 return tree_constant (); |
|
|
5568 retval = do_matrix_index (i, jv); |
|
|
5569 } |
|
|
5570 } |
|
|
5571 break; |
|
|
5572 case string_constant: |
|
|
5573 gripe_string_invalid (); |
|
|
5574 break; |
|
|
5575 case range_constant: |
|
|
5576 { |
|
|
5577 Range rj = tmp_j.range_value (); |
|
|
5578 if (nc == 2 && is_zero_one (rj)) |
|
|
5579 { |
|
|
5580 retval = do_matrix_index (i, 1); |
|
|
5581 } |
|
|
5582 else if (nc == 2 && is_one_zero (rj)) |
|
|
5583 { |
|
|
5584 retval = do_matrix_index (i, 0); |
|
|
5585 } |
|
|
5586 else |
|
|
5587 { |
|
|
5588 if (index_check (rj, "column") < 0) |
|
|
5589 return tree_constant (); |
|
|
5590 if (range_max_check (i, tree_to_mat_idx (rj.max ()), nr, nc) < 0) |
|
|
5591 return tree_constant (); |
|
|
5592 retval = do_matrix_index (i, rj); |
|
|
5593 } |
|
|
5594 } |
|
|
5595 break; |
|
|
5596 case magic_colon: |
|
|
5597 if (range_max_check (i, 0, nr, nc) < 0) |
|
|
5598 return tree_constant (); |
|
|
5599 retval = do_matrix_index (i, magic_colon); |
|
|
5600 break; |
|
|
5601 default: |
|
|
5602 panic_impossible (); |
|
|
5603 break; |
|
|
5604 } |
|
|
5605 |
|
|
5606 return retval; |
|
|
5607 } |
|
|
5608 |
|
|
5609 tree_constant |
|
|
5610 tree_constant_rep::do_matrix_index (const idx_vector& iv, |
|
|
5611 const tree_constant& j_arg) const |
|
|
5612 { |
|
|
5613 tree_constant retval; |
|
|
5614 |
|
|
5615 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
5616 |
|
|
5617 tree_constant_rep::constant_type jtype = tmp_j.const_type (); |
|
|
5618 |
|
|
5619 int nr = rows (); |
|
|
5620 int nc = columns (); |
|
|
5621 |
|
|
5622 switch (jtype) |
|
|
5623 { |
|
|
5624 case complex_scalar_constant: |
|
|
5625 case scalar_constant: |
|
|
5626 { |
|
|
5627 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
5628 if (index_check (j, "column") < 0) |
|
|
5629 return tree_constant (); |
|
|
5630 if (range_max_check (iv.max (), j, nr, nc) < 0) |
|
|
5631 return tree_constant (); |
|
|
5632 retval = do_matrix_index (iv, j); |
|
|
5633 } |
|
|
5634 break; |
|
|
5635 case complex_matrix_constant: |
|
|
5636 case matrix_constant: |
|
|
5637 { |
|
|
5638 Matrix mj = tmp_j.matrix_value (); |
|
|
5639 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", nc); |
|
|
5640 if (! jv) |
|
|
5641 return tree_constant (); |
|
|
5642 |
|
|
5643 if (jv.length () == 0) |
|
|
5644 { |
|
|
5645 Matrix mtmp; |
|
|
5646 retval = tree_constant (mtmp); |
|
|
5647 } |
|
|
5648 else |
|
|
5649 { |
|
|
5650 if (range_max_check (iv.max (), jv.max (), nr, nc) < 0) |
|
|
5651 return tree_constant (); |
|
|
5652 retval = do_matrix_index (iv, jv); |
|
|
5653 } |
|
|
5654 } |
|
|
5655 break; |
|
|
5656 case string_constant: |
|
|
5657 gripe_string_invalid (); |
|
|
5658 break; |
|
|
5659 case range_constant: |
|
|
5660 { |
|
|
5661 Range rj = tmp_j.range_value (); |
|
|
5662 if (nc == 2 && is_zero_one (rj)) |
|
|
5663 { |
|
|
5664 retval = do_matrix_index (iv, 1); |
|
|
5665 } |
|
|
5666 else if (nc == 2 && is_one_zero (rj)) |
|
|
5667 { |
|
|
5668 retval = do_matrix_index (iv, 0); |
|
|
5669 } |
|
|
5670 else |
|
|
5671 { |
|
|
5672 if (index_check (rj, "column") < 0) |
|
|
5673 return tree_constant (); |
|
|
5674 if (range_max_check (iv.max (), tree_to_mat_idx (rj.max ()), |
|
|
5675 nr, nc) < 0) |
|
|
5676 return tree_constant (); |
|
|
5677 retval = do_matrix_index (iv, rj); |
|
|
5678 } |
|
|
5679 } |
|
|
5680 break; |
|
|
5681 case magic_colon: |
|
|
5682 if (range_max_check (iv.max (), 0, nr, nc) < 0) |
|
|
5683 return tree_constant (); |
|
|
5684 retval = do_matrix_index (iv, magic_colon); |
|
|
5685 break; |
|
|
5686 default: |
|
|
5687 panic_impossible (); |
|
|
5688 break; |
|
|
5689 } |
|
|
5690 |
|
|
5691 return retval; |
|
|
5692 } |
|
|
5693 |
|
|
5694 tree_constant |
|
|
5695 tree_constant_rep::do_matrix_index (const Range& ri, |
|
|
5696 const tree_constant& j_arg) const |
|
|
5697 { |
|
|
5698 tree_constant retval; |
|
|
5699 |
|
|
5700 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
5701 |
|
|
5702 tree_constant_rep::constant_type jtype = tmp_j.const_type (); |
|
|
5703 |
|
|
5704 int nr = rows (); |
|
|
5705 int nc = columns (); |
|
|
5706 |
|
|
5707 switch (jtype) |
|
|
5708 { |
|
|
5709 case complex_scalar_constant: |
|
|
5710 case scalar_constant: |
|
|
5711 { |
|
|
5712 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
5713 if (index_check (j, "column") < 0) |
|
|
5714 return tree_constant (); |
|
|
5715 if (range_max_check (tree_to_mat_idx (ri.max ()), j, nr, nc) < 0) |
|
|
5716 return tree_constant (); |
|
|
5717 retval = do_matrix_index (ri, j); |
|
|
5718 } |
|
|
5719 break; |
|
|
5720 case complex_matrix_constant: |
|
|
5721 case matrix_constant: |
|
|
5722 { |
|
|
5723 Matrix mj = tmp_j.matrix_value (); |
|
|
5724 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", nc); |
|
|
5725 if (! jv) |
|
|
5726 return tree_constant (); |
|
|
5727 |
|
|
5728 if (jv.length () == 0) |
|
|
5729 { |
|
|
5730 Matrix mtmp; |
|
|
5731 retval = tree_constant (mtmp); |
|
|
5732 } |
|
|
5733 else |
|
|
5734 { |
|
|
5735 if (range_max_check (tree_to_mat_idx (ri.max ()), |
|
|
5736 jv.max (), nr, nc) < 0) |
|
|
5737 return tree_constant (); |
|
|
5738 retval = do_matrix_index (ri, jv); |
|
|
5739 } |
|
|
5740 } |
|
|
5741 break; |
|
|
5742 case string_constant: |
|
|
5743 gripe_string_invalid (); |
|
|
5744 break; |
|
|
5745 case range_constant: |
|
|
5746 { |
|
|
5747 Range rj = tmp_j.range_value (); |
|
|
5748 if (nc == 2 && is_zero_one (rj)) |
|
|
5749 { |
|
|
5750 retval = do_matrix_index (ri, 1); |
|
|
5751 } |
|
|
5752 else if (nc == 2 && is_one_zero (rj)) |
|
|
5753 { |
|
|
5754 retval = do_matrix_index (ri, 0); |
|
|
5755 } |
|
|
5756 else |
|
|
5757 { |
|
|
5758 if (index_check (rj, "column") < 0) |
|
|
5759 return tree_constant (); |
|
|
5760 if (range_max_check (tree_to_mat_idx (ri.max ()), |
|
|
5761 tree_to_mat_idx (rj.max ()), nr, nc) < 0) |
|
|
5762 return tree_constant (); |
|
|
5763 retval = do_matrix_index (ri, rj); |
|
|
5764 } |
|
|
5765 } |
|
|
5766 break; |
|
|
5767 case magic_colon: |
|
|
5768 retval = do_matrix_index (ri, magic_colon); |
|
|
5769 break; |
|
|
5770 default: |
|
|
5771 panic_impossible (); |
|
|
5772 break; |
|
|
5773 } |
|
|
5774 |
|
|
5775 return retval; |
|
|
5776 } |
|
|
5777 |
|
|
5778 tree_constant |
|
|
5779 tree_constant_rep::do_matrix_index (tree_constant_rep::constant_type mci, |
|
|
5780 const tree_constant& j_arg) const |
|
|
5781 { |
|
|
5782 tree_constant retval; |
|
|
5783 |
|
|
5784 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
5785 |
|
|
5786 tree_constant_rep::constant_type jtype = tmp_j.const_type (); |
|
|
5787 |
|
|
5788 int nr = rows (); |
|
|
5789 int nc = columns (); |
|
|
5790 |
|
|
5791 switch (jtype) |
|
|
5792 { |
|
|
5793 case complex_scalar_constant: |
|
|
5794 case scalar_constant: |
|
|
5795 { |
|
|
5796 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
5797 if (index_check (j, "column") < 0) |
|
|
5798 return tree_constant (); |
|
|
5799 if (range_max_check (0, j, nr, nc) < 0) |
|
|
5800 return tree_constant (); |
|
|
5801 retval = do_matrix_index (magic_colon, j); |
|
|
5802 } |
|
|
5803 break; |
|
|
5804 case complex_matrix_constant: |
|
|
5805 case matrix_constant: |
|
|
5806 { |
|
|
5807 Matrix mj = tmp_j.matrix_value (); |
|
|
5808 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", nc); |
|
|
5809 if (! jv) |
|
|
5810 return tree_constant (); |
|
|
5811 |
|
|
5812 if (jv.length () == 0) |
|
|
5813 { |
|
|
5814 Matrix mtmp; |
|
|
5815 retval = tree_constant (mtmp); |
|
|
5816 } |
|
|
5817 else |
|
|
5818 { |
|
|
5819 if (range_max_check (0, jv.max (), nr, nc) < 0) |
|
|
5820 return tree_constant (); |
|
|
5821 retval = do_matrix_index (magic_colon, jv); |
|
|
5822 } |
|
|
5823 } |
|
|
5824 break; |
|
|
5825 case string_constant: |
|
|
5826 gripe_string_invalid (); |
|
|
5827 break; |
|
|
5828 case range_constant: |
|
|
5829 { |
|
|
5830 Range rj = tmp_j.range_value (); |
|
|
5831 if (nc == 2 && is_zero_one (rj)) |
|
|
5832 { |
|
|
5833 retval = do_matrix_index (magic_colon, 1); |
|
|
5834 } |
|
|
5835 else if (nc == 2 && is_one_zero (rj)) |
|
|
5836 { |
|
|
5837 retval = do_matrix_index (magic_colon, 0); |
|
|
5838 } |
|
|
5839 else |
|
|
5840 { |
|
|
5841 if (index_check (rj, "column") < 0) |
|
|
5842 return tree_constant (); |
|
|
5843 if (range_max_check (0, tree_to_mat_idx (rj.max ()), nr, nc) < 0) |
|
|
5844 return tree_constant (); |
|
|
5845 retval = do_matrix_index (magic_colon, rj); |
|
|
5846 } |
|
|
5847 } |
|
|
5848 break; |
|
|
5849 case magic_colon: |
|
|
5850 retval = do_matrix_index (magic_colon, magic_colon); |
|
|
5851 break; |
|
|
5852 default: |
|
|
5853 panic_impossible (); |
|
|
5854 break; |
|
|
5855 } |
|
|
5856 |
|
|
5857 return retval; |
|
|
5858 } |
|
|
5859 |
|
|
5860 tree_constant |
|
|
5861 tree_constant_rep::do_matrix_index (int i, int j) const |
|
|
5862 { |
|
|
5863 tree_constant retval; |
|
|
5864 |
|
|
5865 if (type_tag == matrix_constant) |
|
|
5866 retval = tree_constant (matrix->elem (i, j)); |
|
|
5867 else |
|
|
5868 retval = tree_constant (complex_matrix->elem (i, j)); |
|
|
5869 |
|
|
5870 return retval; |
|
|
5871 } |
|
|
5872 |
|
|
5873 tree_constant |
|
|
5874 tree_constant_rep::do_matrix_index (int i, const idx_vector& jv) const |
|
|
5875 { |
|
|
5876 tree_constant retval; |
|
|
5877 |
|
|
5878 int jlen = jv.capacity (); |
|
|
5879 |
|
|
5880 CRMATRIX (m, cm, 1, jlen); |
|
|
5881 |
|
|
5882 for (int j = 0; j < jlen; j++) |
|
|
5883 { |
|
|
5884 int col = jv.elem (j); |
|
|
5885 CRMATRIX_ASSIGN_REP_ELEM (m, cm, 0, j, i, col); |
|
|
5886 } |
|
|
5887 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
5888 |
|
|
5889 return retval; |
|
|
5890 } |
|
|
5891 |
|
|
5892 tree_constant |
|
|
5893 tree_constant_rep::do_matrix_index (int i, const Range& rj) const |
|
|
5894 { |
|
|
5895 tree_constant retval; |
|
|
5896 |
|
|
5897 int jlen = rj.nelem (); |
|
|
5898 |
|
|
5899 CRMATRIX (m, cm, 1, jlen); |
|
|
5900 |
|
|
5901 double b = rj.base (); |
|
|
5902 double increment = rj.inc (); |
|
|
5903 for (int j = 0; j < jlen; j++) |
|
|
5904 { |
|
|
5905 double tmp = b + j * increment; |
|
|
5906 int col = tree_to_mat_idx (tmp); |
|
|
5907 CRMATRIX_ASSIGN_REP_ELEM (m, cm, 0, j, i, col); |
|
|
5908 } |
|
|
5909 |
|
|
5910 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
5911 |
|
|
5912 return retval; |
|
|
5913 } |
|
|
5914 |
|
|
5915 tree_constant |
|
|
5916 tree_constant_rep::do_matrix_index |
|
|
5917 (int i, tree_constant_rep::constant_type mcj) const |
|
|
5918 { |
|
|
5919 assert (mcj == magic_colon); |
|
|
5920 |
|
|
5921 tree_constant retval; |
|
|
5922 |
|
|
5923 int nc = columns (); |
|
|
5924 |
|
|
5925 CRMATRIX (m, cm, 1, nc); |
|
|
5926 |
|
|
5927 for (int j = 0; j < nc; j++) |
|
|
5928 { |
|
|
5929 CRMATRIX_ASSIGN_REP_ELEM (m, cm, 0, j, i, j); |
|
|
5930 } |
|
|
5931 |
|
|
5932 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
5933 |
|
|
5934 return retval; |
|
|
5935 } |
|
|
5936 |
|
|
5937 tree_constant |
|
|
5938 tree_constant_rep::do_matrix_index (const idx_vector& iv, int j) const |
|
|
5939 { |
|
|
5940 tree_constant retval; |
|
|
5941 |
|
|
5942 int ilen = iv.capacity (); |
|
|
5943 |
|
|
5944 CRMATRIX (m, cm, ilen, 1); |
|
|
5945 |
|
|
5946 for (int i = 0; i < ilen; i++) |
|
|
5947 { |
|
|
5948 int row = iv.elem (i); |
|
|
5949 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, 0, row, j); |
|
|
5950 } |
|
|
5951 |
|
|
5952 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
5953 |
|
|
5954 return retval; |
|
|
5955 } |
|
|
5956 |
|
|
5957 tree_constant |
|
|
5958 tree_constant_rep::do_matrix_index (const idx_vector& iv, |
|
|
5959 const idx_vector& jv) const |
|
|
5960 { |
|
|
5961 tree_constant retval; |
|
|
5962 |
|
|
5963 int ilen = iv.capacity (); |
|
|
5964 int jlen = jv.capacity (); |
|
|
5965 |
|
|
5966 CRMATRIX (m, cm, ilen, jlen); |
|
|
5967 |
|
|
5968 for (int i = 0; i < ilen; i++) |
|
|
5969 { |
|
|
5970 int row = iv.elem (i); |
|
|
5971 for (int j = 0; j < jlen; j++) |
|
|
5972 { |
|
|
5973 int col = jv.elem (j); |
|
|
5974 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, col); |
|
|
5975 } |
|
|
5976 } |
|
|
5977 |
|
|
5978 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
5979 |
|
|
5980 return retval; |
|
|
5981 } |
|
|
5982 |
|
|
5983 tree_constant |
|
|
5984 tree_constant_rep::do_matrix_index (const idx_vector& iv, |
|
|
5985 const Range& rj) const |
|
|
5986 { |
|
|
5987 tree_constant retval; |
|
|
5988 |
|
|
5989 int ilen = iv.capacity (); |
|
|
5990 int jlen = rj.nelem (); |
|
|
5991 |
|
|
5992 CRMATRIX (m, cm, ilen, jlen); |
|
|
5993 |
|
|
5994 double b = rj.base (); |
|
|
5995 double increment = rj.inc (); |
|
|
5996 |
|
|
5997 for (int i = 0; i < ilen; i++) |
|
|
5998 { |
|
|
5999 int row = iv.elem (i); |
|
|
6000 for (int j = 0; j < jlen; j++) |
|
|
6001 { |
|
|
6002 double tmp = b + j * increment; |
|
|
6003 int col = tree_to_mat_idx (tmp); |
|
|
6004 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, col); |
|
|
6005 } |
|
|
6006 } |
|
|
6007 |
|
|
6008 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
6009 |
|
|
6010 return retval; |
|
|
6011 } |
|
|
6012 |
|
|
6013 tree_constant |
|
|
6014 tree_constant_rep::do_matrix_index |
|
|
6015 (const idx_vector& iv, tree_constant_rep::constant_type mcj) const |
|
|
6016 { |
|
|
6017 assert (mcj == magic_colon); |
|
|
6018 |
|
|
6019 tree_constant retval; |
|
|
6020 |
|
|
6021 int nc = columns (); |
|
|
6022 int ilen = iv.capacity (); |
|
|
6023 |
|
|
6024 CRMATRIX (m, cm, ilen, nc); |
|
|
6025 |
|
|
6026 for (int j = 0; j < nc; j++) |
|
|
6027 { |
|
|
6028 for (int i = 0; i < ilen; i++) |
|
|
6029 { |
|
|
6030 int row = iv.elem (i); |
|
|
6031 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, j); |
|
|
6032 } |
|
|
6033 } |
|
|
6034 |
|
|
6035 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
6036 |
|
|
6037 return retval; |
|
|
6038 } |
|
|
6039 |
|
|
6040 tree_constant |
|
|
6041 tree_constant_rep::do_matrix_index (const Range& ri, int j) const |
|
|
6042 { |
|
|
6043 tree_constant retval; |
|
|
6044 |
|
|
6045 int ilen = ri.nelem (); |
|
|
6046 |
|
|
6047 CRMATRIX (m, cm, ilen, 1); |
|
|
6048 |
|
|
6049 double b = ri.base (); |
|
|
6050 double increment = ri.inc (); |
|
|
6051 for (int i = 0; i < ilen; i++) |
|
|
6052 { |
|
|
6053 double tmp = b + i * increment; |
|
|
6054 int row = tree_to_mat_idx (tmp); |
|
|
6055 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, 0, row, j); |
|
|
6056 } |
|
|
6057 |
|
|
6058 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
6059 |
|
|
6060 return retval; |
|
|
6061 } |
|
|
6062 |
|
|
6063 tree_constant |
|
|
6064 tree_constant_rep::do_matrix_index (const Range& ri, |
|
|
6065 const idx_vector& jv) const |
|
|
6066 { |
|
|
6067 tree_constant retval; |
|
|
6068 |
|
|
6069 int ilen = ri.nelem (); |
|
|
6070 int jlen = jv.capacity (); |
|
|
6071 |
|
|
6072 CRMATRIX (m, cm, ilen, jlen); |
|
|
6073 |
|
|
6074 double b = ri.base (); |
|
|
6075 double increment = ri.inc (); |
|
|
6076 for (int i = 0; i < ilen; i++) |
|
|
6077 { |
|
|
6078 double tmp = b + i * increment; |
|
|
6079 int row = tree_to_mat_idx (tmp); |
|
|
6080 for (int j = 0; j < jlen; j++) |
|
|
6081 { |
|
|
6082 int col = jv.elem (j); |
|
|
6083 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, col); |
|
|
6084 } |
|
|
6085 } |
|
|
6086 |
|
|
6087 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
6088 |
|
|
6089 return retval; |
|
|
6090 } |
|
|
6091 |
|
|
6092 tree_constant |
|
|
6093 tree_constant_rep::do_matrix_index (const Range& ri, const Range& rj) const |
|
|
6094 { |
|
|
6095 tree_constant retval; |
|
|
6096 |
|
|
6097 int ilen = ri.nelem (); |
|
|
6098 int jlen = rj.nelem (); |
|
|
6099 |
|
|
6100 CRMATRIX (m, cm, ilen, jlen); |
|
|
6101 |
|
|
6102 double ib = ri.base (); |
|
|
6103 double iinc = ri.inc (); |
|
|
6104 double jb = rj.base (); |
|
|
6105 double jinc = rj.inc (); |
|
|
6106 |
|
|
6107 for (int i = 0; i < ilen; i++) |
|
|
6108 { |
|
|
6109 double itmp = ib + i * iinc; |
|
|
6110 int row = tree_to_mat_idx (itmp); |
|
|
6111 for (int j = 0; j < jlen; j++) |
|
|
6112 { |
|
|
6113 double jtmp = jb + j * jinc; |
|
|
6114 int col = tree_to_mat_idx (jtmp); |
|
|
6115 |
|
|
6116 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, col); |
|
|
6117 } |
|
|
6118 } |
|
|
6119 |
|
|
6120 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
6121 |
|
|
6122 return retval; |
|
|
6123 } |
|
|
6124 |
|
|
6125 tree_constant |
|
|
6126 tree_constant_rep::do_matrix_index |
|
|
6127 (const Range& ri, tree_constant_rep::constant_type mcj) const |
|
|
6128 { |
|
|
6129 assert (mcj == magic_colon); |
|
|
6130 |
|
|
6131 tree_constant retval; |
|
|
6132 |
|
|
6133 int nc = columns (); |
|
|
6134 |
|
|
6135 int ilen = ri.nelem (); |
|
|
6136 |
|
|
6137 CRMATRIX (m, cm, ilen, nc); |
|
|
6138 |
|
|
6139 double ib = ri.base (); |
|
|
6140 double iinc = ri.inc (); |
|
|
6141 |
|
|
6142 for (int i = 0; i < ilen; i++) |
|
|
6143 { |
|
|
6144 double itmp = ib + i * iinc; |
|
|
6145 int row = tree_to_mat_idx (itmp); |
|
|
6146 for (int j = 0; j < nc; j++) |
|
|
6147 { |
|
|
6148 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, j); |
|
|
6149 } |
|
|
6150 } |
|
|
6151 |
|
|
6152 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
6153 |
|
|
6154 return retval; |
|
|
6155 } |
|
|
6156 |
|
|
6157 tree_constant |
|
|
6158 tree_constant_rep::do_matrix_index (tree_constant_rep::constant_type mci, |
|
|
6159 int j) const |
|
|
6160 { |
|
|
6161 assert (mci == magic_colon); |
|
|
6162 |
|
|
6163 tree_constant retval; |
|
|
6164 |
|
|
6165 int nr = rows (); |
|
|
6166 |
|
|
6167 CRMATRIX (m, cm, nr, 1); |
|
|
6168 |
|
|
6169 for (int i = 0; i < nr; i++) |
|
|
6170 { |
|
|
6171 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, 0, i, j); |
|
|
6172 } |
|
|
6173 |
|
|
6174 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
6175 |
|
|
6176 return retval; |
|
|
6177 } |
|
|
6178 |
|
|
6179 tree_constant |
|
|
6180 tree_constant_rep::do_matrix_index (tree_constant_rep::constant_type mci, |
|
|
6181 const idx_vector& jv) const |
|
|
6182 { |
|
|
6183 assert (mci == magic_colon); |
|
|
6184 |
|
|
6185 tree_constant retval; |
|
|
6186 |
|
|
6187 int nr = rows (); |
|
|
6188 int jlen = jv.capacity (); |
|
|
6189 |
|
|
6190 CRMATRIX (m, cm, nr, jlen); |
|
|
6191 |
|
|
6192 for (int i = 0; i < nr; i++) |
|
|
6193 { |
|
|
6194 for (int j = 0; j < jlen; j++) |
|
|
6195 { |
|
|
6196 int col = jv.elem (j); |
|
|
6197 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, i, col); |
|
|
6198 } |
|
|
6199 } |
|
|
6200 |
|
|
6201 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
6202 |
|
|
6203 return retval; |
|
|
6204 } |
|
|
6205 |
|
|
6206 tree_constant |
|
|
6207 tree_constant_rep::do_matrix_index (tree_constant_rep::constant_type mci, |
|
|
6208 const Range& rj) const |
|
|
6209 { |
|
|
6210 assert (mci == magic_colon); |
|
|
6211 |
|
|
6212 tree_constant retval; |
|
|
6213 |
|
|
6214 int nr = rows (); |
|
|
6215 int jlen = rj.nelem (); |
|
|
6216 |
|
|
6217 CRMATRIX (m, cm, nr, jlen); |
|
|
6218 |
|
|
6219 double jb = rj.base (); |
|
|
6220 double jinc = rj.inc (); |
|
|
6221 |
|
|
6222 for (int j = 0; j < jlen; j++) |
|
|
6223 { |
|
|
6224 double jtmp = jb + j * jinc; |
|
|
6225 int col = tree_to_mat_idx (jtmp); |
|
|
6226 for (int i = 0; i < nr; i++) |
|
|
6227 { |
|
|
6228 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, i, col); |
|
|
6229 } |
|
|
6230 } |
|
|
6231 |
|
|
6232 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
6233 |
|
|
6234 return retval; |
|
|
6235 } |
|
|
6236 |
|
|
6237 tree_constant |
|
|
6238 tree_constant_rep::do_matrix_index (tree_constant_rep::constant_type mci, |
|
|
6239 tree_constant_rep::constant_type mcj) const |
|
|
6240 { |
|
529
|
6241 tree_constant retval; |
|
492
|
6242 assert (mci == magic_colon && mcj == magic_colon); |
|
529
|
6243 retval = tree_constant (*this); |
|
|
6244 return retval; |
|
492
|
6245 } |
|
|
6246 |
|
|
6247 tree_constant |
|
|
6248 tree_constant_rep::do_matrix_index |
|
|
6249 (tree_constant_rep::constant_type mci) const |
|
|
6250 { |
|
|
6251 assert (mci == magic_colon); |
|
|
6252 |
|
|
6253 tree_constant retval; |
|
|
6254 int nr = rows (); |
|
|
6255 int nc = columns (); |
|
|
6256 int size = nr * nc; |
|
|
6257 if (size > 0) |
|
|
6258 { |
|
|
6259 CRMATRIX (m, cm, size, 1); |
|
|
6260 int idx = 0; |
|
|
6261 for (int j = 0; j < nc; j++) |
|
|
6262 for (int i = 0; i < nr; i++) |
|
|
6263 { |
|
|
6264 CRMATRIX_ASSIGN_REP_ELEM (m, cm, idx, 0, i, j); |
|
|
6265 idx++; |
|
|
6266 } |
|
|
6267 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
6268 } |
|
|
6269 return retval; |
|
|
6270 } |
|
|
6271 |
|
|
6272 /* |
|
|
6273 ;;; Local Variables: *** |
|
|
6274 ;;; mode: C++ *** |
|
|
6275 ;;; page-delimiter: "^/\\*" *** |
|
|
6276 ;;; End: *** |
|
|
6277 */ |
