[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 4997 - (download) (as text) (annotate)
Mon Jun 11 18:16:40 2007 UTC (12 years, 8 months ago) by gage
File size: 36286 byte(s)
Fixing docementation so that it can be read from the web.

    1 
    2 BEGIN{
    3     be_strict();
    4 }
    5 
    6 sub _PGmorematrixmacros_init{}
    7 
    8 sub random_inv_matrix { ## Builds and returns a random invertible \$row by \$col matrix.
    9 
   10     warn "Usage: \$new_matrix = random_inv_matrix(\$rows,\$cols)"
   11       if (@_ != 2);
   12     my $A = new Matrix($_[0],$_[1]);
   13     my $A_lr = new Matrix($_[0],$_[1]);
   14     my $det = 0;
   15     my $safety=0;
   16     while ($det == 0 and $safety < 6) {
   17         foreach my $i (1..$_[0]) {
   18             foreach my $j (1..$_[1]) {
   19                 $A->assign($i,$j,random(-9,9,1) );
   20                 }
   21             }
   22             $A_lr = $A->decompose_LR();
   23             $det = $A_lr->det_LR();
   24         }
   25     return $A;
   26 }
   27 
   28 =head4 random_diag_matrix
   29 
   30 This method returns a random nxn diagonal matrix.
   31 
   32 =cut
   33 
   34 sub random_diag_matrix{ ## Builds and returns a random diagonal \$n by \$n matrix
   35 
   36     warn "Usage: \$new_matrix = random_diag_matrix(\$n)" if (@_ != 1);
   37 
   38     my $D = new Matrix($_[0],$_[0]);
   39     my $norm = 0;
   40     while( $norm == 0 ){
   41         foreach my $i (1..$_[0]){
   42             foreach my $j (1..$_[0]){
   43                 if( $i != $j ){
   44                     $D->assign($i,$j,0);
   45                 }else{
   46                     $D->assign($i,$j,random(-9,9,1));
   47                 }
   48             }
   49         }
   50         $norm = abs($D);
   51     }
   52     return $D;
   53 }
   54 
   55 sub swap_rows{
   56 
   57     warn "Usage: \$new_matrix = swap_rows(\$matrix,\$row1,\$row2);"
   58       if (@_ != 3);
   59     my $matrix = $_[0];
   60     my ($i,$j) = ($_[1],$_[2]);
   61     warn "Error:  Rows to be swapped must exist!"
   62       if ($i>@$matrix or $j >@$matrix);
   63     warn "Warning:  Swapping the same row is pointless"
   64       if ($i==$j);
   65     my $cols = @{$matrix->[0]};
   66     my $B = new Matrix(@$matrix,$cols);
   67     foreach my $k (1..$cols){
   68         $B->assign($i,$k,element $matrix($j,$k));
   69         $B->assign($j,$k,element $matrix($i,$k));
   70     }
   71     return $B;
   72 }
   73 
   74 sub row_mult{
   75 
   76     warn "Usage: \$new_matrix = row_mult(\$matrix,\$scalar,\$row);"
   77       if (@_ != 3);
   78     my $matrix = $_[0];
   79     my ($scalar,$row) = ($_[1],$_[2]);
   80     warn "Undefined row multiplication"
   81       if ($row > @$matrix);
   82     my $B = new Matrix(@$matrix,@{$matrix->[0]});
   83     foreach my $j (1..@{$matrix->[0]}) {
   84         $B->assign($row,$j,$scalar*element $matrix($row,$j));
   85     }
   86     return $B;
   87 }
   88 
   89 sub linear_combo{
   90 
   91     warn "Usage: \$new_matrix = linear_combo(\$matrix,\$scalar,\$row1,\$row2);"
   92       if (@_ != 4);
   93     my $matrix = $_[0];
   94     my ($scalar,$row1,$row2) = ($_[1],$_[2],$_[3]);
   95     warn "Undefined row in multiplication"
   96       if ($row1>@$matrix or $row2>@$matrix);
   97     warn "Warning:  Using the same row"
   98       if ($row1==$row2);
   99     my $B = new Matrix(@$matrix,@{$matrix->[0]});
  100     foreach my $j (1..@$matrix) {
  101         my ($t1,$t2) = (element $matrix($row1,$j),element $matrix($row2,$j));
  102         $B->assign($row2,$j,$scalar*$t1+$t2);
  103     }
  104     return $B;
  105 }
  106 
  107 =head3 basis_cmp()
  108 
  109 Compares a list of vectors by finding the change of coordinate matrix
  110 from the Prof's vectors to the students, and then taking the determinant of
  111 that to determine the existence of the change of coordinate matrix going the
  112 other way.
  113 
  114 ANS( basis_cmp( vectors_as_array_ref_in_array_ref, options_hash ) );
  115 
  116     1. a reference to an array of correct vectors
  117     2. a hash with the following keys (all optional):
  118         mode            --  'basis' (default) (only a basis allowed)
  119                             'orthogonal' (only an orthogonal basis is allowed)
  120                             'unit' (only unit vectors in the basis allowed)
  121                             'orthonormal' (only orthogonal unit vectors in basis allowed)
  122         zeroLevelTol    --  absolute tolerance to allow when answer is close
  123                                  to zero
  124 
  125         debug           --  if set to 1, provides verbose listing of
  126                                 hash entries throughout fliters.
  127 
  128         help        --  'none' (default) (is quiet on all errors)
  129                     'dim' (Tells student if wrong number of vectors are entered)
  130                     'length' (Tells student if there is a vector of the wrong length)
  131                     'orthogonal' (Tells student if their vectors are not orthogonal)
  132                             (This is only in orthogonal mode)
  133                     'unit' (Tells student if there is a vector not of unit length)
  134                             (This is only in unit mode)
  135                     'orthonormal' (Gives errors from orthogonal and orthonormal)
  136                             (This is only in orthonormal mode)
  137                     'verbose' (Gives all the above answer messages)
  138 
  139     Returns an answer evaluator.
  140 
  141 EXAMPLES:
  142 
  143     basis_cmp([[1,0,0],[0,1,0],[0,0,1]])
  144                                     --  correct answer is any basis for R^3.
  145     basis_cmp([1,0,2,0],[0,1,0,0], 'mode'=>orthonormal )
  146                                     --  correct answer is any orthonormal basis
  147                                         for this space such as:
  148                                         [1/sqrt(3),0,2/sqrt(3),0],[0,1,0,0]
  149 
  150 =cut
  151 
  152 
  153 sub basis_cmp {
  154     my $correctAnswer = shift;
  155     my %opt = @_;
  156 
  157     set_default_options(    \%opt,
  158             'zeroLevelTol'          =>  $main::functZeroLevelTolDefault,
  159             'debug'                 =>  0,
  160             'mode'                  =>  'basis',
  161             'help'                  =>  'none',
  162     );
  163 
  164     # produce answer evaluator
  165     BASIS_CMP(
  166             'correct_ans'       =>  $correctAnswer,
  167             'zeroLevelTol'      =>  $opt{'zeroLevelTol'},
  168             'debug'             =>  $opt{'debug'},
  169             'mode'              =>  $opt{'mode'},
  170             'help'              =>  $opt{'help'},
  171     );
  172 }
  173 
  174 =head1 BASIS_CMP
  175 
  176 Made to keep the same format as num_cmp and fun_cmp.
  177 
  178 =cut
  179 
  180 sub BASIS_CMP {
  181     my %mat_params = @_;
  182     my $zeroLevelTol                =   $mat_params{'zeroLevelTol'};
  183 
  184     # Check that everything is defined:
  185     $mat_params{debug} = 0 unless defined($mat_params{debug});
  186     $zeroLevelTol = $main::functZeroLevelTolDefault         unless defined $zeroLevelTol;
  187     $mat_params{'zeroLevelTol'}             =   $zeroLevelTol;
  188 
  189 ## This is where the correct answer should be checked someday.
  190     my $matrix                  =   Matrix->new_from_col_vecs($mat_params{'correct_ans'});
  191 
  192 #construct the answer evaluator
  193     my $answer_evaluator = new AnswerEvaluator;
  194 
  195     $answer_evaluator->{debug} = $mat_params{debug};
  196     $answer_evaluator->ans_hash(
  197         correct_ans         =>  display_correct_vecs($mat_params{correct_ans}),
  198         rm_correct_ans      =>  $matrix,
  199         zeroLevelTol        =>  $mat_params{zeroLevelTol},
  200         debug               =>  $mat_params{debug},
  201         mode                =>  $mat_params{mode},
  202         help                =>  $mat_params{help},
  203     );
  204 
  205     $answer_evaluator->install_pre_filter(
  206         sub {my $rh_ans              = shift;
  207             $rh_ans->{_filter_name}  = 'remove_white_space';
  208             $rh_ans->{student_ans}   =~ s/\s+//g;       # remove all whitespace
  209             $rh_ans;
  210         }
  211     );
  212     $answer_evaluator->install_pre_filter(
  213         sub{my $rh_ans      = shift;
  214             my @options     = @_;
  215             $rh_ans->{_filter_name}  = 'mung_student_answer';
  216             if( $rh_ans->{ans_label} =~ /ArRaY/ ){
  217                 $rh_ans           = ans_array_filter($rh_ans,@options);
  218                 my @student_array = @{$rh_ans->{ra_student_ans}};
  219                 my @array         = ();
  220                 for( my $i = 0; $i < scalar(@student_array) ; $i ++ )
  221                 {
  222                     push( @array, Matrix->new_from_array_ref($student_array[$i]));
  223                 }
  224                 $rh_ans->{ra_student_ans} = \@array;
  225                 $rh_ans;
  226             }else{
  227                 $rh_ans->{student_ans}    = math_constants($rh_ans->{student_ans});
  228                 vec_list_string($rh_ans, '_filter_name' => 'vec_list_string', @options);
  229             }
  230         }
  231     );#ra_student_ans is now the students answer as an array of vectors
  232     # anonymous subroutine to check dimension and length of the student vectors
  233     # if either is wrong, the answer is wrong.
  234     $answer_evaluator->install_pre_filter(
  235         sub{
  236             my $rh_ans               = shift;
  237             $rh_ans->{_filter_name}  = 'check_vector_size';
  238             my $length               = $rh_ans->{rm_correct_ans}->[1];
  239             my $dim                  = $rh_ans->{rm_correct_ans}->[2];
  240             if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
  241             {
  242 
  243                 $rh_ans->{score} = 0;
  244                 if( $rh_ans->{help} =~ /dim|verbose/ )
  245                 {
  246                     $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
  247                 }else{
  248                     $rh_ans->throw_error('EVAL');
  249                 }
  250             }
  251             for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ )
  252             {
  253                 if( $length != $rh_ans->{ra_student_ans}->[$i]->[1])
  254                 {
  255                     $rh_ans->{score} = 0;
  256                     if( $rh_ans->{help} =~ /length|verbose/ )
  257                     {
  258                         $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
  259                     }else{
  260                         $rh_ans->throw_error('EVAL');
  261                     }
  262                 }
  263             }
  264             $rh_ans;
  265         }
  266     );
  267     # Install prefilter for various modes
  268     if( $mat_params{mode} ne 'basis' )
  269     {
  270         if( $mat_params{mode} =~ /orthogonal|orthonormal/ )
  271         {
  272             $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
  273         }
  274 
  275         if( $mat_params{mode} =~ /unit|orthonormal/ )
  276         {
  277             $answer_evaluator->install_pre_filter(\&are_unit_vecs);
  278 
  279         }
  280     }
  281         $answer_evaluator->install_evaluator(\&compare_basis, %mat_params);
  282     $answer_evaluator->install_post_filter(
  283         sub {my $rh_ans = shift;
  284                 if ($rh_ans->catch_error('SYNTAX') ) {
  285                     $rh_ans->{ans_message} = $rh_ans->{error_message};
  286                     $rh_ans->clear_error('SYNTAX');
  287                 }
  288                 if ($rh_ans->catch_error('EVAL') ) {
  289                     $rh_ans->{ans_message} = $rh_ans->{error_message};
  290                     $rh_ans->clear_error('EVAL');
  291                 }
  292                 $rh_ans;
  293         }
  294     );
  295     $answer_evaluator;
  296 }
  297 
  298 =head4 compare_basis
  299 
  300     compare_basis( $ans_hash,
  301         %options
  302         ra_student_ans     # a reference to the array of students answer vectors
  303         rm_correct_ans,    # a reference to the correct answer matrix
  304         %options
  305     )
  306 
  307 
  308 =cut
  309 
  310 
  311 
  312 sub compare_basis {
  313     my ($rh_ans, %options) = @_;
  314     $rh_ans->{_filter_name} = "compare_basis";
  315     my @ch_coord;
  316     my @vecs = @{$rh_ans->{ra_student_ans}};
  317 
  318     # A lot of the following code was taken from Matrix::proj_coeff
  319     # calling this method recursively would be a waste of time since
  320     # the prof's matrix never changes and solve_LR is an expensive
  321     # operation. This way it is only done once.
  322     my $matrix = $rh_ans->{rm_correct_ans};
  323     my ($dim,$x_vector, $base_matrix);
  324     my $errors = undef;
  325     my $lin_space_tr= ~ $matrix; #transpose of the matrix
  326     $matrix = $lin_space_tr * $matrix;  #(~A * A)
  327     my $matrix_lr = $matrix->decompose_LR();
  328 
  329     #finds the coefficient vectors for each of the students vectors
  330     for( my $i = 0; $i < scalar(@{$rh_ans->{ra_student_ans}}) ; $i++ ) {
  331 
  332         $vecs[$i] = $lin_space_tr*$vecs[$i];
  333         ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($vecs[$i]);
  334         push( @ch_coord, $x_vector );
  335         $errors = "A unique adapted answer could not be determined.
  336         Possibly the parameters have coefficient zero.<br>  dim = $dim base_matrix
  337         is $base_matrix\n" if $dim;  # only print if the dim is not zero.
  338     }
  339 
  340     if( defined($errors)) {
  341         $rh_ans->throw_error('EVAL', $errors) ;
  342     } else {
  343         my $ch_coord_mat = Matrix->new_from_col_vecs(\@ch_coord);
  344             #creates change of coordinate matrix
  345             #existence of this matrix implies that
  346             #the all of the students answers are a
  347             #linear combo of the prof's
  348         $ch_coord_mat = $ch_coord_mat->decompose_LR();
  349 
  350         if( abs($ch_coord_mat->det_LR()) > $options{zeroLevelTol} ) {
  351             # if the det of the change of coordinate  matrix is
  352             # non-zero, this implies the existence of an inverse
  353             # which implies all of the prof's vectors are a linear
  354             # combo of the students vectors, showing containment
  355             # both ways.
  356 
  357             # I think sometimes if the students space has the same dimension as the profs space it
  358             # will get projected into the profs space even if it isn't a basis for that space.
  359             # this just checks that the prof's matrix times the change of coordinate matrix is actually
  360             #the students matrix
  361             if(  abs(Matrix->new_from_col_vecs(\@{$rh_ans->{ra_student_ans}}) -
  362                 ($rh_ans->{rm_correct_ans})*(Matrix->new_from_col_vecs(\@ch_coord)))
  363                 < $options{zeroLevelTol} ) {
  364                 $rh_ans->{score} = 1;
  365             } else {
  366                 $rh_ans->{score} = 0;
  367             }
  368         } else {
  369             $rh_ans->{score}=0;
  370         }
  371     }
  372     $rh_ans;
  373 
  374 }
  375 
  376 
  377 =head2 vec_list_string
  378 
  379 This is a check_syntax type method (in fact I borrowed some of that method's code) for vector input.
  380 The student needs to enter vectors like:        [1,0,0],[1,2,3],[0,9/sqrt(10),1/sqrt(10)]
  381 Each entry can contain functions and operations and the usual math constants (pi and e).
  382 The vectors, however can not be added or multiplied or scalar multiplied by the student.
  383 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.
  384 Right now the method basically ignores every thing outside the vectors. Also, an unmatched open parenthesis is caught,
  385 but a unmatched close parenthesis ends the vector, and since everything outside is ignored, no error is sent (other than the
  386 later when the length of the vectors is checked.
  387 In the end, the method returns an array of Matrix objects.
  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 ans_array_filter
  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