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