Parent Directory
| 
Revision Log
remove unneccsary shebang lines Arnie
1 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 sub swap_rows{ 30 31 warn "Usage: \$new_matrix = swap_rows(\$matrix,\$row1,\$row2);" 32 if (@_ != 3); 33 my $matrix = $_[0]; 34 my ($i,$j) = ($_[1],$_[2]); 35 warn "Error: Rows to be swapped must exist!" 36 if ($i>@$matrix or $j >@$matrix); 37 warn "Warning: Swapping the same row is pointless" 38 if ($i==$j); 39 my $cols = @{$matrix->[0]}; 40 my $B = new Matrix(@$matrix,$cols); 41 foreach my $k (1..$cols){ 42 $B->assign($i,$k,element $matrix($j,$k)); 43 $B->assign($j,$k,element $matrix($i,$k)); 44 } 45 return $B; 46 } 47 48 sub row_mult{ 49 50 warn "Usage: \$new_matrix = row_mult(\$matrix,\$scalar,\$row);" 51 if (@_ != 3); 52 my $matrix = $_[0]; 53 my ($scalar,$row) = ($_[1],$_[2]); 54 warn "Undefined row multiplication" 55 if ($row > @$matrix); 56 my $B = new Matrix(@$matrix,@{$matrix->[0]}); 57 foreach my $j (1..@{$matrix->[0]}) { 58 $B->assign($row,$j,$scalar*element $matrix($row,$j)); 59 } 60 return $B; 61 } 62 63 sub linear_combo{ 64 65 warn "Usage: \$new_matrix = linear_combo(\$matrix,\$scalar,\$row1,\$row2);" 66 if (@_ != 4); 67 my $matrix = $_[0]; 68 my ($scalar,$row1,$row2) = ($_[1],$_[2],$_[3]); 69 warn "Undefined row in multiplication" 70 if ($row1>@$matrix or $row2>@$matrix); 71 warn "Warning: Using the same row" 72 if ($row1==$row2); 73 my $B = new Matrix(@$matrix,@{$matrix->[0]}); 74 foreach my $j (1..@$matrix) { 75 my ($t1,$t2) = (element $matrix($row1,$j),element $matrix($row2,$j)); 76 $B->assign($row2,$j,$scalar*$t1+$t2); 77 } 78 return $B; 79 } 80 81 =head3 basis_cmp() 82 83 Compares a list of vectors by finding the change of coordinate matrix 84 from the Prof's vectors to the students, and then taking the determinant of 85 that to determine the existence of the change of coordinate matrix going the 86 other way. 87 88 ANS( basis_cmp( vectors_as_array_ref_in_array_ref, options_hash ) ); 89 90 1. a reference to an array of correct vectors 91 2. a hash with the following keys (all optional): 92 mode -- 'basis' (default) (only a basis allowed) 93 'orthogonal' (only an orthogonal basis is allowed) 94 'unit' (only unit vectors in the basis allowed) 95 'orthonormal' (only orthogonal unit vectors in basis allowed) 96 zeroLevelTol -- absolute tolerance to allow when answer is close 97 to zero 98 99 debug -- if set to 1, provides verbose listing of 100 hash entries throughout fliters. 101 102 help -- 'none' (default) (is quiet on all errors) 103 'dim' (Tells student if wrong number of vectors are entered) 104 'length' (Tells student if there is a vector of the wrong length) 105 'orthogonal' (Tells student if their vectors are not orthogonal) 106 (This is only in orthogonal mode) 107 'unit' (Tells student if there is a vector not of unit length) 108 (This is only in unit mode) 109 'orthonormal' (Gives errors from orthogonal and orthonormal) 110 (This is only in orthonormal mode) 111 'verbose' (Gives all the above answer messages) 112 113 Returns an answer evaluator. 114 115 EXAMPLES: 116 117 basis_cmp([[1,0,0],[0,1,0],[0,0,1]]) 118 -- correct answer is any basis for R^3. 119 basis_cmp([1,0,2,0],[0,1,0,0], 'mode'=>orthonormal ) 120 -- correct answer is any orthonormal basis 121 for this space such as: 122 [1/sqrt(3),0,2/sqrt(3),0],[0,1,0,0] 123 124 =cut 125 126 127 sub basis_cmp { 128 my $correctAnswer = shift; 129 my %opt = @_; 130 131 set_default_options( \%opt, 132 'zeroLevelTol' => $main::functZeroLevelTolDefault, 133 'debug' => 0, 134 'mode' => 'basis', 135 'help' => 'none', 136 ); 137 138 # produce answer evaluator 139 BASIS_CMP( 140 'correct_ans' => $correctAnswer, 141 'zeroLevelTol' => $opt{'zeroLevelTol'}, 142 'debug' => $opt{'debug'}, 143 'mode' => $opt{'mode'}, 144 'help' => $opt{'help'}, 145 ); 146 } 147 148 =head BASIS_CMP 149 150 Made to keep the same format as num_cmp and fun_cmp. 151 152 =cut 153 154 sub BASIS_CMP { 155 my %mat_params = @_; 156 my $zeroLevelTol = $mat_params{'zeroLevelTol'}; 157 158 # Check that everything is defined: 159 $mat_params{debug} = 0 unless defined($mat_params{debug}); 160 $zeroLevelTol = $main::functZeroLevelTolDefault unless defined $zeroLevelTol; 161 $mat_params{'zeroLevelTol'} = $zeroLevelTol; 162 163 ## This is where the correct answer should be checked someday. 164 my $matrix = Matrix->new_from_col_vecs($mat_params{'correct_ans'}); 165 166 #construct the answer evaluator 167 my $answer_evaluator = new AnswerEvaluator; 168 169 $answer_evaluator->{debug} = $mat_params{debug}; 170 171 $answer_evaluator->ans_hash( correct_ans => pretty_print($mat_params{correct_ans}), 172 rm_correct_ans => $matrix, 173 zeroLevelTol => $mat_params{zeroLevelTol}, 174 debug => $mat_params{debug}, 175 mode => $mat_params{mode}, 176 help => $mat_params{help}, 177 ); 178 179 $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift; 180 $rh_ans->{student_ans} =~ s/\s+//g; # remove all whitespace 181 $rh_ans; 182 }); 183 184 $answer_evaluator->install_pre_filter(\&math_constants); 185 $answer_evaluator->install_pre_filter(\&vec_list_string);#ra_student_ans is now the students answer as an array of vectors 186 # anonymous subroutine to check dimension and length of the student vectors 187 # if either is wrong, the answer is wrong. 188 $answer_evaluator->install_pre_filter(sub{ 189 my $rh_ans = shift; 190 my $length = $rh_ans->{rm_correct_ans}->[1]; 191 my $dim = $rh_ans->{rm_correct_ans}->[2]; 192 if( $dim != scalar(@{$rh_ans->{ra_student_ans}})) 193 { 194 195 $rh_ans->{score} = 0; 196 if( $rh_ans->{help} =~ /dim|verbose/ ) 197 { 198 $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.'); 199 }else{ 200 $rh_ans->throw_error('EVAL'); 201 } 202 } 203 for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ ) 204 { 205 if( $length != $rh_ans->{ra_student_ans}->[$i]->[1]) 206 { 207 $rh_ans->{score} = 0; 208 if( $rh_ans->{help} =~ /length|verbose/ ) 209 { 210 $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.'); 211 }else{ 212 $rh_ans->throw_error('EVAL'); 213 } 214 } 215 } 216 $rh_ans; 217 }); 218 # Install prefilter for various modes 219 if( $mat_params{mode} ne 'basis' ) 220 { 221 if( $mat_params{mode} =~ /orthogonal|orthonormal/ ) 222 { 223 $answer_evaluator->install_pre_filter(sub{ 224 my $rh_ans = shift; 225 my @vecs = @{$rh_ans->{ra_student_ans}}; 226 my ($i,$j) = (0,0); 227 my $num = scalar(@vecs); 228 my $length = $vecs[0]->[1]; 229 230 for( ; $i < $num ; $i ++ ) 231 { 232 for( $j = $i+1; $j < $num ; $j++ ) 233 { 234 my $sum = 0; 235 my $k = 0; 236 237 for( ; $k < $length; $k++ ) { 238 $sum += $vecs[$i]->[0][$k][0]*$vecs[$j]->[0][$k][0]; 239 } 240 241 if( $sum > $mat_params{zeroLevelTol} ) 242 { 243 $rh_ans->{score} = 0; 244 if( $rh_ans->{help} =~ /orthogonal|orthonormal|verbose/ ) 245 { 246 $rh_ans->throw_error('EVAL','You have entered vectors which are not orthogonal. '); 247 }else{ 248 $rh_ans->throw_error('EVAL'); 249 } 250 } 251 } 252 } 253 254 255 $rh_ans; 256 }); 257 } 258 259 if( $mat_params{mode} =~ /unit|orthonormal/ ) 260 { 261 $answer_evaluator->install_pre_filter(sub{ 262 my $rh_ans = shift; 263 my @vecs = @{$rh_ans->{ra_student_ans}}; 264 my $i = 0; 265 my $num = scalar(@vecs); 266 my $length = $vecs[0]->[1]; 267 268 for( ; $i < $num ; $i ++ ) 269 { 270 my $sum = 0; 271 my $k = 0; 272 273 for( ; $k < $length; $k++ ) { 274 $sum += $vecs[$i]->[0][$k][0]*$vecs[$i]->[0][$k][0]; 275 } 276 if( abs(sqrt($sum) - 1) > $mat_params{zeroLevelTol} ) 277 { 278 $rh_ans->{score} = 0; 279 280 if( $rh_ans->{help} =~ /unit|orthonormal|verbose/ ) 281 { 282 $rh_ans->throw_error('EVAL','You have entered vector(s) which are not of unit length.'); 283 }else{ 284 $rh_ans->throw_error('EVAL'); 285 } 286 } 287 } 288 289 290 $rh_ans; 291 }); 292 293 } 294 } 295 $answer_evaluator->install_evaluator(\&compare_basis, %mat_params); 296 $answer_evaluator->install_post_filter( 297 sub {my $rh_ans = shift; 298 if ($rh_ans->catch_error('SYNTAX') ) { 299 $rh_ans->{ans_message} = $rh_ans->{error_message}; 300 $rh_ans->clear_error('SYNTAX'); 301 } 302 if ($rh_ans->catch_error('EVAL') ) { 303 $rh_ans->{ans_message} = $rh_ans->{error_message}; 304 $rh_ans->clear_error('EVAL'); 305 } 306 $rh_ans; 307 } 308 ); 309 $answer_evaluator; 310 } 311 312 =head4 compare_basis 313 314 compare_basis( $ans_hash, %options); 315 316 {ra_student_ans}, # a reference to the array of students answer vectors 317 {rm_correct_ans}, # a reference to the correct answer matrix 318 %options 319 ) 320 321 =cut 322 323 sub compare_basis { 324 my ($rh_ans, %options) = @_; 325 my @ch_coord; 326 my @vecs = @{$rh_ans->{ra_student_ans}}; 327 328 # A lot of the follosing code was taken from Matrix::proj_coeff 329 # calling this method recursively would be a waste of time since 330 # the prof's matrix never changes and solve_LR is an expensive 331 # operation. This way it is only done once. 332 my $matrix = $rh_ans->{rm_correct_ans}; 333 my ($dim,$x_vector, $base_matrix); 334 my $errors = undef; 335 my $lin_space_tr= ~ $matrix; 336 $matrix = $lin_space_tr * $matrix; 337 my $matrix_lr = $matrix->decompose_LR(); 338 339 #finds the coefficient vectors for each of the students vectors 340 for( my $i = 0; $i < scalar(@{$rh_ans->{ra_student_ans}}) ; $i++ ) 341 { 342 343 $vecs[$i] = $lin_space_tr*$vecs[$i]; 344 ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($vecs[$i]); 345 push( @ch_coord, $x_vector ); 346 $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. 347 } 348 349 if( defined($errors)) 350 { 351 $rh_ans->throw_error('EVAL', $errors) ; 352 }else{ 353 my $ch_coord_mat = Matrix->new_from_col_vecs(\@ch_coord);#creates change of coordinate matrix 354 #existence of this matrix implies that 355 #the all of the students answers are a 356 #linear combo of the prof's 357 $ch_coord_mat = $ch_coord_mat->decompose_LR(); 358 359 if( $ch_coord_mat->det_LR() > $options{zeroLevelTol} )# if the det of the change of coordinate matrix is 360 # non-zero, this implies the existence of an inverse 361 # which implies all of the prof's vectors are a linear 362 # combo of the students vectors, showing containment 363 # both ways. 364 { 365 # I think sometimes if the students space has the same dimension as the profs space it 366 # will get projected into the profs space even if it isn't a basis for that space. 367 # this just checks that the prof's matrix times the change of coordinate matrix is actually 368 #the students matrix 369 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} ) 370 { 371 $rh_ans->{score} = 1; 372 }else{ 373 $rh_ans->{score} = 0; 374 } 375 } 376 else{ 377 $rh_ans->{score}=0; 378 } 379 } 380 $rh_ans; 381 382 } 383 384 385 =head 2 vec_list_string 386 387 This is a check_syntax type method (in fact I borrowed some of that method's code) for vector input. 388 The student needs to enter vectors like: [1,0,0],[1,2,3],[0,9/sqrt(10),1/sqrt(10)] 389 Each entry can contain functions and operations and the usual math constants (pi and e). 390 The vectors, however can not be added or multiplied or scalar multiplied by the student. 391 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. 392 Right now the method basically ignores every thing outside the vectors. Also, an unmatched open parenthesis is caught, 393 but a unmatched close parenthesis ends the vector, and since everything outside is ignored, no error is sent (other than the 394 later when the length of the vectors is checked. 395 In the end, the method returns an array of Matrix objects. 396 397 398 =cut 399 400 sub vec_list_string{ 401 my $rh_ans = shift; 402 my %options = @_; 403 my $i; 404 my $entry = ""; 405 my $char; 406 my @paren_stack; 407 my $length = length($rh_ans->{student_ans}); 408 my @temp; 409 my $j = 0; 410 my @answers; 411 my $paren; 412 my $display_ans; 413 414 for( $i = 0; $i < $length ; $i++ ) 415 { 416 $char = substr($rh_ans->{student_ans},$i,1); 417 418 if( $char =~ /\(|\[|\{/ ){ 419 push( @paren_stack, $char ) 420 } 421 422 if( !( $char =~ /\(|\[|\{/ && scalar(@paren_stack) == 1 ) ) 423 { 424 if( $char !~ /,|\)|\]|\}/ ){ 425 $entry .= $char; 426 }else{ 427 if( $char =~ /,/ || ( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1 ) ) 428 { 429 if( length($entry) == 0 ){ 430 if( $char !~ /,/ ){ 431 $rh_ans->throw_error('EVAL','There is a syntax error in your answer'); 432 }else{ 433 $rh_ans->{preview_text_string} .= ","; 434 $rh_ans->{preview_latex_string} .= ","; 435 $display_ans .= ","; 436 } 437 }else{ 438 439 # This parser code was origianally taken from PGanswermacros::check_syntax 440 # but parts of it needed to be slighty modified for this context 441 my $parser = new AlgParserWithImplicitExpand; 442 my $ret = $parser -> parse($entry); #for use with loops 443 444 if ( ref($ret) ) { ## parsed successfully 445 $parser -> tostring(); 446 $parser -> normalize(); 447 $entry = $parser -> tostring(); 448 $rh_ans->{preview_text_string} .= $entry.","; 449 $rh_ans->{preview_latex_string} .= $parser -> tolatex().","; 450 451 } else { ## error in parsing 452 453 $rh_ans->{'student_ans'} = 'syntax error:'.$display_ans. $parser->{htmlerror}, 454 $rh_ans->{'ans_message'} = $display_ans.$parser -> {error_msg}, 455 $rh_ans->{'preview_text_string'} = '', 456 $rh_ans->{'preview_latex_string'} = '', 457 $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR"); 458 } 459 460 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry); 461 462 if ($PG_eval_errors) { 463 $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ; 464 $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors); 465 last; 466 } else { 467 $entry = prfmt($inVal,$options{format}); 468 $display_ans .= $entry.","; 469 push(@temp , $entry); 470 } 471 472 if( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1) 473 { 474 pop @paren_stack; 475 chop($rh_ans->{preview_text_string}); 476 chop($rh_ans->{preview_latex_string}); 477 chop($display_ans); 478 $rh_ans->{preview_text_string} .= "]"; 479 $rh_ans->{preview_latex_string} .= "]"; 480 $display_ans .= "]"; 481 if( scalar(@temp) > 0 ) 482 { 483 push( @answers,Matrix->new_from_col_vecs([\@temp])); 484 while(scalar(@temp) > 0 ){ 485 pop @temp; 486 } 487 }else{ 488 $rh_ans->throw_error('EVAL','There is a syntax error in your answer.'); 489 } 490 } 491 } 492 $entry = ""; 493 }else{ 494 $paren = pop @paren_stack; 495 if( scalar(@paren_stack) > 0 ){ 496 #this uses ASCII to check if the parens match up 497 # in ASCII ord ( = 40 , ord ) = 41 , ord [ = 91 , 498 # ord ] = 93 , ord { = 123 , ord } = 125 499 if( (ord($char) - ord($paren) <= 2) ){ 500 $entry = $entry . $char; 501 }else{ 502 $rh_ans->throw_error('EVAL','There is a syntax error in your answer'); 503 } 504 } 505 } 506 } 507 }else{ 508 $rh_ans->{preview_text_string} .= "["; 509 $rh_ans->{preview_latex_string} .= "["; 510 $display_ans .= "["; 511 } 512 } 513 $rh_ans->{ra_student_ans} = \@answers; 514 $rh_ans->{student_ans} = $display_ans unless $rh_ans->{error_flag}; 515 $rh_ans; 516 } 517 518 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |