[system] / trunk / pg / lib / Matrix.pm Repository:
ViewVC logotype

Diff of /trunk/pg/lib/Matrix.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 3359 Revision 3360
… …
8 8
9use Carp; 9use Carp;
10 10
11$Matrix::DEFAULT_FORMAT = '% #-19.12E '; 11$Matrix::DEFAULT_FORMAT = '% #-19.12E ';
12# allows specification of the format 12# allows specification of the format
13
14=head4
15
16 Method $matrix->_stringify()
17 -- overrides MatrixReal1 display mode
18
19=cut
20
21
13sub _stringify 22sub _stringify
14{ 23{
15 my($object,$argument,$flag) = @_; 24 my($object,$argument,$flag) = @_;
16# my($name) = '""'; #&_trace($name,$object,$argument,$flag); 25# my($name) = '""'; #&_trace($name,$object,$argument,$flag);
17 my($rows,$cols) = ($object->[1],$object->[2]); 26 my($rows,$cols) = ($object->[1],$object->[2]);
… …
31 $s .= "]\n"; 40 $s .= "]\n";
32 } 41 }
33 return($s); 42 return($s);
34} 43}
35 44
45=head4
46
47 Method $matrix->rh_options
48
49=cut
50
36sub rh_options { 51sub rh_options {
37 my $self = shift; 52 my $self = shift;
38 my $last_element = $#$self; 53 my $last_element = $#$self;
39 $self->[$last_element] = {} unless defined($self->[3]); # not sure why this needs to be done 54 $self->[$last_element] = {} unless defined($self->[3]); # not sure why this needs to be done
40 $self->[$last_element]; # provides a reference to the options hash MEG 55 $self->[$last_element]; # provides a reference to the options hash MEG
41} 56}
42 57
58=head4
59
60 Method $matrix->trace
61
62 Returns: scalar which is the trace of the matrix.
63
64=cut
43 65
44sub trace { 66sub trace {
45 my $self = shift; 67 my $self = shift;
46 my $rows = $self->[1]; 68 my $rows = $self->[1];
47 my $cols = $self->[2]; 69 my $cols = $self->[2];
… …
50 for( my $i = 0; $i<$rows;$i++) { 72 for( my $i = 0; $i<$rows;$i++) {
51 $sum +=$self->[0][$i][$i]; 73 $sum +=$self->[0][$i][$i];
52 } 74 }
53 $sum; 75 $sum;
54} 76}
77
78=head4
79
80 Method $matrix->new_from_array_ref
81
82=cut
83
55sub new_from_array_ref { # this will build a matrix or a row vector from [a, b, c, ] 84sub new_from_array_ref { # this will build a matrix or a row vector from [a, b, c, ]
56 my $class = shift; 85 my $class = shift;
57 my $array = shift; 86 my $array = shift;
58 my $rows = @$array; 87 my $rows = @$array;
59 my $cols = @{$array->[0]}; 88 my $cols = @{$array->[0]};
60 my $matrix = new Matrix($rows,$cols); 89 my $matrix = new Matrix($rows,$cols);
61 $matrix->[0]=$array; 90 $matrix->[0]=$array;
62 $matrix; 91 $matrix;
63} 92}
64 93
94=head4
95
96 Method $matrix->array_ref
97
98=cut
99
65sub array_ref { 100sub array_ref {
66 my $this = shift; 101 my $this = shift;
67 $this->[0]; 102 $this->[0];
68} 103}
104
105=head4
106
107 Method $matrix->list
108
109=cut
69 110
70sub list { # this is used only for column vectors 111sub list { # this is used only for column vectors
71 my $self = shift; 112 my $self = shift;
72 my @list = (); 113 my @list = ();
73 warn "This only works with column vectors" unless $self->[2] == 1; 114 warn "This only works with column vectors" unless $self->[2] == 1;
… …
75 for(my $i=1; $i<=$rows; $i++) { 116 for(my $i=1; $i<=$rows; $i++) {
76 push(@list, $self->element($i,1) ); 117 push(@list, $self->element($i,1) );
77 } 118 }
78 @list; 119 @list;
79} 120}
121
122=head4
123
124 Method $matrix->new_from_list
125
126=cut
127
80sub new_from_list { # this builds a row vector from an array 128sub new_from_list { # this builds a row vector from an array
81 my $class = shift; 129 my $class = shift;
82 my @list = @_; 130 my @list = @_;
83 my $cols = @list; 131 my $cols = @list;
84 my $rows = 1; 132 my $rows = 1;
… …
88 my $elem = shift(@list); 136 my $elem = shift(@list);
89 $matrix->assign($i++,1, $elem); 137 $matrix->assign($i++,1, $elem);
90 } 138 }
91 $matrix; 139 $matrix;
92} 140}
141
142=head4
143
144 Method $matrix->new_row_matrix
145
146=cut
147
93sub new_row_matrix { # this builds a row vector from an array 148sub new_row_matrix { # this builds a row vector from an array
94 my $class = shift; 149 my $class = shift;
95 my @list = @_; 150 my @list = @_;
96 my $cols = @list; 151 my $cols = @list;
97 my $rows = 1; 152 my $rows = 1;
… …
101 my $elem = shift(@list); 156 my $elem = shift(@list);
102 $matrix->assign($i++,1, $elem); 157 $matrix->assign($i++,1, $elem);
103 } 158 }
104 $matrix; 159 $matrix;
105} 160}
161
162=head4
163
164 Method $matrix->proj
165
166=cut
167
106sub proj{ 168sub proj{
107 my $self = shift; 169 my $self = shift;
108 my ($vec) = @_; 170 my ($vec) = @_;
109 $self * $self ->proj_coeff($vec); 171 $self * $self ->proj_coeff($vec);
110} 172}
173
174=head4
175
176 Method $matrix->proj_coeff
177
178=cut
179
111sub proj_coeff{ 180sub proj_coeff{
112 my $self= shift; 181 my $self= shift;
113 my ($vec) = @_; 182 my ($vec) = @_;
114 warn 'The vector must be of type Matrix',ref($vec),"|" unless ref($vec) eq 'Matrix'; 183 warn 'The vector must be of type Matrix',ref($vec),"|" unless ref($vec) eq 'Matrix';
115 my $lin_space_tr= ~ $self; 184 my $lin_space_tr= ~ $self;
… …
118 my $matrix_lr = $matrix->decompose_LR; 187 my $matrix_lr = $matrix->decompose_LR;
119 my ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($vec); 188 my ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($vec);
120 warn "A unique adapted answer could not be determined. Possibly the parameters have coefficient zero.<br> dim = $dim base_matrix is $base_matrix\n" if $dim; # only print if the dim is not zero. 189 warn "A unique adapted answer could not be determined. Possibly the parameters have coefficient zero.<br> dim = $dim base_matrix is $base_matrix\n" if $dim; # only print if the dim is not zero.
121 $x_vector; 190 $x_vector;
122} 191}
192
193=head4
194
195 Method $matrix->new_column_matrix
196
197=cut
198
123sub new_column_matrix { 199sub new_column_matrix {
124 my $class = shift; 200 my $class = shift;
125 my $vec = shift; 201 my $vec = shift;
126 warn "The argument to assign column must be a reference to an array" unless ref($vec) =~/ARRAY/; 202 warn "The argument to assign column must be a reference to an array" unless ref($vec) =~/ARRAY/;
127 my $cols = 1; 203 my $cols = 1;
… …
130 foreach my $i (1..$rows) { 206 foreach my $i (1..$rows) {
131 $matrix->assign($i,1,$vec->[$i-1]); 207 $matrix->assign($i,1,$vec->[$i-1]);
132 } 208 }
133 $matrix; 209 $matrix;
134} 210}
211
135=head4 212=head4
136 213
137 This method takes an array of column vectors, or an array of arrays, 214 This method takes an array of column vectors, or an array of arrays,
138 and converts them to a matrix where each column is one of the previous 215 and converts them to a matrix where each column is one of the previous
139 vectors. 216 vectors.
217
218 Method $matrix->new_from_col_vecs
140 219
141=cut 220=cut
142 221
143sub new_from_col_vecs 222sub new_from_col_vecs
144{ 223{
… …
177 256
178###################################################################### 257######################################################################
179# Modifications to MatrixReal.pm which allow use of complex entries 258# Modifications to MatrixReal.pm which allow use of complex entries
180###################################################################### 259######################################################################
181 260
261=head3
262
263 Overrides of MatrixReal which allow use of complex entries
264
265=cut
266
267=head4
268
269 Method $matrix->new_from_col_vecs
270
271=cut
272
182sub cp { # MEG makes new copies of complex number 273sub cp { # MEG makes new copies of complex number
183 my $z = shift; 274 my $z = shift;
184 return $z unless ref($z); 275 return $z unless ref($z);
185 my $w = Complex1::cplx($z->Re,$z->Im); 276 my $w = Complex1::cplx($z->Re,$z->Im);
186 return $w; 277 return $w;
187} 278}
279
280=head4
281
282 Method $matrix->copy
283
284=cut
285
188sub copy 286sub copy
189{ 287{
190 croak "Usage: \$matrix1->copy(\$matrix2);" 288 croak "Usage: \$matrix1->copy(\$matrix2);"
191 if (@_ != 2); 289 if (@_ != 2);
192 290
… …
219 } 317 }
220} 318}
221################################################################### 319###################################################################
222 320
223# MEG added 6/25/03 to accomodate complex entries 321# MEG added 6/25/03 to accomodate complex entries
322
323=head4
324
325 Method $matrix->conj
326
327=cut
328
224sub conj { 329sub conj {
225 my $elem = shift; 330 my $elem = shift;
226 $elem = (ref($elem)) ? ($elem->conjugate) : $elem; 331 $elem = (ref($elem)) ? ($elem->conjugate) : $elem;
227 $elem; 332 $elem;
228} 333}
334
335=head4
336
337 Method $matrix->transpose
338
339=cut
340
229sub transpose 341sub transpose
230{ 342{
231 croak "Usage: \$matrix1->transpose(\$matrix2);" 343 croak "Usage: \$matrix1->transpose(\$matrix2);"
232 if (@_ != 2); 344 if (@_ != 2);
233 345
… …
267 } 379 }
268 } 380 }
269 $matrix1; 381 $matrix1;
270} 382}
271 383
384=head4
272 385
386 Method $matrix->decompose_LR
387
388=cut
273 389
274sub decompose_LR 390sub decompose_LR
275{ 391{
276 croak "Usage: \$LR_matrix = \$matrix->decompose_LR();" 392 croak "Usage: \$LR_matrix = \$matrix->decompose_LR();"
277 if (@_ != 1); 393 if (@_ != 1);
… …
283# my($i,$j,$k,$n); #MEG 399# my($i,$j,$k,$n); #MEG
284 my($i,$j,$k,); 400 my($i,$j,$k,);
285 my($sign) = 1; 401 my($sign) = 1;
286 my($swap); 402 my($swap);
287 my($temp); 403 my($temp);
288# Why won't this work on non-square matrices? 404# FIXEME Why won't this work on non-square matrices?
289# croak "MatrixReal1::decompose_LR(): matrix is not quadratic" 405# croak "MatrixReal1::decompose_LR(): matrix is not quadratic"
290# unless ($rows == $cols); 406# unless ($rows == $cols);
291 croak "MatrixReal1::decompose_LR(): matrix has more rows than columns" 407 croak "MatrixReal1::decompose_LR(): matrix has more rows than columns"
292 unless ($rows <= $cols); 408 unless ($rows <= $cols);
293 409
Legend:
Removed from v.3359  
changed lines
  Added in v.3360
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9