[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 1050 - (view) (download) (as text)

1 : sh002i 1050 #!/usr/local/perl -w
2 :     BEGIN {
3 :     be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
4 :    
5 :     }
6 :     package Matrix;
7 :     @Matrix::ISA = qw(MatrixReal1);
8 :    
9 :    
10 :    
11 :     $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 :    
20 :     $s = '';
21 :     for ( $i = 0; $i < $rows; $i++ )
22 :     {
23 :     $s .= "[ ";
24 :     for ( $j = 0; $j < $cols; $j++ )
25 :     {
26 :     my $format = (defined($object->rh_options->{display_format}))
27 :     ? $object->[3]->{display_format} :
28 :     $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 :     warn "Can't take trace of non-square matrix " unless $rows = $cols;
49 :     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 :     $self * $self ->proj_coeff($vec);
110 :     }
111 :     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 :     my $rows = @{$vec};
129 :     my $matrix = new Matrix($rows,1);
130 :     foreach my $i (1..$rows) {
131 :     $matrix->assign($i,1,$vec->[$i-1]);
132 :     }
133 :     $matrix;
134 :     }

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9