| 1 | #!/usr/local/perl -w |
1 | |
| 2 | BEGIN { |
2 | BEGIN { |
| 3 | be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix. |
3 | be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix. |
| 4 | |
4 | |
| 5 | } |
5 | } |
| 6 | package Matrix; |
6 | package Matrix; |
| 7 | @Matrix::ISA = qw(MatrixReal1); |
7 | @Matrix::ISA = qw(MatrixReal1); |
| 8 | |
8 | |
| 9 | |
9 | |
| 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 | sub _stringify |
13 | sub _stringify |
| 14 | { |
14 | { |
| 15 | my($object,$argument,$flag) = @_; |
15 | my($object,$argument,$flag) = @_; |
| 16 | # my($name) = '""'; #&_trace($name,$object,$argument,$flag); |
16 | # my($name) = '""'; #&_trace($name,$object,$argument,$flag); |
| 17 | my($rows,$cols) = ($object->[1],$object->[2]); |
17 | my($rows,$cols) = ($object->[1],$object->[2]); |
| 18 | my($i,$j,$s); |
18 | my($i,$j,$s); |
| 19 | |
19 | |
| 20 | $s = ''; |
20 | $s = ''; |
| 21 | for ( $i = 0; $i < $rows; $i++ ) |
21 | for ( $i = 0; $i < $rows; $i++ ) |
| 22 | { |
22 | { |
| 23 | $s .= "[ "; |
23 | $s .= "[ "; |
| 24 | for ( $j = 0; $j < $cols; $j++ ) |
24 | for ( $j = 0; $j < $cols; $j++ ) |
| 25 | { |
25 | { |
| 26 | my $format = (defined($object->rh_options->{display_format})) |
26 | my $format = (defined($object->rh_options->{display_format})) |
| 27 | ? $object->[3]->{display_format} : |
27 | ? $object->[3]->{display_format} : |
| 28 | $Matrix::DEFAULT_FORMAT; |
28 | $Matrix::DEFAULT_FORMAT; |
| 29 | $s .= sprintf($Matrix::DEFAULT_FORMAT, $object->[0][$i][$j]); |
29 | $s .= sprintf($Matrix::DEFAULT_FORMAT, $object->[0][$i][$j]); |
| 30 | } |
30 | } |
| 31 | $s .= "]\n"; |
31 | $s .= "]\n"; |
| 32 | } |
32 | } |
| … | |
… | |
| 104 | $matrix; |
104 | $matrix; |
| 105 | } |
105 | } |
| 106 | sub proj{ |
106 | sub proj{ |
| 107 | my $self = shift; |
107 | my $self = shift; |
| 108 | my ($vec) = @_; |
108 | my ($vec) = @_; |
| 109 | $self * $self ->proj_coeff($vec); |
109 | $self * $self ->proj_coeff($vec); |
| 110 | } |
110 | } |
| 111 | sub proj_coeff{ |
111 | sub proj_coeff{ |
| 112 | my $self= shift; |
112 | my $self= shift; |
| 113 | my ($vec) = @_; |
113 | my ($vec) = @_; |
| 114 | warn 'The vector must be of type Matrix',ref($vec),"|" unless ref($vec) eq 'Matrix'; |
114 | warn 'The vector must be of type Matrix',ref($vec),"|" unless ref($vec) eq 'Matrix'; |
| 115 | my $lin_space_tr= ~ $self; |
115 | my $lin_space_tr= ~ $self; |
| … | |
… | |
| 123 | sub new_column_matrix { |
123 | sub new_column_matrix { |
| 124 | my $class = shift; |
124 | my $class = shift; |
| 125 | my $vec = shift; |
125 | my $vec = shift; |
| 126 | warn "The argument to assign column must be a reference to an array" unless ref($vec) =~/ARRAY/; |
126 | warn "The argument to assign column must be a reference to an array" unless ref($vec) =~/ARRAY/; |
| 127 | my $cols = 1; |
127 | my $cols = 1; |
| 128 | my $rows = @{$vec}; |
128 | my $rows = @{$vec}; |
| 129 | my $matrix = new Matrix($rows,1); |
129 | my $matrix = new Matrix($rows,1); |
| 130 | foreach my $i (1..$rows) { |
130 | foreach my $i (1..$rows) { |
| 131 | $matrix->assign($i,1,$vec->[$i-1]); |
131 | $matrix->assign($i,1,$vec->[$i-1]); |
| 132 | } |
132 | } |
| 133 | $matrix; |
133 | $matrix; |
| 134 | } |
134 | } |
| 135 | =head4 |
135 | =head4 |
| 136 | |
136 | |
| 137 | This method takes an array of column vectors, or an array of arrays, |
137 | 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 |
138 | and converts them to a matrix where each column is one of the previous |
| 139 | vectors. |
139 | vectors. |
| 140 | |
140 | |
| 141 | =cut |
141 | =cut |
| 142 | |
142 | |
| 143 | sub new_from_col_vecs |
143 | sub new_from_col_vecs |
| 144 | { |
144 | { |
| 145 | my $class = shift; |
145 | my $class = shift; |
| 146 | my($vecs) = shift; |
146 | my($vecs) = shift; |
| 147 | my($rows,$cols); |
147 | my($rows,$cols); |
| 148 | |
148 | |
| 149 | if(ref($vecs->[0])eq 'Matrix' ){ |
149 | if(ref($vecs->[0])eq 'Matrix' ){ |
| 150 | ($rows,$cols) = (scalar($vecs->[0]->[1]),scalar(@$vecs)); |
150 | ($rows,$cols) = (scalar($vecs->[0]->[1]),scalar(@$vecs)); |
| 151 | }else{ |
151 | }else{ |
| 152 | ($rows,$cols) = (scalar(@{$vecs->[0]}),scalar(@$vecs)); |
152 | ($rows,$cols) = (scalar(@{$vecs->[0]}),scalar(@$vecs)); |
| 153 | } |
153 | } |
| 154 | |
154 | |
| 155 | my($i,$j); |
155 | my($i,$j); |
| 156 | my $matrix = Matrix->new($rows,$cols); |
156 | my $matrix = Matrix->new($rows,$cols); |
| 157 | |
157 | |
| 158 | if(ref($vecs->[0])eq 'Matrix' ){ |
158 | if(ref($vecs->[0])eq 'Matrix' ){ |
| 159 | for ( $i = 0; $i < $cols; $i++ ) |
159 | for ( $i = 0; $i < $cols; $i++ ) |
| 160 | { |
160 | { |
| 161 | for( $j = 0; $j < $rows; $j++ ) |
161 | for( $j = 0; $j < $rows; $j++ ) |
| 162 | { |
162 | { |
| … | |
… | |
| 171 | $matrix->[0][$j][$i] = $vecs->[$i]->[$j]; |
171 | $matrix->[0][$j][$i] = $vecs->[$i]->[$j]; |
| 172 | } |
172 | } |
| 173 | } |
173 | } |
| 174 | } |
174 | } |
| 175 | return($matrix); |
175 | return($matrix); |
| 176 | } |
176 | } |
| 177 | |
177 | |
| 178 | 1; |
178 | 1; |
Parent Directory
| 
Revision Log
| 
Patch