[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 1331 - (download) (as text) (annotate)
Wed Jul 9 20:28:40 2003 UTC (16 years, 7 months ago) by lr003k
File size: 28112 byte(s)
Removed the last change, it's now handled in display_matrix.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9