[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 3314 - (download) (as text) (annotate)
Fri Jun 24 20:11:23 2005 UTC (14 years, 8 months ago) by gage
File size: 36270 byte(s)
Fixed conceptual error in compare_vec_solution.  This should fix bug
#670.  In my opinion the entire concept of vec_solution_cmp should be
reconsidered.  In solving an underdetermined linear equation of the form
Ax-b=0 it seems to me that the solutions answer in the form:
x= a +bt+cu+ds  where a,b,c,d are vectors should simply be evaluated
to see if it satisfies Ax-b=0 for 5 or six values of a,b,c,d  --
checking the solution should use a
vector valued version of fun_cmp.

As it is, the student's coefficients for a,b,c,d are compared with the
instructors to see if they span the same space. This is quite a bit more
complicated -- and indeed the method came up with the wrong answer.

I believe I have the method corrected, but I would suggest that this
answer evaluator be replaced with one which operates more
directly and is therefore easier to maintain.  Am I missing something in
this analysis?  Has someone else created answer evaluators for this type
of problem?

 -- Mike

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9