[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 1896 - (download) (as text) (annotate)
Wed Mar 17 00:45:28 2004 UTC (15 years, 10 months ago) by gage
File size: 28971 byte(s)
Changed the naming of arrays from ArRaY[0,0,0] to ArRaY__0:0:0:__

This involved changes in PG.pl and PGmorematrixmacros (ans_array_filter)

Made other cosmetic fixes to code.  Added names to many filters to help with
debugging.  It seems to work for now.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9