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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1079 - (view) (download) (as text)

1 : apizer 1079
2 : sh002i 1050 BEGIN {
3 :     be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
4 : apizer 1079
5 : sh002i 1050 }
6 :     package Matrix;
7 :     @Matrix::ISA = qw(MatrixReal1);
8 :    
9 :    
10 : apizer 1079
11 : sh002i 1050 $Matrix::DEFAULT_FORMAT = '% #-19.12E ';
12 :     # allows specification of the format
13 :     sub _stringify
14 :     {
15 :     my($object,$argument,$flag) = @_;
16 :     # my($name) = '""'; #&_trace($name,$object,$argument,$flag);
17 :     my($rows,$cols) = ($object->[1],$object->[2]);
18 :     my($i,$j,$s);
19 : apizer 1079
20 : sh002i 1050 $s = '';
21 :     for ( $i = 0; $i < $rows; $i++ )
22 :     {
23 :     $s .= "[ ";
24 :     for ( $j = 0; $j < $cols; $j++ )
25 :     {
26 : apizer 1079 my $format = (defined($object->rh_options->{display_format}))
27 :     ? $object->[3]->{display_format} :
28 : sh002i 1050 $Matrix::DEFAULT_FORMAT;
29 :     $s .= sprintf($Matrix::DEFAULT_FORMAT, $object->[0][$i][$j]);
30 :     }
31 :     $s .= "]\n";
32 :     }
33 :     return($s);
34 :     }
35 :    
36 :     sub rh_options {
37 :     my $self = shift;
38 :     my $last_element = $#$self;
39 :     $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
41 :     }
42 :    
43 :    
44 :     sub trace {
45 :     my $self = shift;
46 :     my $rows = $self->[1];
47 :     my $cols = $self->[2];
48 : gage 1070 warn "Can't take trace of non-square matrix " unless $rows == $cols;
49 : sh002i 1050 my $sum = 0;
50 :     for( my $i = 0; $i<$rows;$i++) {
51 :     $sum +=$self->[0][$i][$i];
52 :     }
53 :     $sum;
54 :     }
55 :     sub new_from_array_ref { # this will build a matrix or a row vector from [a, b, c, ]
56 :     my $class = shift;
57 :     my $array = shift;
58 :     my $rows = @$array;
59 :     my $cols = @{$array->[0]};
60 :     my $matrix = new Matrix($rows,$cols);
61 :     $matrix->[0]=$array;
62 :     $matrix;
63 :     }
64 :    
65 :     sub array_ref {
66 :     my $this = shift;
67 :     $this->[0];
68 :     }
69 :    
70 :     sub list { # this is used only for column vectors
71 :     my $self = shift;
72 :     my @list = ();
73 :     warn "This only works with column vectors" unless $self->[2] == 1;
74 :     my $rows = $self->[1];
75 :     for(my $i=1; $i<=$rows; $i++) {
76 :     push(@list, $self->element($i,1) );
77 :     }
78 :     @list;
79 :     }
80 :     sub new_from_list { # this builds a row vector from an array
81 :     my $class = shift;
82 :     my @list = @_;
83 :     my $cols = @list;
84 :     my $rows = 1;
85 :     my $matrix = new Matrix($rows, $cols);
86 :     my $i=1;
87 :     while(@list) {
88 :     my $elem = shift(@list);
89 :     $matrix->assign($i++,1, $elem);
90 :     }
91 :     $matrix;
92 :     }
93 :     sub new_row_matrix { # this builds a row vector from an array
94 :     my $class = shift;
95 :     my @list = @_;
96 :     my $cols = @list;
97 :     my $rows = 1;
98 :     my $matrix = new Matrix($rows, $cols);
99 :     my $i=1;
100 :     while(@list) {
101 :     my $elem = shift(@list);
102 :     $matrix->assign($i++,1, $elem);
103 :     }
104 :     $matrix;
105 :     }
106 :     sub proj{
107 :     my $self = shift;
108 :     my ($vec) = @_;
109 : apizer 1079 $self * $self ->proj_coeff($vec);
110 :     }
111 : sh002i 1050 sub proj_coeff{
112 :     my $self= shift;
113 :     my ($vec) = @_;
114 :     warn 'The vector must be of type Matrix',ref($vec),"|" unless ref($vec) eq 'Matrix';
115 :     my $lin_space_tr= ~ $self;
116 :     my $matrix = $lin_space_tr * $self;
117 :     $vec = $lin_space_tr*$vec;
118 :     my $matrix_lr = $matrix->decompose_LR;
119 :     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.
121 :     $x_vector;
122 :     }
123 :     sub new_column_matrix {
124 :     my $class = shift;
125 :     my $vec = shift;
126 :     warn "The argument to assign column must be a reference to an array" unless ref($vec) =~/ARRAY/;
127 :     my $cols = 1;
128 : apizer 1079 my $rows = @{$vec};
129 : sh002i 1050 my $matrix = new Matrix($rows,1);
130 :     foreach my $i (1..$rows) {
131 :     $matrix->assign($i,1,$vec->[$i-1]);
132 :     }
133 : gage 1070 $matrix;
134 :     }
135 :     =head4
136 :    
137 :     This method takes an array of column vectors, or an array of arrays,
138 : apizer 1079 and converts them to a matrix where each column is one of the previous
139 : gage 1070 vectors.
140 :    
141 :     =cut
142 :    
143 :     sub new_from_col_vecs
144 :     {
145 :     my $class = shift;
146 :     my($vecs) = shift;
147 :     my($rows,$cols);
148 : apizer 1079
149 : gage 1070 if(ref($vecs->[0])eq 'Matrix' ){
150 :     ($rows,$cols) = (scalar($vecs->[0]->[1]),scalar(@$vecs));
151 :     }else{
152 :     ($rows,$cols) = (scalar(@{$vecs->[0]}),scalar(@$vecs));
153 :     }
154 : apizer 1079
155 : gage 1070 my($i,$j);
156 : apizer 1079 my $matrix = Matrix->new($rows,$cols);
157 :    
158 : gage 1070 if(ref($vecs->[0])eq 'Matrix' ){
159 :     for ( $i = 0; $i < $cols; $i++ )
160 :     {
161 :     for( $j = 0; $j < $rows; $j++ )
162 :     {
163 :     $matrix->[0][$j][$i] = $vecs->[$i][0][$j][0];
164 :     }
165 :     }
166 :     }else{
167 :     for ( $i = 0; $i < $cols; $i++ )
168 :     {
169 :     for( $j = 0; $j < $rows; $j++ )
170 :     {
171 :     $matrix->[0][$j][$i] = $vecs->[$i]->[$j];
172 :     }
173 :     }
174 :     }
175 :     return($matrix);
176 : apizer 1079 }
177 : gage 1070
178 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9