[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 1534 - (download) (as text) (annotate)
Thu Sep 25 05:42:31 2003 UTC (16 years, 2 months ago) by sh002i
File size: 28082 byte(s)
removed unneeded #! line

    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(  correct_ans     =>  display_correct_vecs($mat_params{correct_ans}),
  196           rm_correct_ans    =>  $matrix,
  197           zeroLevelTol    =>  $mat_params{zeroLevelTol},
  198           debug     =>  $mat_params{debug},
  199           mode      =>  $mat_params{mode},
  200           help      =>  $mat_params{help},
  201       );
  202 
  203   $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
  204     $rh_ans->{student_ans} =~ s/\s+//g;   # remove all whitespace
  205     $rh_ans;
  206   });
  207   $answer_evaluator->install_pre_filter(sub{my $rh_ans = shift; my @options = @_;
  208     if( $rh_ans->{ans_label} =~ /ArRaY/ ){
  209       $rh_ans = ans_array_filter($rh_ans,@options);
  210       my @student_array = @{$rh_ans->{ra_student_ans}};
  211       my @array = ();
  212       for( my $i = 0; $i < scalar(@student_array) ; $i ++ )
  213       {
  214         push( @array, Matrix->new_from_array_ref($student_array[$i]));
  215       }
  216       $rh_ans->{ra_student_ans} = \@array;
  217       $rh_ans;
  218     }else{
  219       $rh_ans->{student_ans} = math_constants($rh_ans->{student_ans});
  220       vec_list_string($rh_ans,@options);
  221     }
  222 
  223   });#ra_student_ans is now the students answer as an array of vectors
  224   # anonymous subroutine to check dimension and length of the student vectors
  225   # if either is wrong, the answer is wrong.
  226   $answer_evaluator->install_pre_filter(sub{
  227     my $rh_ans = shift;
  228     my $length = $rh_ans->{rm_correct_ans}->[1];
  229     my $dim = $rh_ans->{rm_correct_ans}->[2];
  230     if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
  231     {
  232 
  233       $rh_ans->{score} = 0;
  234       if( $rh_ans->{help} =~ /dim|verbose/ )
  235       {
  236         $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
  237       }else{
  238         $rh_ans->throw_error('EVAL');
  239       }
  240     }
  241     for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ )
  242     {
  243       if( $length != $rh_ans->{ra_student_ans}->[$i]->[1])
  244       {
  245         $rh_ans->{score} = 0;
  246         if( $rh_ans->{help} =~ /length|verbose/ )
  247         {
  248           $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
  249         }else{
  250           $rh_ans->throw_error('EVAL');
  251         }
  252       }
  253     }
  254     $rh_ans;
  255   });
  256   # Install prefilter for various modes
  257   if( $mat_params{mode} ne 'basis' )
  258   {
  259     if( $mat_params{mode} =~ /orthogonal|orthonormal/ )
  260     {
  261       $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
  262     }
  263 
  264     if( $mat_params{mode} =~ /unit|orthonormal/ )
  265     {
  266       $answer_evaluator->install_pre_filter(\&are_unit_vecs);
  267 
  268     }
  269   }
  270       $answer_evaluator->install_evaluator(\&compare_basis, %mat_params);
  271   $answer_evaluator->install_post_filter(
  272     sub {my $rh_ans = shift;
  273         if ($rh_ans->catch_error('SYNTAX') ) {
  274           $rh_ans->{ans_message} = $rh_ans->{error_message};
  275           $rh_ans->clear_error('SYNTAX');
  276         }
  277         if ($rh_ans->catch_error('EVAL') ) {
  278           $rh_ans->{ans_message} = $rh_ans->{error_message};
  279           $rh_ans->clear_error('EVAL');
  280         }
  281         $rh_ans;
  282     }
  283   );
  284   $answer_evaluator;
  285 }
  286 
  287 =head4 compare_basis
  288 
  289   compare_basis( $ans_hash, %options);
  290 
  291                 {ra_student_ans},     # a reference to the array of students answer vectors
  292                                {rm_correct_ans},      # a reference to the correct answer matrix
  293                                %options
  294                               )
  295 
  296 =cut
  297 
  298 sub compare_basis {
  299   my ($rh_ans, %options) = @_;
  300   my @ch_coord;
  301   my @vecs = @{$rh_ans->{ra_student_ans}};
  302 
  303   # A lot of the follosing code was taken from Matrix::proj_coeff
  304   # calling this method recursively would be a waste of time since
  305   # the prof's matrix never changes and solve_LR is an expensive
  306   # operation. This way it is only done once.
  307   my $matrix = $rh_ans->{rm_correct_ans};
  308   my ($dim,$x_vector, $base_matrix);
  309   my $errors = undef;
  310   my $lin_space_tr= ~ $matrix;
  311   $matrix = $lin_space_tr * $matrix;
  312   my $matrix_lr = $matrix->decompose_LR();
  313 
  314   #finds the coefficient vectors for each of the students vectors
  315   for( my $i = 0; $i < scalar(@{$rh_ans->{ra_student_ans}}) ; $i++ )
  316   {
  317 
  318     $vecs[$i] = $lin_space_tr*$vecs[$i];
  319     ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($vecs[$i]);
  320     push( @ch_coord, $x_vector );
  321     $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.
  322   }
  323 
  324   if( defined($errors))
  325   {
  326     $rh_ans->throw_error('EVAL', $errors) ;
  327   }else{
  328     my $ch_coord_mat = Matrix->new_from_col_vecs(\@ch_coord);#creates change of coordinate matrix
  329                   #existence of this matrix implies that
  330                   #the all of the students answers are a
  331                   #linear combo of the prof's
  332     $ch_coord_mat = $ch_coord_mat->decompose_LR();
  333 
  334     if( abs($ch_coord_mat->det_LR()) > $options{zeroLevelTol} )# if the det of the change of coordinate  matrix is
  335                   # non-zero, this implies the existence of an inverse
  336                   # which implies all of the prof's vectors are a linear
  337                   # combo of the students vectors, showing containment
  338                   # both ways.
  339     {
  340       # I think sometimes if the students space has the same dimension as the profs space it
  341       # will get projected into the profs space even if it isn't a basis for that space.
  342       # this just checks that the prof's matrix times the change of coordinate matrix is actually
  343       #the students matrix
  344       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} )
  345       {
  346         $rh_ans->{score} = 1;
  347       }else{
  348         $rh_ans->{score} = 0;
  349       }
  350     }
  351     else{
  352       $rh_ans->{score}=0;
  353     }
  354   }
  355   $rh_ans;
  356 
  357 }
  358 
  359 
  360 =head 2 vec_list_string
  361 
  362 This is a check_syntax type method (in fact I borrowed some of that method's code) for vector input.
  363 The student needs to enter vectors like:        [1,0,0],[1,2,3],[0,9/sqrt(10),1/sqrt(10)]
  364 Each entry can contain functions and operations and the usual math constants (pi and e).
  365 The vectors, however can not be added or multiplied or scalar multiplied by the student.
  366 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.
  367 Right now the method basically ignores every thing outside the vectors. Also, an unmatched open parenthesis is caught,
  368 but a unmatched close parenthesis ends the vector, and since everything outside is ignored, no error is sent (other than the
  369 later when the length of the vectors is checked.
  370 In the end, the method returns an array of Matrix objects.
  371 
  372 
  373 =cut
  374 
  375 sub vec_list_string{
  376   my $rh_ans = shift;
  377   my %options = @_;
  378   my $i;
  379   my $entry = "";
  380   my $char;
  381   my @paren_stack;
  382   my $length = length($rh_ans->{student_ans});
  383   my @temp;
  384   my $j = 0;
  385   my @answers;
  386   my $paren;
  387   my $display_ans;
  388 
  389   for( $i = 0; $i < $length ; $i++ )
  390   {
  391     $char = substr($rh_ans->{student_ans},$i,1);
  392 
  393     if( $char =~ /\(|\[|\{/ ){
  394         push( @paren_stack, $char )
  395     }
  396 
  397     if( !( $char =~ /\(|\[|\{/ && scalar(@paren_stack) == 1 ) )
  398     {
  399       if( $char !~ /,|\)|\]|\}/ ){
  400         $entry .= $char;
  401       }else{
  402         if( $char =~ /,/ || ( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1 ) )
  403         {
  404           if( length($entry) == 0 ){
  405             if( $char !~ /,/ ){
  406               $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
  407             }else{
  408                 $rh_ans->{preview_text_string}   .= ",";
  409                 $rh_ans->{preview_latex_string}  .= ",";
  410                 $display_ans .= ",";
  411             }
  412           }else{
  413 
  414             # This parser code was origianally taken from PGanswermacros::check_syntax
  415             # but parts of it needed to be slighty modified for this context
  416             my $parser = new AlgParserWithImplicitExpand;
  417             my $ret = $parser -> parse($entry);     #for use with loops
  418 
  419             if ( ref($ret) )  {   ## parsed successfully
  420               $parser -> tostring();
  421               $parser -> normalize();
  422               $entry = $parser -> tostring();
  423               $rh_ans->{preview_text_string} .= $entry.",";
  424               $rh_ans->{preview_latex_string} .=  $parser -> tolatex().",";
  425 
  426             } else {          ## error in parsing
  427 
  428               $rh_ans->{'student_ans'}      = 'syntax error:'.$display_ans. $parser->{htmlerror},
  429               $rh_ans->{'ans_message'}      = $display_ans.$parser -> {error_msg},
  430               $rh_ans->{'preview_text_string'}  = '',
  431               $rh_ans->{'preview_latex_string'} = '',
  432               $rh_ans->throw_error('SYNTAX',  'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
  433             }
  434 
  435             my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
  436 
  437             if ($PG_eval_errors) {
  438               $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
  439               $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
  440               last;
  441             } else {
  442               $entry = prfmt($inVal,$options{format});
  443               $display_ans .= $entry.",";
  444               push(@temp , $entry);
  445             }
  446 
  447             if( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1)
  448             {
  449               pop @paren_stack;
  450               chop($rh_ans->{preview_text_string});
  451               chop($rh_ans->{preview_latex_string});
  452               chop($display_ans);
  453               $rh_ans->{preview_text_string} .= "]";
  454               $rh_ans->{preview_latex_string} .= "]";
  455               $display_ans .= "]";
  456               if( scalar(@temp) > 0 )
  457               {
  458                 push( @answers,Matrix->new_from_col_vecs([\@temp]));
  459                 while(scalar(@temp) > 0 ){
  460                   pop @temp;
  461                 }
  462               }else{
  463                 $rh_ans->throw_error('EVAL','There is a syntax error in your answer.');
  464               }
  465             }
  466           }
  467           $entry = "";
  468         }else{
  469           $paren = pop @paren_stack;
  470           if( scalar(@paren_stack) > 0 ){
  471             #this uses ASCII to check if the parens match up
  472             # in ASCII ord ( = 40 , ord ) = 41 , ord [ = 91 ,
  473             # ord ] = 93 , ord { = 123 , ord } = 125
  474             if( (ord($char) - ord($paren) <= 2) ){
  475               $entry = $entry . $char;
  476             }else{
  477               $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
  478             }
  479           }
  480         }
  481       }
  482     }else{
  483       $rh_ans->{preview_text_string}   .= "[";
  484       $rh_ans->{preview_latex_string}  .= "[";
  485       $display_ans .= "[";
  486     }
  487   }
  488   $rh_ans->{ra_student_ans} = \@answers;
  489   $rh_ans->{student_ans} = $display_ans unless $rh_ans->{error_flag};
  490   $rh_ans;
  491 }
  492 
  493 =head5
  494   This filter was created to get, format, and evaluate each entry of the ans_array and ans_array_extension
  495   answer entry methods. Running this filter is necessary to get all the entries out of the answer
  496   hash. Each entry is evaluated and the resulting number is put in the display for student answer
  497   as a string. For evaluation purposes an array of arrays of arrays is created called ra_student_ans
  498   and placed in the hash. The entries are [array_number][row_number][column_number]. The latex strings
  499   for each entry are taken from the parser and put, as a matrix, into the previewer. The preview text
  500   string is also created, but this display method becomes confusing when large matrices are used.
  501 =cut
  502 
  503 
  504 sub ans_array_filter{
  505   my $rh_ans = shift;
  506   my %options = @_;
  507   $rh_ans->{ans_label} =~ /ArRaY(\d+)\[\d+,\d+,\d+\]/;
  508   my $ans_num = $1;
  509   my @keys = grep /ArRaY$ans_num/, keys(%{$main::inputs_ref});
  510   my $key;
  511   my @array = ();
  512   my ($i,$j,$k) = (0,0,0);
  513 
  514   #the keys aren't in order, so their info has to be put into the array before doing anything with it
  515   foreach $key (@keys){
  516     $key =~ /ArRaY\d+\[(\d+),(\d+),(\d+)\]/;
  517     ($i,$j,$k) = ($1,$2,$3);
  518     $array[$i][$j][$k] = ${$main::inputs_ref}{'ArRaY'.$ans_num.'['.$i.','.$j.','.$k.']'};
  519   }
  520 
  521   my $display_ans = "";
  522 
  523   for( $i=0; $i < scalar(@array) ; $i ++ )
  524   {
  525     $display_ans .= " [";
  526           $rh_ans->{preview_text_string} .= ' [';
  527           $rh_ans->{preview_latex_string} .= '\begin{pmatrix} ';
  528     for( $j = 0; $j < scalar( @{$array[$i]} ) ; $j++ )
  529     {
  530       $display_ans .= " [";
  531                   $rh_ans->{preview_text_string} .= ' [';
  532                   for( $k = 0; $k < scalar( @{$array[$i][$j]} ) ; $k ++ ){
  533         my $entry = $array[$i][$j][$k];
  534         $entry = math_constants($entry);
  535         # This parser code was origianally taken from PGanswermacros::check_syntax
  536         # but parts of it needed to be slighty modified for this context
  537         my $parser = new AlgParserWithImplicitExpand;
  538         my $ret = $parser -> parse($entry);     #for use with loops
  539 
  540         if ( ref($ret) )  {   ## parsed successfully
  541           $parser -> tostring();
  542           $parser -> normalize();
  543           $entry = $parser -> tostring();
  544           $rh_ans->{preview_text_string} .= $entry.",";
  545           $rh_ans->{preview_latex_string} .= $parser -> tolatex() . '& ';
  546 
  547         } else {          ## error in parsing
  548           $rh_ans->{'student_ans'}      = 'syntax error:'.$display_ans. $parser->{htmlerror},
  549           $rh_ans->{'ans_message'}      = $display_ans.$parser -> {error_msg},
  550           $rh_ans->{'preview_text_string'}  = '',
  551           $rh_ans->throw_error('SYNTAX',  'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
  552         }
  553 
  554         my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
  555         if ($PG_eval_errors) {
  556           $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
  557           $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
  558           last;
  559         } else {
  560           $entry = prfmt($inVal,$options{format});
  561           $display_ans .= $entry.",";
  562           $array[$i][$j][$k] = $entry;
  563         }
  564       }
  565       chop($rh_ans->{preview_text_string});
  566       chop($display_ans);
  567                   $rh_ans->{preview_text_string} .= '] ,';
  568                  $rh_ans->{preview_latex_string} .= '\\\\';
  569       $display_ans .= '] ,';
  570 
  571     }
  572     chop($rh_ans->{preview_text_string});
  573     chop($display_ans);
  574                 $rh_ans->{preview_text_string} .= '] ,';
  575                 $rh_ans->{preview_latex_string} .= '\end{pmatrix}'.' , ';
  576     $display_ans .= '] ,';
  577   }
  578   chop($rh_ans->{preview_text_string});
  579   chop($rh_ans->{preview_latex_string});
  580   chop($rh_ans->{preview_latex_string});
  581   chop($rh_ans->{preview_latex_string});
  582   chop($display_ans);
  583 
  584   my @temp = ();
  585   for( $i = 0 ; $i < scalar( @array ); $i++ ){
  586     push @temp , display_matrix($array[$i], 'left'=>'.', 'right'=>'.');
  587     push @temp , "," unless $i == scalar(@array) - 1;
  588   }
  589   $rh_ans->{student_ans} = mbox(\@temp);
  590   $rh_ans->{ra_student_ans} = \@array;
  591 
  592   $rh_ans;
  593 
  594 }
  595 
  596 
  597 sub are_orthogonal_vecs{
  598   my ($vec_ref , %opts) = @_;
  599   my @vecs = ();
  600   if( ref($vec_ref) eq 'AnswerHash' )
  601   {
  602     @vecs = @{$vec_ref->{ra_student_ans}};
  603   }else{
  604     @vecs = @{$vec_ref};
  605   }
  606   my ($i,$j) = (0,0);
  607 
  608   my $num = scalar(@vecs);
  609   my $length = $vecs[0]->[1];
  610 
  611   for( ; $i < $num ; $i ++ )
  612   {
  613     for( $j = $i+1; $j < $num ; $j++ )
  614     {
  615       if( $vecs[$i]->scalar_product($vecs[$j]) > $main::functZeroLevelTolDefault )
  616       {
  617         if( ref( $vec_ref ) eq 'AnswerHash' ){
  618           $vec_ref->{score} = 0;
  619           if( $vec_ref->{help} =~ /orthogonal|orthonormal|verbose/ )
  620           {
  621             $vec_ref->throw_error('EVAL','You have entered vectors which are not orthogonal. ');
  622           }else{
  623             $vec_ref->throw_error('EVAL');
  624           }
  625           return $vec_ref;
  626         }else{
  627           return 0;
  628         }
  629       }
  630     }
  631   }
  632   if( ref( $vec_ref ) eq 'AnswerHash' ){
  633     $vec_ref->{score} = 1;
  634     $vec_ref;
  635   }else{
  636     1;
  637   }
  638 }
  639 
  640 sub is_diagonal{
  641   my $matrix  = shift;
  642   my %options   = @_;
  643   my $process_ans_hash = ( ref( $matrix ) eq 'AnswerHash' ) ? 1 : 0 ;
  644   my ($rh_ans);
  645   if ($process_ans_hash) {
  646     $rh_ans = $matrix;
  647     $matrix = $rh_ans->{ra_student_ans};
  648   }
  649 
  650   return 0 unless defined($matrix);
  651 
  652   if( ref($matrix) eq 'ARRAY' ){
  653     my @matrix = @{$matrix};
  654     @matrix = @{$matrix[0]} if ref($matrix[0][0]) eq 'ARRAY';
  655     if( ref($matrix[0]) ne 'ARRAY' or scalar( @matrix ) != scalar( @{$matrix[0]} ) ){
  656       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.";
  657     }
  658 
  659     for( my $i = 0; $i < scalar( @matrix ) ; $i++ ){
  660       for( my $j = 0; $j < scalar( @{$matrix[0]} ); $j++ ){
  661         if( $matrix[$i][$j] != 0 and $i != $j )
  662         {
  663               if ($process_ans_hash){
  664                 $rh_ans->throw_error('EVAL');
  665                 return $rh_ans;
  666               } else {
  667             return 0;
  668           }
  669         }
  670       }
  671     }
  672     if ($process_ans_hash){
  673         return $rh_ans;
  674         } else {
  675       return 1;
  676     }
  677   }elsif( ref($matrix) eq 'Matrix' ){
  678     if( $matrix->[1] != $matrix->[2] ){
  679       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.";
  680       if ($process_ans_hash){
  681         $rh_ans->throw_error('EVAL');
  682             return $rh_ans;
  683           } else {
  684         return 0;
  685       }
  686     }
  687     for( my $i = 0; $i < $matrix->[1] ; $i++ ){
  688       for( my $j = 0; $j < $matrix->[2] ; $j++ ){
  689         if( $matrix->[0][$i][$j] != 0 and $i != $j ){
  690               if ($process_ans_hash){
  691                 $rh_ans->throw_error('EVAL');
  692             return $rh_ans;
  693               } else {
  694             return 0;
  695           }
  696         }
  697       }
  698     }
  699     if ($process_ans_hash){
  700         return $rh_ans;
  701         } else {
  702       return 1;
  703     }
  704   }else{
  705     warn "There is a problem with the problem, please alert your professor.";
  706     if ($process_ans_hash){
  707       $rh_ans->throw_error('EVAL');
  708           return $rh_ans;
  709         } else {
  710       return 0;
  711     }
  712   }
  713 
  714 }
  715 
  716 
  717 sub are_unit_vecs{
  718   my ( $vec_ref,%opts ) = @_;
  719   my @vecs = ();
  720   if( ref($vec_ref) eq 'AnswerHash' )
  721   {
  722     @vecs = @{$vec_ref->{ra_student_ans}};
  723   }else{
  724     @vecs = @{$vec_ref};
  725   }
  726 
  727   my $i = 0;
  728   my $num = scalar(@vecs);
  729   my $length = $vecs[0]->[1];
  730 
  731   for( ; $i < $num ; $i ++ )
  732   {
  733     if( abs(sqrt($vecs[$i]->scalar_product($vecs[$i]))- 1) > $main::functZeroLevelTolDefault )
  734     {
  735       if( ref( $vec_ref ) eq 'AnswerHash' ){
  736         $vec_ref->{score} = 0;
  737         if( $vec_ref->{help} =~ /unit|orthonormal|verbose/ )
  738         {
  739           $vec_ref->throw_error('EVAL','You have entered vector(s) which are not of unit length.');
  740         }else{
  741           $vec_ref->throw_error('EVAL');
  742         }
  743         return $vec_ref;
  744       }else{
  745         return 0;
  746       }
  747 
  748     }
  749   }
  750 
  751   if( ref( $vec_ref ) eq 'AnswerHash' ){
  752     $vec_ref->{score} = 1;
  753     $vec_ref;
  754   }else{
  755     1;
  756   }
  757 }
  758 
  759 sub display_correct_vecs{
  760   my ( $ra_vecs,%opts ) = @_;
  761   my @ra_vecs = @{$ra_vecs};
  762   my @temp = ();
  763 
  764   for( my $i = 0 ; $i < scalar(@ra_vecs) ; $i++ ){
  765     push @temp, display_matrix(Matrix->new_from_col_vecs([$ra_vecs[$i]]),'left'=>'.','right'=>'.');
  766     push @temp, ",";
  767   }
  768 
  769   pop @temp;
  770 
  771   mbox(\@temp);
  772 
  773 }
  774 
  775 sub vec_solution_cmp{
  776   my $correctAnswer = shift;
  777   my %opt = @_;
  778 
  779   set_default_options(  \%opt,
  780         'zeroLevelTol'        =>  $main::functZeroLevelTolDefault,
  781               'debug'         =>  0,
  782         'mode'          =>  'basis',
  783         'help'          =>  'none',
  784       );
  785 
  786   $opt{debug} = 0 unless defined($opt{debug});
  787 
  788 ## This is where the correct answer should be checked someday.
  789   my $matrix          = Matrix->new_from_col_vecs($correctAnswer);
  790 
  791 
  792 #construct the answer evaluator
  793   my $answer_evaluator = new AnswerEvaluator;
  794 
  795       $answer_evaluator->{debug} = $opt{debug};
  796   $answer_evaluator->ans_hash(  correct_ans     =>  display_correct_vecs($correctAnswer),
  797           old_correct_ans   =>  $correctAnswer,
  798           rm_correct_ans    =>  $matrix,
  799           zeroLevelTol    =>  $opt{zeroLevelTol},
  800           debug     =>  $opt{debug},
  801           mode      =>  $opt{mode},
  802           help      =>  $opt{help},
  803       );
  804 
  805   $answer_evaluator->install_pre_filter(\&ans_array_filter);
  806   $answer_evaluator->install_pre_filter(sub{
  807       my ($rh_ans,@options) = @_;
  808       my @student_array = @{$rh_ans->{ra_student_ans}};
  809       my @array = ();
  810       for( my $i = 0; $i < scalar(@student_array) ; $i ++ )
  811       {
  812         push( @array, Matrix->new_from_array_ref($student_array[$i]));
  813       }
  814       $rh_ans->{ra_student_ans} = \@array;
  815       $rh_ans;
  816   });#ra_student_ans is now the students answer as an array of vectors
  817   # anonymous subroutine to check dimension and length of the student vectors
  818   # if either is wrong, the answer is wrong.
  819   $answer_evaluator->install_pre_filter(sub{
  820     my $rh_ans = shift;
  821     my $length = $rh_ans->{rm_correct_ans}->[1];
  822     my $dim = $rh_ans->{rm_correct_ans}->[2];
  823     if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
  824     {
  825 
  826       $rh_ans->{score} = 0;
  827       if( $rh_ans->{help} =~ /dim|verbose/ )
  828       {
  829         $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
  830       }else{
  831         $rh_ans->throw_error('EVAL');
  832       }
  833     }
  834     for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ )
  835     {
  836       if( $length != $rh_ans->{ra_student_ans}->[$i]->[1])
  837       {
  838         $rh_ans->{score} = 0;
  839         if( $rh_ans->{help} =~ /length|verbose/ )
  840         {
  841           $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
  842         }else{
  843           $rh_ans->throw_error('EVAL');
  844         }
  845       }
  846     }
  847     $rh_ans;
  848   });
  849   # Install prefilter for various modes
  850   if( $opt{mode} ne 'basis' )
  851   {
  852     if( $opt{mode} =~ /orthogonal|orthonormal/ )
  853     {
  854       $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
  855     }
  856 
  857     if( $opt{mode} =~ /unit|orthonormal/ )
  858     {
  859       $answer_evaluator->install_pre_filter(\&are_unit_vecs);
  860 
  861     }
  862   }
  863 
  864   $answer_evaluator->install_evaluator(\&compare_vec_solution, %opt);
  865 
  866   $answer_evaluator->install_post_filter(
  867     sub {my $rh_ans = shift;
  868         if ($rh_ans->catch_error('SYNTAX') ) {
  869           $rh_ans->{ans_message} = $rh_ans->{error_message};
  870           $rh_ans->clear_error('SYNTAX');
  871         }
  872         if ($rh_ans->catch_error('EVAL') ) {
  873           $rh_ans->{ans_message} = $rh_ans->{error_message};
  874           $rh_ans->clear_error('EVAL');
  875         }
  876         $rh_ans;
  877     }
  878   );
  879   $answer_evaluator;
  880 
  881 }
  882 
  883 
  884 sub compare_vec_solution {
  885   my ( $rh_ans, %options ) = @_ ;
  886   my @space = @{$rh_ans->{ra_student_ans}};
  887   my $solution = shift @space;
  888 
  889   # A lot of the follosing code was taken from Matrix::proj_coeff
  890   # calling this method recursively would be a waste of time since
  891   # the prof's matrix never changes and solve_LR is an expensive
  892   # operation. This way it is only done once.
  893   my $matrix = $rh_ans->{rm_correct_ans};
  894   my ($dim,$x_vector, $base_matrix);
  895   my $errors = undef;
  896   my $lin_space_tr= ~ $matrix;
  897   $matrix = $lin_space_tr * $matrix;
  898   my $matrix_lr = $matrix->decompose_LR();
  899 
  900   #this section determines whether or not the first vector, a solution to
  901   #the system, is a linear combination of the prof's vectors in which there
  902   #is a nonzero coefficient on the first term, the prof's solution to the system
  903   $solution = $lin_space_tr*$solution;
  904   ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($solution);
  905   if( $dim ){
  906     $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.
  907     $rh_ans->{score} = 0;
  908     $rh_ans;
  909   }elsif( abs($x_vector->[0][0][0]) <= $options{zeroLevelTol} )
  910   {
  911     $rh_ans->{score} = 0;
  912     $rh_ans;
  913   }else{
  914   $rh_ans->{score} = 1;
  915   my @correct_space = @{$rh_ans->{old_correct_ans}};
  916   shift @correct_space;
  917   $rh_ans->{rm_correct_ans} = Matrix->new_from_col_vecs(\@correct_space);
  918   $rh_ans->{ra_student_ans} = \@space;
  919   return compare_basis( $rh_ans, %options );
  920   }
  921 }
  922 
  923 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9