[system] / trunk / pg / macros / PGmorematrixmacros.pl Repository:
ViewVC logotype

View of /trunk/pg/macros/PGmorematrixmacros.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1080 - (download) (as text) (annotate)
Mon Jun 9 17:49:36 2003 UTC (16 years, 8 months ago) by apizer
File size: 15993 byte(s)
remove unneccsary shebang lines

Arnie

    1 
    2 
    3 BEGIN{
    4   be_strict();
    5 }
    6 
    7 sub _PGmorematrixmacros_init{}
    8 
    9 sub random_inv_matrix { ## Builds and returns a random invertible \$row by \$col matrix.
   10 
   11     warn "Usage: \$new_matrix = random_inv_matrix(\$rows,\$cols)"
   12       if (@_ != 2);
   13     my $A = new Matrix($_[0],$_[1]);
   14     my $A_lr = new Matrix($_[0],$_[1]);
   15     my $det = 0;
   16     my $safety=0;
   17     while ($det == 0 and $safety < 6) {
   18         foreach my $i (1..$_[0]) {
   19             foreach my $j (1..$_[1]) {
   20                 $A->assign($i,$j,random(-9,9,1) );
   21                 }
   22             }
   23             $A_lr = $A->decompose_LR();
   24             $det = $A_lr->det_LR();
   25         }
   26     return $A;
   27 }
   28 
   29 sub swap_rows{
   30 
   31     warn "Usage: \$new_matrix = swap_rows(\$matrix,\$row1,\$row2);"
   32       if (@_ != 3);
   33     my $matrix = $_[0];
   34     my ($i,$j) = ($_[1],$_[2]);
   35     warn "Error:  Rows to be swapped must exist!"
   36       if ($i>@$matrix or $j >@$matrix);
   37     warn "Warning:  Swapping the same row is pointless"
   38       if ($i==$j);
   39     my $cols = @{$matrix->[0]};
   40     my $B = new Matrix(@$matrix,$cols);
   41     foreach my $k (1..$cols){
   42         $B->assign($i,$k,element $matrix($j,$k));
   43         $B->assign($j,$k,element $matrix($i,$k));
   44     }
   45     return $B;
   46 }
   47 
   48 sub row_mult{
   49 
   50     warn "Usage: \$new_matrix = row_mult(\$matrix,\$scalar,\$row);"
   51       if (@_ != 3);
   52     my $matrix = $_[0];
   53     my ($scalar,$row) = ($_[1],$_[2]);
   54     warn "Undefined row multiplication"
   55       if ($row > @$matrix);
   56     my $B = new Matrix(@$matrix,@{$matrix->[0]});
   57     foreach my $j (1..@{$matrix->[0]}) {
   58         $B->assign($row,$j,$scalar*element $matrix($row,$j));
   59     }
   60     return $B;
   61 }
   62 
   63 sub linear_combo{
   64 
   65     warn "Usage: \$new_matrix = linear_combo(\$matrix,\$scalar,\$row1,\$row2);"
   66       if (@_ != 4);
   67     my $matrix = $_[0];
   68     my ($scalar,$row1,$row2) = ($_[1],$_[2],$_[3]);
   69     warn "Undefined row in multiplication"
   70       if ($row1>@$matrix or $row2>@$matrix);
   71     warn "Warning:  Using the same row"
   72       if ($row1==$row2);
   73     my $B = new Matrix(@$matrix,@{$matrix->[0]});
   74     foreach my $j (1..@$matrix) {
   75         my ($t1,$t2) = (element $matrix($row1,$j),element $matrix($row2,$j));
   76         $B->assign($row2,$j,$scalar*$t1+$t2);
   77     }
   78     return $B;
   79 }
   80 
   81 =head3 basis_cmp()
   82 
   83 Compares a list of vectors by finding the change of coordinate matrix
   84 from the Prof's vectors to the students, and then taking the determinant of
   85 that to determine the existence of the change of coordinate matrix going the
   86 other way.
   87 
   88 ANS( basis_cmp( vectors_as_array_ref_in_array_ref, options_hash ) );
   89 
   90   1. a reference to an array of correct vectors
   91   2. a hash with the following keys (all optional):
   92     mode      --  'basis' (default) (only a basis allowed)
   93               'orthogonal' (only an orthogonal basis is allowed)
   94               'unit' (only unit vectors in the basis allowed)
   95               'orthonormal' (only orthogonal unit vectors in basis allowed)
   96     zeroLevelTol  --  absolute tolerance to allow when answer is close
   97                  to zero
   98 
   99     debug     --  if set to 1, provides verbose listing of
  100                 hash entries throughout fliters.
  101 
  102     help    --  'none' (default) (is quiet on all errors)
  103           'dim' (Tells student if wrong number of vectors are entered)
  104           'length' (Tells student if there is a vector of the wrong length)
  105           'orthogonal' (Tells student if their vectors are not orthogonal)
  106               (This is only in orthogonal mode)
  107           'unit' (Tells student if there is a vector not of unit length)
  108               (This is only in unit mode)
  109           'orthonormal' (Gives errors from orthogonal and orthonormal)
  110               (This is only in orthonormal mode)
  111           'verbose' (Gives all the above answer messages)
  112 
  113   Returns an answer evaluator.
  114 
  115 EXAMPLES:
  116 
  117   basis_cmp([[1,0,0],[0,1,0],[0,0,1]])
  118                   --  correct answer is any basis for R^3.
  119   basis_cmp([1,0,2,0],[0,1,0,0], 'mode'=>orthonormal )
  120                   --  correct answer is any orthonormal basis
  121                     for this space such as:
  122                     [1/sqrt(3),0,2/sqrt(3),0],[0,1,0,0]
  123 
  124 =cut
  125 
  126 
  127 sub basis_cmp {
  128   my $correctAnswer = shift;
  129   my %opt = @_;
  130 
  131   set_default_options(  \%opt,
  132         'zeroLevelTol'        =>  $main::functZeroLevelTolDefault,
  133               'debug'         =>  0,
  134         'mode'          =>  'basis',
  135         'help'          =>  'none',
  136       );
  137 
  138   # produce answer evaluator
  139   BASIS_CMP(
  140         'correct_ans'     =>  $correctAnswer,
  141         'zeroLevelTol'      =>  $opt{'zeroLevelTol'},
  142         'debug'       =>  $opt{'debug'},
  143         'mode'        =>  $opt{'mode'},
  144         'help'        =>  $opt{'help'},
  145   );
  146 }
  147 
  148 =head BASIS_CMP
  149 
  150 Made to keep the same format as num_cmp and fun_cmp.
  151 
  152 =cut
  153 
  154 sub BASIS_CMP {
  155   my %mat_params = @_;
  156   my $zeroLevelTol        = $mat_params{'zeroLevelTol'};
  157 
  158   # Check that everything is defined:
  159   $mat_params{debug} = 0 unless defined($mat_params{debug});
  160   $zeroLevelTol = $main::functZeroLevelTolDefault     unless defined $zeroLevelTol;
  161   $mat_params{'zeroLevelTol'}       =   $zeroLevelTol;
  162 
  163 ## This is where the correct answer should be checked someday.
  164   my $matrix          = Matrix->new_from_col_vecs($mat_params{'correct_ans'});
  165 
  166 #construct the answer evaluator
  167   my $answer_evaluator = new AnswerEvaluator;
  168 
  169       $answer_evaluator->{debug} = $mat_params{debug};
  170 
  171       $answer_evaluator->ans_hash(  correct_ans     =>  pretty_print($mat_params{correct_ans}),
  172           rm_correct_ans    =>  $matrix,
  173           zeroLevelTol    =>  $mat_params{zeroLevelTol},
  174           debug     =>  $mat_params{debug},
  175           mode      =>  $mat_params{mode},
  176           help      =>  $mat_params{help},
  177       );
  178 
  179   $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
  180     $rh_ans->{student_ans} =~ s/\s+//g;   # remove all whitespace
  181     $rh_ans;
  182   });
  183 
  184   $answer_evaluator->install_pre_filter(\&math_constants);
  185   $answer_evaluator->install_pre_filter(\&vec_list_string);#ra_student_ans is now the students answer as an array of vectors
  186   # anonymous subroutine to check dimension and length of the student vectors
  187   # if either is wrong, the answer is wrong.
  188   $answer_evaluator->install_pre_filter(sub{
  189     my $rh_ans = shift;
  190     my $length = $rh_ans->{rm_correct_ans}->[1];
  191     my $dim = $rh_ans->{rm_correct_ans}->[2];
  192     if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
  193     {
  194 
  195       $rh_ans->{score} = 0;
  196       if( $rh_ans->{help} =~ /dim|verbose/ )
  197       {
  198         $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
  199       }else{
  200         $rh_ans->throw_error('EVAL');
  201       }
  202     }
  203     for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ )
  204     {
  205       if( $length != $rh_ans->{ra_student_ans}->[$i]->[1])
  206       {
  207         $rh_ans->{score} = 0;
  208         if( $rh_ans->{help} =~ /length|verbose/ )
  209         {
  210           $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
  211         }else{
  212           $rh_ans->throw_error('EVAL');
  213         }
  214       }
  215     }
  216     $rh_ans;
  217   });
  218   # Install prefilter for various modes
  219   if( $mat_params{mode} ne 'basis' )
  220   {
  221     if( $mat_params{mode} =~ /orthogonal|orthonormal/ )
  222     {
  223       $answer_evaluator->install_pre_filter(sub{
  224         my $rh_ans = shift;
  225         my @vecs = @{$rh_ans->{ra_student_ans}};
  226         my ($i,$j) = (0,0);
  227         my $num = scalar(@vecs);
  228         my $length = $vecs[0]->[1];
  229 
  230         for( ; $i < $num ; $i ++ )
  231         {
  232           for( $j = $i+1; $j < $num ; $j++ )
  233           {
  234             my $sum = 0;
  235             my $k = 0;
  236 
  237             for( ; $k < $length; $k++ ) {
  238               $sum += $vecs[$i]->[0][$k][0]*$vecs[$j]->[0][$k][0];
  239             }
  240 
  241             if( $sum > $mat_params{zeroLevelTol} )
  242             {
  243               $rh_ans->{score} = 0;
  244               if( $rh_ans->{help} =~ /orthogonal|orthonormal|verbose/ )
  245               {
  246                 $rh_ans->throw_error('EVAL','You have entered vectors which are not orthogonal. ');
  247               }else{
  248                 $rh_ans->throw_error('EVAL');
  249               }
  250             }
  251           }
  252         }
  253 
  254 
  255         $rh_ans;
  256       });
  257     }
  258 
  259     if( $mat_params{mode} =~ /unit|orthonormal/ )
  260     {
  261       $answer_evaluator->install_pre_filter(sub{
  262         my $rh_ans = shift;
  263         my @vecs = @{$rh_ans->{ra_student_ans}};
  264         my $i = 0;
  265         my $num = scalar(@vecs);
  266         my $length = $vecs[0]->[1];
  267 
  268         for( ; $i < $num ; $i ++ )
  269         {
  270           my $sum = 0;
  271           my $k = 0;
  272 
  273           for( ; $k < $length; $k++ ) {
  274             $sum += $vecs[$i]->[0][$k][0]*$vecs[$i]->[0][$k][0];
  275           }
  276           if( abs(sqrt($sum) - 1) > $mat_params{zeroLevelTol} )
  277           {
  278             $rh_ans->{score} = 0;
  279 
  280             if( $rh_ans->{help} =~ /unit|orthonormal|verbose/ )
  281             {
  282               $rh_ans->throw_error('EVAL','You have entered vector(s) which are not of unit length.');
  283             }else{
  284               $rh_ans->throw_error('EVAL');
  285             }
  286           }
  287         }
  288 
  289 
  290         $rh_ans;
  291       });
  292 
  293     }
  294   }
  295       $answer_evaluator->install_evaluator(\&compare_basis, %mat_params);
  296   $answer_evaluator->install_post_filter(
  297     sub {my $rh_ans = shift;
  298         if ($rh_ans->catch_error('SYNTAX') ) {
  299           $rh_ans->{ans_message} = $rh_ans->{error_message};
  300           $rh_ans->clear_error('SYNTAX');
  301         }
  302         if ($rh_ans->catch_error('EVAL') ) {
  303           $rh_ans->{ans_message} = $rh_ans->{error_message};
  304           $rh_ans->clear_error('EVAL');
  305         }
  306         $rh_ans;
  307     }
  308   );
  309   $answer_evaluator;
  310 }
  311 
  312 =head4 compare_basis
  313 
  314   compare_basis( $ans_hash, %options);
  315 
  316                 {ra_student_ans},     # a reference to the array of students answer vectors
  317                                {rm_correct_ans},      # a reference to the correct answer matrix
  318                                %options
  319                               )
  320 
  321 =cut
  322 
  323 sub compare_basis {
  324   my ($rh_ans, %options) = @_;
  325   my @ch_coord;
  326   my @vecs = @{$rh_ans->{ra_student_ans}};
  327 
  328   # A lot of the follosing code was taken from Matrix::proj_coeff
  329   # calling this method recursively would be a waste of time since
  330   # the prof's matrix never changes and solve_LR is an expensive
  331   # operation. This way it is only done once.
  332   my $matrix = $rh_ans->{rm_correct_ans};
  333   my ($dim,$x_vector, $base_matrix);
  334   my $errors = undef;
  335   my $lin_space_tr= ~ $matrix;
  336   $matrix = $lin_space_tr * $matrix;
  337   my $matrix_lr = $matrix->decompose_LR();
  338 
  339   #finds the coefficient vectors for each of the students vectors
  340   for( my $i = 0; $i < scalar(@{$rh_ans->{ra_student_ans}}) ; $i++ )
  341   {
  342 
  343     $vecs[$i] = $lin_space_tr*$vecs[$i];
  344     ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($vecs[$i]);
  345     push( @ch_coord, $x_vector );
  346     $errors = "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.
  347   }
  348 
  349   if( defined($errors))
  350   {
  351     $rh_ans->throw_error('EVAL', $errors) ;
  352   }else{
  353     my $ch_coord_mat = Matrix->new_from_col_vecs(\@ch_coord);#creates change of coordinate matrix
  354                   #existence of this matrix implies that
  355                   #the all of the students answers are a
  356                   #linear combo of the prof's
  357     $ch_coord_mat = $ch_coord_mat->decompose_LR();
  358 
  359     if( $ch_coord_mat->det_LR() > $options{zeroLevelTol} )# if the det of the change of coordinate matrix is
  360                   # non-zero, this implies the existence of an inverse
  361                   # which implies all of the prof's vectors are a linear
  362                   # combo of the students vectors, showing containment
  363                   # both ways.
  364     {
  365       # I think sometimes if the students space has the same dimension as the profs space it
  366       # will get projected into the profs space even if it isn't a basis for that space.
  367       # this just checks that the prof's matrix times the change of coordinate matrix is actually
  368       #the students matrix
  369       if(  abs(Matrix->new_from_col_vecs(\@{$rh_ans->{ra_student_ans}}) - ($rh_ans->{rm_correct_ans})*(Matrix->new_from_col_vecs(\@ch_coord))) < $options{zeroLevelTol} )
  370       {
  371         $rh_ans->{score} = 1;
  372       }else{
  373         $rh_ans->{score} = 0;
  374       }
  375     }
  376     else{
  377       $rh_ans->{score}=0;
  378     }
  379   }
  380   $rh_ans;
  381 
  382 }
  383 
  384 
  385 =head 2 vec_list_string
  386 
  387 This is a check_syntax type method (in fact I borrowed some of that method's code) for vector input.
  388 The student needs to enter vectors like:        [1,0,0],[1,2,3],[0,9/sqrt(10),1/sqrt(10)]
  389 Each entry can contain functions and operations and the usual math constants (pi and e).
  390 The vectors, however can not be added or multiplied or scalar multiplied by the student.
  391 Most errors are handled well. Any error in an entry is caught by the PG_answer_eval like it is in num_cmp or fun_cmp.
  392 Right now the method basically ignores every thing outside the vectors. Also, an unmatched open parenthesis is caught,
  393 but a unmatched close parenthesis ends the vector, and since everything outside is ignored, no error is sent (other than the
  394 later when the length of the vectors is checked.
  395 In the end, the method returns an array of Matrix objects.
  396 
  397 
  398 =cut
  399 
  400 sub vec_list_string{
  401   my $rh_ans = shift;
  402   my %options = @_;
  403   my $i;
  404   my $entry = "";
  405   my $char;
  406   my @paren_stack;
  407   my $length = length($rh_ans->{student_ans});
  408   my @temp;
  409   my $j = 0;
  410   my @answers;
  411   my $paren;
  412   my $display_ans;
  413 
  414   for( $i = 0; $i < $length ; $i++ )
  415   {
  416     $char = substr($rh_ans->{student_ans},$i,1);
  417 
  418     if( $char =~ /\(|\[|\{/ ){
  419         push( @paren_stack, $char )
  420     }
  421 
  422     if( !( $char =~ /\(|\[|\{/ && scalar(@paren_stack) == 1 ) )
  423     {
  424       if( $char !~ /,|\)|\]|\}/ ){
  425         $entry .= $char;
  426       }else{
  427         if( $char =~ /,/ || ( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1 ) )
  428         {
  429           if( length($entry) == 0 ){
  430             if( $char !~ /,/ ){
  431               $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
  432             }else{
  433                 $rh_ans->{preview_text_string}   .= ",";
  434                 $rh_ans->{preview_latex_string}  .= ",";
  435                 $display_ans .= ",";
  436             }
  437           }else{
  438 
  439             # This parser code was origianally taken from PGanswermacros::check_syntax
  440             # but parts of it needed to be slighty modified for this context
  441             my $parser = new AlgParserWithImplicitExpand;
  442             my $ret = $parser -> parse($entry);     #for use with loops
  443 
  444             if ( ref($ret) )  {   ## parsed successfully
  445               $parser -> tostring();
  446               $parser -> normalize();
  447               $entry = $parser -> tostring();
  448               $rh_ans->{preview_text_string} .= $entry.",";
  449               $rh_ans->{preview_latex_string} .=  $parser -> tolatex().",";
  450 
  451             } else {          ## error in parsing
  452 
  453               $rh_ans->{'student_ans'}      = 'syntax error:'.$display_ans. $parser->{htmlerror},
  454               $rh_ans->{'ans_message'}      = $display_ans.$parser -> {error_msg},
  455               $rh_ans->{'preview_text_string'}  = '',
  456               $rh_ans->{'preview_latex_string'} = '',
  457               $rh_ans->throw_error('SYNTAX',  'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
  458             }
  459 
  460             my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
  461 
  462             if ($PG_eval_errors) {
  463               $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
  464               $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
  465               last;
  466             } else {
  467               $entry = prfmt($inVal,$options{format});
  468               $display_ans .= $entry.",";
  469               push(@temp , $entry);
  470             }
  471 
  472             if( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1)
  473             {
  474               pop @paren_stack;
  475               chop($rh_ans->{preview_text_string});
  476               chop($rh_ans->{preview_latex_string});
  477               chop($display_ans);
  478               $rh_ans->{preview_text_string} .= "]";
  479               $rh_ans->{preview_latex_string} .= "]";
  480               $display_ans .= "]";
  481               if( scalar(@temp) > 0 )
  482               {
  483                 push( @answers,Matrix->new_from_col_vecs([\@temp]));
  484                 while(scalar(@temp) > 0 ){
  485                   pop @temp;
  486                 }
  487               }else{
  488                 $rh_ans->throw_error('EVAL','There is a syntax error in your answer.');
  489               }
  490             }
  491           }
  492           $entry = "";
  493         }else{
  494           $paren = pop @paren_stack;
  495           if( scalar(@paren_stack) > 0 ){
  496             #this uses ASCII to check if the parens match up
  497             # in ASCII ord ( = 40 , ord ) = 41 , ord [ = 91 ,
  498             # ord ] = 93 , ord { = 123 , ord } = 125
  499             if( (ord($char) - ord($paren) <= 2) ){
  500               $entry = $entry . $char;
  501             }else{
  502               $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
  503             }
  504           }
  505         }
  506       }
  507     }else{
  508       $rh_ans->{preview_text_string}   .= "[";
  509       $rh_ans->{preview_latex_string}  .= "[";
  510       $display_ans .= "[";
  511     }
  512   }
  513   $rh_ans->{ra_student_ans} = \@answers;
  514   $rh_ans->{student_ans} = $display_ans unless $rh_ans->{error_flag};
  515   $rh_ans;
  516 }
  517 
  518 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9