[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 6817 - (download) (as text) (annotate)
Fri May 20 02:22:16 2011 UTC (8 years, 8 months ago) by gage
File size: 36370 byte(s)
fix the coloring of matrices.  Still not completely satisfactory since only the
first element in a matrix or vector is colored.  Required that we replace the colons
in the labels with - since apparently colons are not allowed in css ids. (they worked
for HTML but not for this.)


    1 
    2 BEGIN{
    3     be_strict();
    4 }
    5 # set the prefix used for arrays.
    6 our $ArRaY = $main::PG->{ARRAY_PREFIX};
    7 
    8 sub _PGmorematrixmacros_init{}
    9 
   10 sub random_inv_matrix { ## Builds and returns a random invertible \$row by \$col matrix.
   11 
   12     warn "Usage: \$new_matrix = random_inv_matrix(\$rows,\$cols)"
   13       if (@_ != 2);
   14     my $A = new Matrix($_[0],$_[1]);
   15     my $A_lr = new Matrix($_[0],$_[1]);
   16     my $det = 0;
   17     my $safety=0;
   18     while ($det == 0 and $safety < 6) {
   19         foreach my $i (1..$_[0]) {
   20             foreach my $j (1..$_[1]) {
   21                 $A->assign($i,$j,random(-9,9,1) );
   22                 }
   23             }
   24             $A_lr = $A->decompose_LR();
   25             $det = $A_lr->det_LR();
   26         }
   27     return $A;
   28 }
   29 
   30 =head4 random_diag_matrix
   31 
   32 This method returns a random nxn diagonal matrix.
   33 
   34 =cut
   35 
   36 sub random_diag_matrix{ ## Builds and returns a random diagonal \$n by \$n matrix
   37 
   38     warn "Usage: \$new_matrix = random_diag_matrix(\$n)" if (@_ != 1);
   39 
   40     my $D = new Matrix($_[0],$_[0]);
   41     my $norm = 0;
   42     while( $norm == 0 ){
   43         foreach my $i (1..$_[0]){
   44             foreach my $j (1..$_[0]){
   45                 if( $i != $j ){
   46                     $D->assign($i,$j,0);
   47                 }else{
   48                     $D->assign($i,$j,random(-9,9,1));
   49                 }
   50             }
   51         }
   52         $norm = abs($D);
   53     }
   54     return $D;
   55 }
   56 
   57 sub swap_rows{
   58 
   59     warn "Usage: \$new_matrix = swap_rows(\$matrix,\$row1,\$row2);"
   60       if (@_ != 3);
   61     my $matrix = $_[0];
   62     my ($i,$j) = ($_[1],$_[2]);
   63     warn "Error:  Rows to be swapped must exist!"
   64       if ($i>@$matrix or $j >@$matrix);
   65     warn "Warning:  Swapping the same row is pointless"
   66       if ($i==$j);
   67     my $cols = @{$matrix->[0]};
   68     my $B = new Matrix(@$matrix,$cols);
   69     foreach my $k (1..$cols){
   70         $B->assign($i,$k,element $matrix($j,$k));
   71         $B->assign($j,$k,element $matrix($i,$k));
   72     }
   73     return $B;
   74 }
   75 
   76 sub row_mult{
   77 
   78     warn "Usage: \$new_matrix = row_mult(\$matrix,\$scalar,\$row);"
   79       if (@_ != 3);
   80     my $matrix = $_[0];
   81     my ($scalar,$row) = ($_[1],$_[2]);
   82     warn "Undefined row multiplication"
   83       if ($row > @$matrix);
   84     my $B = new Matrix(@$matrix,@{$matrix->[0]});
   85     foreach my $j (1..@{$matrix->[0]}) {
   86         $B->assign($row,$j,$scalar*element $matrix($row,$j));
   87     }
   88     return $B;
   89 }
   90 
   91 sub linear_combo{
   92 
   93     warn "Usage: \$new_matrix = linear_combo(\$matrix,\$scalar,\$row1,\$row2);"
   94       if (@_ != 4);
   95     my $matrix = $_[0];
   96     my ($scalar,$row1,$row2) = ($_[1],$_[2],$_[3]);
   97     warn "Undefined row in multiplication"
   98       if ($row1>@$matrix or $row2>@$matrix);
   99     warn "Warning:  Using the same row"
  100       if ($row1==$row2);
  101     my $B = new Matrix(@$matrix,@{$matrix->[0]});
  102     foreach my $j (1..@$matrix) {
  103         my ($t1,$t2) = (element $matrix($row1,$j),element $matrix($row2,$j));
  104         $B->assign($row2,$j,$scalar*$t1+$t2);
  105     }
  106     return $B;
  107 }
  108 
  109 =head3 basis_cmp()
  110 
  111 Compares a list of vectors by finding the change of coordinate matrix
  112 from the Prof's vectors to the students, and then taking the determinant of
  113 that to determine the existence of the change of coordinate matrix going the
  114 other way.
  115 
  116 ANS( basis_cmp( vectors_as_array_ref_in_array_ref, options_hash ) );
  117 
  118     1. a reference to an array of correct vectors
  119     2. a hash with the following keys (all optional):
  120         mode            --  'basis' (default) (only a basis allowed)
  121                             'orthogonal' (only an orthogonal basis is allowed)
  122                             'unit' (only unit vectors in the basis allowed)
  123                             'orthonormal' (only orthogonal unit vectors in basis allowed)
  124         zeroLevelTol    --  absolute tolerance to allow when answer is close
  125                                  to zero
  126 
  127         debug           --  if set to 1, provides verbose listing of
  128                                 hash entries throughout fliters.
  129 
  130         help        --  'none' (default) (is quiet on all errors)
  131                     'dim' (Tells student if wrong number of vectors are entered)
  132                     'length' (Tells student if there is a vector of the wrong length)
  133                     'orthogonal' (Tells student if their vectors are not orthogonal)
  134                             (This is only in orthogonal mode)
  135                     'unit' (Tells student if there is a vector not of unit length)
  136                             (This is only in unit mode)
  137                     'orthonormal' (Gives errors from orthogonal and orthonormal)
  138                             (This is only in orthonormal mode)
  139                     'verbose' (Gives all the above answer messages)
  140 
  141     Returns an answer evaluator.
  142 
  143 EXAMPLES:
  144 
  145     basis_cmp([[1,0,0],[0,1,0],[0,0,1]])
  146                                     --  correct answer is any basis for R^3.
  147     basis_cmp([1,0,2,0],[0,1,0,0], 'mode'=>orthonormal )
  148                                     --  correct answer is any orthonormal basis
  149                                         for this space such as:
  150                                         [1/sqrt(3),0,2/sqrt(3),0],[0,1,0,0]
  151 
  152 =cut
  153 
  154 
  155 sub basis_cmp {
  156     my $correctAnswer = shift;
  157     my %opt = @_;
  158 
  159     set_default_options(    \%opt,
  160             'zeroLevelTol'          =>  $main::functZeroLevelTolDefault,
  161             'debug'                 =>  0,
  162             'mode'                  =>  'basis',
  163             'help'                  =>  'none',
  164     );
  165 
  166     # produce answer evaluator
  167     BASIS_CMP(
  168             'correct_ans'       =>  $correctAnswer,
  169             'zeroLevelTol'      =>  $opt{'zeroLevelTol'},
  170             'debug'             =>  $opt{'debug'},
  171             'mode'              =>  $opt{'mode'},
  172             'help'              =>  $opt{'help'},
  173     );
  174 }
  175 
  176 =head1 BASIS_CMP
  177 
  178 Made to keep the same format as num_cmp and fun_cmp.
  179 
  180 =cut
  181 
  182 sub BASIS_CMP {
  183     my %mat_params = @_;
  184     my $zeroLevelTol                =   $mat_params{'zeroLevelTol'};
  185 
  186     # Check that everything is defined:
  187     $mat_params{debug} = 0 unless defined($mat_params{debug});
  188     $zeroLevelTol = $main::functZeroLevelTolDefault         unless defined $zeroLevelTol;
  189     $mat_params{'zeroLevelTol'}             =   $zeroLevelTol;
  190 
  191 ## This is where the correct answer should be checked someday.
  192     my $matrix                  =   Matrix->new_from_col_vecs($mat_params{'correct_ans'});
  193 
  194 #construct the answer evaluator
  195     my $answer_evaluator = new AnswerEvaluator;
  196 
  197     $answer_evaluator->{debug} = $mat_params{debug};
  198     $answer_evaluator->ans_hash(
  199         correct_ans         =>  display_correct_vecs($mat_params{correct_ans}),
  200         rm_correct_ans      =>  $matrix,
  201         zeroLevelTol        =>  $mat_params{zeroLevelTol},
  202         debug               =>  $mat_params{debug},
  203         mode                =>  $mat_params{mode},
  204         help                =>  $mat_params{help},
  205     );
  206 
  207     $answer_evaluator->install_pre_filter(
  208         sub {my $rh_ans              = shift;
  209             $rh_ans->{_filter_name}  = 'remove_white_space';
  210             $rh_ans->{student_ans}   =~ s/\s+//g;       # remove all whitespace
  211             $rh_ans;
  212         }
  213     );
  214     $answer_evaluator->install_pre_filter(
  215         sub{my $rh_ans      = shift;
  216             my @options     = @_;
  217             $rh_ans->{_filter_name}  = 'mung_student_answer';
  218             if( $rh_ans->{ans_label} =~ /$ArRaY/ ){
  219                 $rh_ans           = ans_array_filter($rh_ans,@options);
  220                 my @student_array = @{$rh_ans->{ra_student_ans}};
  221                 my @array         = ();
  222                 for( my $i = 0; $i < scalar(@student_array) ; $i ++ )
  223                 {
  224                     push( @array, Matrix->new_from_array_ref($student_array[$i]));
  225                 }
  226                 $rh_ans->{ra_student_ans} = \@array;
  227                 $rh_ans;
  228             }else{
  229                 $rh_ans->{student_ans}    = math_constants($rh_ans->{student_ans});
  230                 vec_list_string($rh_ans, '_filter_name' => 'vec_list_string', @options);
  231             }
  232         }
  233     );#ra_student_ans is now the students answer as an array of vectors
  234     # anonymous subroutine to check dimension and length of the student vectors
  235     # if either is wrong, the answer is wrong.
  236     $answer_evaluator->install_pre_filter(
  237         sub{
  238             my $rh_ans               = shift;
  239             $rh_ans->{_filter_name}  = 'check_vector_size';
  240             my $length               = $rh_ans->{rm_correct_ans}->[1];
  241             my $dim                  = $rh_ans->{rm_correct_ans}->[2];
  242             if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
  243             {
  244 
  245                 $rh_ans->{score} = 0;
  246                 if( $rh_ans->{help} =~ /dim|verbose/ )
  247                 {
  248                     $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
  249                 }else{
  250                     $rh_ans->throw_error('EVAL');
  251                 }
  252             }
  253             for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ )
  254             {
  255                 if( $length != $rh_ans->{ra_student_ans}->[$i]->[1])
  256                 {
  257                     $rh_ans->{score} = 0;
  258                     if( $rh_ans->{help} =~ /length|verbose/ )
  259                     {
  260                         $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
  261                     }else{
  262                         $rh_ans->throw_error('EVAL');
  263                     }
  264                 }
  265             }
  266             $rh_ans;
  267         }
  268     );
  269     # Install prefilter for various modes
  270     if( $mat_params{mode} ne 'basis' )
  271     {
  272         if( $mat_params{mode} =~ /orthogonal|orthonormal/ )
  273         {
  274             $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
  275         }
  276 
  277         if( $mat_params{mode} =~ /unit|orthonormal/ )
  278         {
  279             $answer_evaluator->install_pre_filter(\&are_unit_vecs);
  280 
  281         }
  282     }
  283         $answer_evaluator->install_evaluator(\&compare_basis, %mat_params);
  284     $answer_evaluator->install_post_filter(
  285         sub {my $rh_ans = shift;
  286                 if ($rh_ans->catch_error('SYNTAX') ) {
  287                     $rh_ans->{ans_message} = $rh_ans->{error_message};
  288                     $rh_ans->clear_error('SYNTAX');
  289                 }
  290                 if ($rh_ans->catch_error('EVAL') ) {
  291                     $rh_ans->{ans_message} = $rh_ans->{error_message};
  292                     $rh_ans->clear_error('EVAL');
  293                 }
  294                 $rh_ans;
  295         }
  296     );
  297     $answer_evaluator;
  298 }
  299 
  300 =head4 compare_basis
  301 
  302     compare_basis( $ans_hash,
  303         %options
  304         ra_student_ans     # a reference to the array of students answer vectors
  305         rm_correct_ans,    # a reference to the correct answer matrix
  306         %options
  307     )
  308 
  309 
  310 =cut
  311 
  312 
  313 
  314 sub compare_basis {
  315     my ($rh_ans, %options) = @_;
  316     $rh_ans->{_filter_name} = "compare_basis";
  317     my @ch_coord;
  318     my @vecs = @{$rh_ans->{ra_student_ans}};
  319 
  320     # A lot of the following code was taken from Matrix::proj_coeff
  321     # calling this method recursively would be a waste of time since
  322     # the prof's matrix never changes and solve_LR is an expensive
  323     # operation. This way it is only done once.
  324     my $matrix = $rh_ans->{rm_correct_ans};
  325     my ($dim,$x_vector, $base_matrix);
  326     my $errors = undef;
  327     my $lin_space_tr= ~ $matrix; #transpose of the matrix
  328     $matrix = $lin_space_tr * $matrix;  #(~A * A)
  329     my $matrix_lr = $matrix->decompose_LR();
  330 
  331     #finds the coefficient vectors for each of the students vectors
  332     for( my $i = 0; $i < scalar(@{$rh_ans->{ra_student_ans}}) ; $i++ ) {
  333 
  334         $vecs[$i] = $lin_space_tr*$vecs[$i];
  335         ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($vecs[$i]);
  336         push( @ch_coord, $x_vector );
  337         $errors = "A unique adapted answer could not be determined.
  338         Possibly the parameters have coefficient zero.<br>  dim = $dim base_matrix
  339         is $base_matrix\n" if $dim;  # only print if the dim is not zero.
  340     }
  341 
  342     if( defined($errors)) {
  343         $rh_ans->throw_error('EVAL', $errors) ;
  344     } else {
  345         my $ch_coord_mat = Matrix->new_from_col_vecs(\@ch_coord);
  346             #creates change of coordinate matrix
  347             #existence of this matrix implies that
  348             #the all of the students answers are a
  349             #linear combo of the prof's
  350         $ch_coord_mat = $ch_coord_mat->decompose_LR();
  351 
  352         if( abs($ch_coord_mat->det_LR()) > $options{zeroLevelTol} ) {
  353             # if the det of the change of coordinate  matrix is
  354             # non-zero, this implies the existence of an inverse
  355             # which implies all of the prof's vectors are a linear
  356             # combo of the students vectors, showing containment
  357             # both ways.
  358 
  359             # I think sometimes if the students space has the same dimension as the profs space it
  360             # will get projected into the profs space even if it isn't a basis for that space.
  361             # this just checks that the prof's matrix times the change of coordinate matrix is actually
  362             #the students matrix
  363             if(  abs(Matrix->new_from_col_vecs(\@{$rh_ans->{ra_student_ans}}) -
  364                 ($rh_ans->{rm_correct_ans})*(Matrix->new_from_col_vecs(\@ch_coord)))
  365                 < $options{zeroLevelTol} ) {
  366                 $rh_ans->{score} = 1;
  367             } else {
  368                 $rh_ans->{score} = 0;
  369             }
  370         } else {
  371             $rh_ans->{score}=0;
  372         }
  373     }
  374     $rh_ans;
  375 
  376 }
  377 
  378 
  379 =head2 vec_list_string
  380 
  381 This is a check_syntax type method (in fact I borrowed some of that method's code) for vector input.
  382 The student needs to enter vectors like:        [1,0,0],[1,2,3],[0,9/sqrt(10),1/sqrt(10)]
  383 Each entry can contain functions and operations and the usual math constants (pi and e).
  384 The vectors, however can not be added or multiplied or scalar multiplied by the student.
  385 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.
  386 Right now the method basically ignores every thing outside the vectors. Also, an unmatched open parenthesis is caught,
  387 but a unmatched close parenthesis ends the vector, and since everything outside is ignored, no error is sent (other than the
  388 later when the length of the vectors is checked.
  389 In the end, the method returns an array of Matrix objects.
  390 
  391 =cut
  392 
  393 sub vec_list_string{
  394     my $rh_ans = shift;
  395     my %options = @_;
  396     my $i;
  397     my $entry = "";
  398     my $char;
  399     my @paren_stack;
  400     my $length = length($rh_ans->{student_ans});
  401     my @temp;
  402     my $j = 0;
  403     my @answers;
  404     my $paren;
  405     my $display_ans;
  406 
  407     for( $i = 0; $i < $length ; $i++ ) {
  408         $char = substr($rh_ans->{student_ans},$i,1);
  409 
  410         if( $char =~ /\(|\[|\{/ ){
  411                 push( @paren_stack, $char )
  412         }
  413 
  414         if( !( $char =~ /\(|\[|\{/ && scalar(@paren_stack) == 1 ) ) {
  415             if( $char !~ /,|\)|\]|\}/ ){
  416                 $entry .= $char;
  417             } else {
  418                 if( $char =~ /,/ || ( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1 ) ) {
  419                     if( length($entry) == 0 ){
  420                         if( $char !~ /,/ ){
  421                             $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
  422                         } else {
  423                                 $rh_ans->{preview_text_string}   .= ",";
  424                                 $rh_ans->{preview_latex_string}  .= ",";
  425                                 $display_ans .= ",";
  426                         }
  427                     } else {
  428 
  429                         # This parser code was origianally taken from PGanswermacros::check_syntax
  430                         # but parts of it needed to be slighty modified for this context
  431                         my $parser = new AlgParserWithImplicitExpand;
  432                         my $ret = $parser -> parse($entry);         #for use with loops
  433 
  434                         if ( ref($ret) )  {     ## parsed successfully
  435                             $parser -> tostring();
  436                             $parser -> normalize();
  437                             $entry = $parser -> tostring();
  438                             $rh_ans->{preview_text_string} .= $entry.",";
  439                             $rh_ans->{preview_latex_string} .=  $parser -> tolatex().",";
  440 
  441                         } else {                    ## error in parsing
  442 
  443                             $rh_ans->{'student_ans'}            =   'syntax error:'.$display_ans. $parser->{htmlerror},
  444                             $rh_ans->{'ans_message'}            =   $display_ans.$parser -> {error_msg},
  445                             $rh_ans->{'preview_text_string'}    =   '',
  446                             $rh_ans->{'preview_latex_string'}   =   '',
  447                             $rh_ans->throw_error('SYNTAX',  'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
  448                         }
  449 
  450                         my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
  451 
  452                         if ($PG_eval_errors) {
  453                             $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
  454                             $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
  455                             last;
  456                         } else {
  457                             $entry = prfmt($inVal,$options{format});
  458                             $display_ans .= $entry.",";
  459                             push(@temp , $entry);
  460                         }
  461 
  462                         if( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1) {
  463                             pop @paren_stack;
  464                             chop($rh_ans->{preview_text_string});
  465                             chop($rh_ans->{preview_latex_string});
  466                             chop($display_ans);
  467                             $rh_ans->{preview_text_string} .= "]";
  468                             $rh_ans->{preview_latex_string} .= "]";
  469                             $display_ans .= "]";
  470                             if( scalar(@temp) > 0 ) {
  471                                 push( @answers,Matrix->new_from_col_vecs([\@temp]));
  472                                 while(scalar(@temp) > 0 ){
  473                                     pop @temp;
  474                                 }
  475                             } else {
  476                                 $rh_ans->throw_error('EVAL','There is a syntax error in your answer.');
  477                             }
  478                         }
  479                     }
  480                     $entry = "";
  481                 } else {
  482                     $paren = pop @paren_stack;
  483                     if( scalar(@paren_stack) > 0 ){
  484                         #this uses ASCII to check if the parens match up
  485                         # in ASCII ord ( = 40 , ord ) = 41 , ord [ = 91 ,
  486                         # ord ] = 93 , ord { = 123 , ord } = 125
  487                         if( (ord($char) - ord($paren) <= 2) ){
  488                             $entry = $entry . $char;
  489                         }else{
  490                             $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
  491                         }
  492                     }
  493                 }
  494             }
  495         } else {
  496             $rh_ans->{preview_text_string}   .= "[";
  497             $rh_ans->{preview_latex_string}  .= "[";
  498             $display_ans .= "[";
  499         }
  500     }
  501     $rh_ans->{ra_student_ans} = \@answers;
  502     $rh_ans->{student_ans} = $display_ans unless $rh_ans->{error_flag};
  503     $rh_ans;
  504 }
  505 
  506 =head5 ans_array_filter
  507 
  508     This filter was created to get, format, and evaluate each entry of the ans_array and ans_array_extension
  509     answer entry methods. Running this filter is necessary to get all the entries out of the answer
  510     hash. Each entry is evaluated and the resulting number is put in the display for student answer
  511     as a string. For evaluation purposes an array of arrays of arrays is created called ra_student_ans
  512     and placed in the hash. The entries are [array_number][row_number][column_number]. The latex strings
  513     for each entry are taken from the parser and put, as a matrix, into the previewer. The preview text
  514     string is also created, but this display method becomes confusing when large matrices are used.
  515 
  516 =cut
  517 
  518 
  519 sub ans_array_filter{
  520     my $rh_ans = shift;
  521     my %options = @_;
  522 #   assign_option_aliases( \%opt,
  523 #     );
  524     set_default_options(\%options,
  525     _filter_name  =>  'ans_array_filter',
  526     );
  527 #   $rh_ans->{ans_label} =~ /$ArRaY(\d+)\[\d+,\d+,\d+\]/;  # CHANGE made to accomodate HTML 4.01 standards for name attribute
  528     $rh_ans->{ans_label} =~ /$ArRaY(\d+)\_\_\d+\-\d+\-\d+\_\_/;
  529     my $ans_num = $1;
  530     my @keys = grep /$ArRaY$ans_num/, keys(%{$main::inputs_ref});
  531     my $key;
  532     my @array = ();
  533     my ($i,$j,$k) = (0,0,0);
  534 
  535     #the keys aren't in order, so their info has to be put into the array before doing anything with it
  536     foreach $key (@keys){
  537 #       $key =~ /ArRaY\d+\[(\d+),(\d+),(\d+)\]/;
  538 #       ($i,$j,$k) = ($1,$2,$3);
  539 #       $array[$i][$j][$k] = ${$main::inputs_ref}{'ArRaY'.$ans_num.'['.$i.','.$j.','.$k.']'};
  540         $key =~ /$ArRaY\d+\_\_(\d+)\-(\d+)\-(\d+)\_\_/;
  541         ($i,$j,$k) = ($1,$2,$3);
  542         $array[$i][$j][$k] = ${$main::inputs_ref}{"$ArRaY".$ans_num.'__'.$i.'-'.$j.'-'.$k.'__'};
  543 
  544     }
  545     #$rh_ans->{debug_student_answer }=  \@array;
  546     my $display_ans = "";
  547 
  548     for( $i=0; $i < scalar(@array) ; $i ++ ) {
  549         $display_ans .= " [";
  550             $rh_ans->{preview_text_string} .= ' [';
  551             $rh_ans->{preview_latex_string} .= '\begin{pmatrix} ';
  552         for( $j = 0; $j < scalar( @{$array[$i]} ) ; $j++ ) {
  553             $display_ans .= " [";
  554                     $rh_ans->{preview_text_string} .= ' [';
  555                     for( $k = 0; $k < scalar( @{$array[$i][$j]} ) ; $k ++ ){
  556                 my $entry = $array[$i][$j][$k];
  557                 $entry = math_constants($entry);
  558                 # This parser code was origianally taken from PGanswermacros::check_syntax
  559                 # but parts of it needed to be slighty modified for this context
  560                 my $parser = new AlgParserWithImplicitExpand;
  561                 my $ret = $parser -> parse($entry);         #for use with loops
  562 
  563                 if ( ref($ret) )  {     ## parsed successfully
  564                     $parser -> tostring();
  565                     $parser -> normalize();
  566                     $entry = $parser -> tostring();
  567                     $rh_ans->{preview_text_string} .= $entry.",";
  568                     $rh_ans->{preview_latex_string} .= $parser -> tolatex() . '& ';
  569 
  570                 } else {                    ## error in parsing
  571                     $rh_ans->{'student_ans'}            =   'syntax error:'.$display_ans. $parser->{htmlerror},
  572                     $rh_ans->{'ans_message'}            =   $display_ans.$parser -> {error_msg},
  573                     $rh_ans->{'preview_text_string'}    =   '',
  574                     $rh_ans->throw_error('SYNTAX',  'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
  575                 }
  576 
  577                 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
  578                 if ($PG_eval_errors) {
  579                     $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
  580                     $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
  581                     last;
  582                 } else {
  583                     $entry = prfmt($inVal,$options{format});
  584                     $display_ans .= $entry.",";
  585                     $array[$i][$j][$k] = $entry;
  586                 }
  587             }
  588             chop($rh_ans->{preview_text_string});
  589             chop($display_ans);
  590                     $rh_ans->{preview_text_string} .= '] ,';
  591                    $rh_ans->{preview_latex_string} .= '\\\\';
  592             $display_ans .= '] ,';
  593 
  594         }
  595         chop($rh_ans->{preview_text_string});
  596         chop($display_ans);
  597                 $rh_ans->{preview_text_string} .= '] ,';
  598                 $rh_ans->{preview_latex_string} .= '\end{pmatrix}'.' , ';
  599         $display_ans .= '] ,';
  600     }
  601     chop($rh_ans->{preview_text_string});
  602     chop($rh_ans->{preview_latex_string});
  603     chop($rh_ans->{preview_latex_string});
  604     chop($rh_ans->{preview_latex_string});
  605     chop($display_ans);
  606 
  607     my @temp = ();
  608     for( $i = 0 ; $i < scalar( @array ); $i++ ){
  609         push @temp , display_matrix($array[$i], 'left'=>'.', 'right'=>'.');
  610         push @temp , "," unless $i == scalar(@array) - 1;
  611     }
  612     $rh_ans->{student_ans} = mbox(\@temp);
  613     $rh_ans->{ra_student_ans} = \@array;
  614 
  615     $rh_ans;
  616 
  617 }
  618 
  619 
  620 sub are_orthogonal_vecs{
  621     my ($vec_ref , %opts) = @_;
  622     $vec_ref->{_filter_name}  = 'are_orthogonal_vecs';
  623     my @vecs = ();
  624     if( ref($vec_ref) eq 'AnswerHash' )
  625     {
  626         @vecs = @{$vec_ref->{ra_student_ans}};
  627     }else{
  628         @vecs = @{$vec_ref};
  629     }
  630 
  631     my $num = scalar(@vecs);
  632     my $length = $vecs[0]->[1];
  633 
  634     for( my $i=0; $i < $num ; $i ++ ) {
  635         for( my $j = $i+1; $j < $num ; $j++ ) {
  636             if( $vecs[$i]->scalar_product($vecs[$j]) > $main::functZeroLevelTolDefault ) {
  637                 if( ref( $vec_ref ) eq 'AnswerHash' ){
  638                     $vec_ref->{score} = 0;
  639                     if( $vec_ref->{help} =~ /orthogonal|orthonormal|verbose/ )
  640                     {
  641                         $vec_ref->throw_error('EVAL','You have entered vectors which are not orthogonal. ');
  642                     }else{
  643                         $vec_ref->throw_error('EVAL');
  644                     }
  645                     return $vec_ref;
  646                 } else {
  647                     return 0;
  648                 }
  649             }
  650         }
  651     }
  652     if( ref( $vec_ref ) eq 'AnswerHash' ){
  653         $vec_ref->{score} = 1;
  654         $vec_ref;
  655     } else {
  656         1;
  657     }
  658 }
  659 
  660 sub is_diagonal{
  661     my $matrix  =   shift;
  662     my %options     =   @_;
  663     my $process_ans_hash = ( ref( $matrix ) eq 'AnswerHash' ) ? 1 : 0 ;
  664     my ($rh_ans);
  665     if ($process_ans_hash) {
  666         $rh_ans = $matrix;
  667         $matrix = $rh_ans->{ra_student_ans};
  668     }
  669 
  670     return 0 unless defined($matrix);
  671 
  672     if( ref($matrix) eq 'ARRAY' ) {
  673         my @matrix = @{$matrix};
  674         @matrix = @{$matrix[0]} if ref($matrix[0][0]) eq 'ARRAY';
  675         if( ref($matrix[0]) ne 'ARRAY' or scalar( @matrix ) != scalar( @{$matrix[0]} ) ){
  676             warn "It is impossible for a non-square matrix to be diagonal, if you are a student, please tell your professor that there is a problem.";
  677         }
  678 
  679         for( my $i = 0; $i < scalar( @matrix ) ; $i++ ) {
  680             for( my $j = 0; $j < scalar( @{$matrix[0]} ); $j++ ){
  681                 if( $matrix[$i][$j] != 0 and $i != $j )
  682                 {
  683                         if ($process_ans_hash){
  684                             $rh_ans->throw_error('EVAL');
  685                             return $rh_ans;
  686                         } else {
  687                         return 0;
  688                     }
  689                 }
  690             }
  691         }
  692         if ($process_ans_hash){
  693             return $rh_ans;
  694             } else {
  695             return 1;
  696         }
  697     } elsif ( ref($matrix) eq 'Matrix' ) {
  698         if( $matrix->[1] != $matrix->[2] ) {
  699             warn "It is impossible for a non-square matrix to be diagonal, if you are a student, please tell your professor that there is a problem.";
  700             if ($process_ans_hash){
  701                 $rh_ans->throw_error('EVAL');
  702                     return $rh_ans;
  703                 } else {
  704                 return 0;
  705             }
  706         }
  707         for( my $i = 0; $i < $matrix->[1] ; $i++ ) {
  708             for( my $j = 0; $j < $matrix->[2] ; $j++ ) {
  709                 if( $matrix->[0][$i][$j] != 0 and $i != $j ){
  710                         if ($process_ans_hash){
  711                             $rh_ans->throw_error('EVAL');
  712                         return $rh_ans;
  713                         } else {
  714                         return 0;
  715                     }
  716                 }
  717             }
  718         }
  719         if ($process_ans_hash) {
  720             return $rh_ans;
  721             } else {
  722             return 1;
  723         }
  724     } else {
  725         warn "There is a problem with the problem, please alert your professor.";
  726         if ($process_ans_hash){
  727             $rh_ans->throw_error('EVAL');
  728                 return $rh_ans;
  729             } else {
  730             return 0;
  731         }
  732     }
  733 
  734 }
  735 
  736 
  737 sub are_unit_vecs{
  738     my ( $vec_ref,%opts ) = @_;
  739     $vec_ref->{_filter_name}  = 'are_unit_vecs';
  740     my @vecs = ();
  741     if( ref($vec_ref) eq 'AnswerHash' )
  742     {
  743         @vecs = @{$vec_ref->{ra_student_ans}};
  744     }else{
  745         @vecs = @{$vec_ref};
  746     }
  747 
  748     my $i = 0;
  749     my $num = scalar(@vecs);
  750     my $length = $vecs[0]->[1];
  751 
  752     for( ; $i < $num ; $i ++ ) {
  753         if( abs(sqrt($vecs[$i]->scalar_product($vecs[$i]))- 1) > $main::functZeroLevelTolDefault )
  754         {
  755             if( ref( $vec_ref ) eq 'AnswerHash' ){
  756                 $vec_ref->{score} = 0;
  757                 if( $vec_ref->{help} =~ /unit|orthonormal|verbose/ )
  758                 {
  759                     $vec_ref->throw_error('EVAL','You have entered vector(s) which are not of unit length.');
  760                 }else{
  761                     $vec_ref->throw_error('EVAL');
  762                 }
  763                 return $vec_ref;
  764             }else{
  765                 return 0;
  766             }
  767 
  768         }
  769     }
  770 
  771     if( ref( $vec_ref ) eq 'AnswerHash' ){
  772         $vec_ref->{score} = 1;
  773         $vec_ref;
  774     }else{
  775         1;
  776     }
  777 }
  778 
  779 sub display_correct_vecs{
  780     my ( $ra_vecs,%opts ) = @_;
  781     my @ra_vecs = @{$ra_vecs};
  782     my @temp = ();
  783 
  784     for( my $i = 0 ; $i < scalar(@ra_vecs) ; $i++ ) {
  785         push @temp, display_matrix(Matrix->new_from_col_vecs([$ra_vecs[$i]]),'left'=>'.','right'=>'.');
  786         push @temp, ",";
  787     }
  788 
  789     pop @temp;
  790 
  791     mbox(\@temp);
  792 
  793 }
  794 
  795 sub vec_solution_cmp{
  796     my $correctAnswer = shift;
  797     my %opt = @_;
  798 
  799     set_default_options(    \%opt,
  800                 'zeroLevelTol'          =>  $main::functZeroLevelTolDefault,
  801                 'debug'                 =>  0,
  802                 'mode'                  =>  'basis',
  803                 'help'                  =>  'none',
  804     );
  805 
  806 
  807 ## This is where the correct answer should be checked someday.
  808     my $matrix                  =   Matrix->new_from_col_vecs($correctAnswer);
  809 
  810 
  811 #construct the answer evaluator
  812     my $answer_evaluator = new AnswerEvaluator;
  813 
  814     $answer_evaluator->{debug}           = $opt{debug};
  815     $answer_evaluator->ans_hash(
  816                     correct_ans         =>  display_correct_vecs($correctAnswer),
  817                     old_correct_ans     =>  $correctAnswer,
  818                     rm_correct_ans      =>  $matrix,
  819                     zeroLevelTol        =>  $opt{zeroLevelTol},
  820                     debug               =>  $opt{debug},
  821                     mode                =>  $opt{mode},
  822                     help                =>  $opt{help},
  823     );
  824 
  825     $answer_evaluator->install_pre_filter(\&ans_array_filter);
  826     $answer_evaluator->install_pre_filter(
  827       sub{
  828             my ($rh_ans,@options) = @_;
  829             $rh_ans->{_filter_name} = "create student answer as an array of vectors";
  830             my @student_array = @{$rh_ans->{ra_student_ans}};
  831             my @array = ();
  832             for( my $i = 0; $i < scalar(@student_array) ; $i ++ ) {
  833                 push( @array, Matrix->new_from_array_ref($student_array[$i]));
  834             }
  835             $rh_ans->{ra_student_ans} = \@array;
  836             $rh_ans;
  837       }
  838     );
  839     #ra_student_ans is now the students answer as an array of vectors
  840     # anonymous subroutine to check dimension and length of the student vectors
  841     # if either is wrong, the answer is wrong.
  842     $answer_evaluator->install_pre_filter(
  843       sub{
  844       my $rh_ans = shift;
  845       $rh_ans->{_filter_name} = "check_dimension_and_length";
  846       my $length = $rh_ans->{rm_correct_ans}->[1];
  847       my $dim = $rh_ans->{rm_correct_ans}->[2];
  848       if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
  849       {
  850 
  851         $rh_ans->{score} = 0;
  852         if( $rh_ans->{help} =~ /dim|verbose/ )
  853         {
  854           $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
  855         }else{
  856           $rh_ans->throw_error('EVAL');
  857         }
  858       }
  859       for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ ) {
  860         if( $length != $rh_ans->{ra_student_ans}->[$i]->[1]) {
  861           $rh_ans->{score} = 0;
  862           if( $rh_ans->{help} =~ /length|verbose/ ) {
  863             $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
  864           }else{
  865             $rh_ans->throw_error('EVAL');
  866           }
  867         }
  868       }
  869       $rh_ans;
  870       }
  871     );
  872     # Install prefilter for various modes
  873     if( $opt{mode} ne 'basis' )  {
  874         if( $opt{mode} =~ /orthogonal|orthonormal/ ) {
  875             $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
  876         }
  877 
  878         if( $opt{mode} =~ /unit|orthonormal/ ) {
  879             $answer_evaluator->install_pre_filter(\&are_unit_vecs);
  880 
  881         }
  882     }
  883 
  884     $answer_evaluator->install_evaluator(\&compare_vec_solution, %opt);
  885 
  886     $answer_evaluator->install_post_filter(
  887         sub {my $rh_ans = shift;
  888                 if ($rh_ans->catch_error('SYNTAX') ) {
  889                     $rh_ans->{ans_message} = $rh_ans->{error_message};
  890                     $rh_ans->clear_error('SYNTAX');
  891                 }
  892                 if ($rh_ans->catch_error('EVAL') ) {
  893                     $rh_ans->{ans_message} = $rh_ans->{error_message};
  894                     $rh_ans->clear_error('EVAL');
  895                 }
  896                 $rh_ans;
  897         }
  898     );
  899     $answer_evaluator;
  900 
  901 }
  902 
  903 
  904 sub compare_vec_solution {
  905     my ( $rh_ans, %options ) = @_ ;
  906     $rh_ans->{_filter_name} = "compare_vec_solution";
  907     my @space = @{$rh_ans->{ra_student_ans}};
  908     my $solution = shift @space;
  909 
  910     # A lot of the following code was taken from Matrix::proj_coeff
  911     # calling this method recursively would be a waste of time since
  912     # the prof's matrix never changes and solve_LR is an expensive
  913     # operation. This way it is only done once.
  914     my $matrix = $rh_ans->{rm_correct_ans};
  915     my ($dim,$x_vector, $base_matrix);
  916     my $errors = undef;
  917     my $lin_space_tr= ~ $matrix;
  918     $matrix = $lin_space_tr * $matrix;
  919     my $matrix_lr = $matrix->decompose_LR();
  920 
  921     #this section determines whether or not the first vector, a solution to
  922     #the system, is a linear combination of the prof's vectors in which there
  923     #is a nonzero coefficient on the first term, the prof's solution to the system
  924     $solution = $lin_space_tr*$solution;
  925     ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($solution);
  926     #$rh_ans->{debug_compare_vec_solution} = $x_vector->element(1,1);
  927     if( $dim ){
  928         $rh_ans->throw_error('EVAL', "A unique adapted answer could not be determined.  Possibly the parameters have coefficient zero.<br>  dim = $dim base_matrix is $base_matrix\n" );  # only print if the dim is not zero.
  929         $rh_ans->{score} = 0;
  930         $rh_ans;
  931     } elsif( abs($x_vector->element(1,1) -1) >= $options{zeroLevelTol} ) {
  932       # changes by MEG 6/24/05
  933         # the student answer needs to be a linear combination of the instructors vectors
  934         # and the coefficient of the first vector needs to be 1 (it is NOT enough that it be non-zero).
  935         # if this is not the case, then the answer is wrong.
  936         # replaced   $x_vector->[0][0][0]  by $x_vector->element(1,1)  since this doesn't depend on the internal structure of the matrix object.
  937 
  938         $rh_ans->{score} = 0;
  939         $rh_ans;
  940     } else {
  941         $rh_ans->{score} = 1;
  942         my @correct_space = @{$rh_ans->{old_correct_ans}};
  943         shift @correct_space;
  944         $rh_ans->{rm_correct_ans} = Matrix->new_from_col_vecs(\@correct_space);
  945         $rh_ans->{ra_student_ans} = \@space;
  946         return compare_basis( $rh_ans, %options );
  947     }
  948 }
  949 
  950 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9