[system] / trunk / pg / macros / PGmorematrixmacros.pl Repository: Repository Listing bbplugincoursesdistsnplrochestersystemwww

# View of /trunk/pg/macros/PGmorematrixmacros.pl

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

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

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

-- Mike


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