View of /trunk/webwork/system/courseScripts/Matrix.pm

    1 #!/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 }