Parent Directory
| 
Revision Log
committed the wrong thing
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 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 $answer_evaluator->ans_hash( correct_ans => pretty_print($mat_params{correct_ans}), 171 rm_correct_ans => $matrix, 172 zeroLevelTol => $mat_params{zeroLevelTol}, 173 debug => $mat_params{debug}, 174 mode => $mat_params{mode}, 175 help => $mat_params{help}, 176 ); 177 178 $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift; 179 $rh_ans->{student_ans} =~ s/\s+//g; # remove all whitespace 180 $rh_ans; 181 }); 182 $answer_evaluator->install_pre_filter(sub{my $rh_ans = shift; my @options = @_; 183 if( $rh_ans->{ans_label} =~ /ArRaY/ ){ 184 $rh_ans = ans_array_filter($rh_ans,@options); 185 my @student_array = @{$rh_ans->{ra_student_ans}}; 186 my @array = (); 187 for( my $i = 0; $i < scalar(@student_array) ; $i ++ ) 188 { 189 push( @array, Matrix->new_from_array_ref($student_array[$i])); 190 } 191 $rh_ans->{ra_student_ans} = \@array; 192 $rh_ans; 193 }else{ 194 $rh_ans->{student_ans} = math_constants($rh_ans->{student_ans}); 195 vec_list_string($rh_ans,@options); 196 } 197 198 });#ra_student_ans is now the students answer as an array of vectors 199 # anonymous subroutine to check dimension and length of the student vectors 200 # if either is wrong, the answer is wrong. 201 $answer_evaluator->install_pre_filter(sub{ 202 my $rh_ans = shift; 203 my $length = $rh_ans->{rm_correct_ans}->[1]; 204 my $dim = $rh_ans->{rm_correct_ans}->[2]; 205 if( $dim != scalar(@{$rh_ans->{ra_student_ans}})) 206 { 207 208 $rh_ans->{score} = 0; 209 if( $rh_ans->{help} =~ /dim|verbose/ ) 210 { 211 $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.'); 212 }else{ 213 $rh_ans->throw_error('EVAL'); 214 } 215 } 216 for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ ) 217 { 218 if( $length != $rh_ans->{ra_student_ans}->[$i]->[1]) 219 { 220 $rh_ans->{score} = 0; 221 if( $rh_ans->{help} =~ /length|verbose/ ) 222 { 223 $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.'); 224 }else{ 225 $rh_ans->throw_error('EVAL'); 226 } 227 } 228 } 229 $rh_ans; 230 }); 231 # Install prefilter for various modes 232 if( $mat_params{mode} ne 'basis' ) 233 { 234 if( $mat_params{mode} =~ /orthogonal|orthonormal/ ) 235 { 236 $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs); 237 } 238 239 if( $mat_params{mode} =~ /unit|orthonormal/ ) 240 { 241 $answer_evaluator->install_pre_filter(\&are_unit_vecs); 242 243 } 244 } 245 $answer_evaluator->install_evaluator(\&compare_basis, %mat_params); 246 $answer_evaluator->install_post_filter( 247 sub {my $rh_ans = shift; 248 if ($rh_ans->catch_error('SYNTAX') ) { 249 $rh_ans->{ans_message} = $rh_ans->{error_message}; 250 $rh_ans->clear_error('SYNTAX'); 251 } 252 if ($rh_ans->catch_error('EVAL') ) { 253 $rh_ans->{ans_message} = $rh_ans->{error_message}; 254 $rh_ans->clear_error('EVAL'); 255 } 256 $rh_ans; 257 } 258 ); 259 $answer_evaluator; 260 } 261 262 =head4 compare_basis 263 264 compare_basis( $ans_hash, %options); 265 266 {ra_student_ans}, # a reference to the array of students answer vectors 267 {rm_correct_ans}, # a reference to the correct answer matrix 268 %options 269 ) 270 271 =cut 272 273 sub compare_basis { 274 my ($rh_ans, %options) = @_; 275 my @ch_coord; 276 my @vecs = @{$rh_ans->{ra_student_ans}}; 277 278 # A lot of the follosing code was taken from Matrix::proj_coeff 279 # calling this method recursively would be a waste of time since 280 # the prof's matrix never changes and solve_LR is an expensive 281 # operation. This way it is only done once. 282 my $matrix = $rh_ans->{rm_correct_ans}; 283 my ($dim,$x_vector, $base_matrix); 284 my $errors = undef; 285 my $lin_space_tr= ~ $matrix; 286 $matrix = $lin_space_tr * $matrix; 287 my $matrix_lr = $matrix->decompose_LR(); 288 289 #finds the coefficient vectors for each of the students vectors 290 for( my $i = 0; $i < scalar(@{$rh_ans->{ra_student_ans}}) ; $i++ ) 291 { 292 293 $vecs[$i] = $lin_space_tr*$vecs[$i]; 294 ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($vecs[$i]); 295 push( @ch_coord, $x_vector ); 296 $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. 297 } 298 299 if( defined($errors)) 300 { 301 $rh_ans->throw_error('EVAL', $errors) ; 302 }else{ 303 my $ch_coord_mat = Matrix->new_from_col_vecs(\@ch_coord);#creates change of coordinate matrix 304 #existence of this matrix implies that 305 #the all of the students answers are a 306 #linear combo of the prof's 307 $ch_coord_mat = $ch_coord_mat->decompose_LR(); 308 309 if( abs($ch_coord_mat->det_LR()) > $options{zeroLevelTol} )# if the det of the change of coordinate matrix is 310 # non-zero, this implies the existence of an inverse 311 # which implies all of the prof's vectors are a linear 312 # combo of the students vectors, showing containment 313 # both ways. 314 { 315 # I think sometimes if the students space has the same dimension as the profs space it 316 # will get projected into the profs space even if it isn't a basis for that space. 317 # this just checks that the prof's matrix times the change of coordinate matrix is actually 318 #the students matrix 319 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} ) 320 { 321 $rh_ans->{score} = 1; 322 }else{ 323 $rh_ans->{score} = 0; 324 } 325 } 326 else{ 327 $rh_ans->{score}=0; 328 } 329 } 330 $rh_ans; 331 332 } 333 334 335 =head 2 vec_list_string 336 337 This is a check_syntax type method (in fact I borrowed some of that method's code) for vector input. 338 The student needs to enter vectors like: [1,0,0],[1,2,3],[0,9/sqrt(10),1/sqrt(10)] 339 Each entry can contain functions and operations and the usual math constants (pi and e). 340 The vectors, however can not be added or multiplied or scalar multiplied by the student. 341 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. 342 Right now the method basically ignores every thing outside the vectors. Also, an unmatched open parenthesis is caught, 343 but a unmatched close parenthesis ends the vector, and since everything outside is ignored, no error is sent (other than the 344 later when the length of the vectors is checked. 345 In the end, the method returns an array of Matrix objects. 346 347 348 =cut 349 350 sub vec_list_string{ 351 my $rh_ans = shift; 352 my %options = @_; 353 my $i; 354 my $entry = ""; 355 my $char; 356 my @paren_stack; 357 my $length = length($rh_ans->{student_ans}); 358 my @temp; 359 my $j = 0; 360 my @answers; 361 my $paren; 362 my $display_ans; 363 364 for( $i = 0; $i < $length ; $i++ ) 365 { 366 $char = substr($rh_ans->{student_ans},$i,1); 367 368 if( $char =~ /\(|\[|\{/ ){ 369 push( @paren_stack, $char ) 370 } 371 372 if( !( $char =~ /\(|\[|\{/ && scalar(@paren_stack) == 1 ) ) 373 { 374 if( $char !~ /,|\)|\]|\}/ ){ 375 $entry .= $char; 376 }else{ 377 if( $char =~ /,/ || ( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1 ) ) 378 { 379 if( length($entry) == 0 ){ 380 if( $char !~ /,/ ){ 381 $rh_ans->throw_error('EVAL','There is a syntax error in your answer'); 382 }else{ 383 $rh_ans->{preview_text_string} .= ","; 384 $rh_ans->{preview_latex_string} .= ","; 385 $display_ans .= ","; 386 } 387 }else{ 388 389 # This parser code was origianally taken from PGanswermacros::check_syntax 390 # but parts of it needed to be slighty modified for this context 391 my $parser = new AlgParserWithImplicitExpand; 392 my $ret = $parser -> parse($entry); #for use with loops 393 394 if ( ref($ret) ) { ## parsed successfully 395 $parser -> tostring(); 396 $parser -> normalize(); 397 $entry = $parser -> tostring(); 398 $rh_ans->{preview_text_string} .= $entry.","; 399 $rh_ans->{preview_latex_string} .= $parser -> tolatex().","; 400 401 } else { ## error in parsing 402 403 $rh_ans->{'student_ans'} = 'syntax error:'.$display_ans. $parser->{htmlerror}, 404 $rh_ans->{'ans_message'} = $display_ans.$parser -> {error_msg}, 405 $rh_ans->{'preview_text_string'} = '', 406 $rh_ans->{'preview_latex_string'} = '', 407 $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR"); 408 } 409 410 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry); 411 412 if ($PG_eval_errors) { 413 $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ; 414 $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors); 415 last; 416 } else { 417 $entry = prfmt($inVal,$options{format}); 418 $display_ans .= $entry.","; 419 push(@temp , $entry); 420 } 421 422 if( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1) 423 { 424 pop @paren_stack; 425 chop($rh_ans->{preview_text_string}); 426 chop($rh_ans->{preview_latex_string}); 427 chop($display_ans); 428 $rh_ans->{preview_text_string} .= "]"; 429 $rh_ans->{preview_latex_string} .= "]"; 430 $display_ans .= "]"; 431 if( scalar(@temp) > 0 ) 432 { 433 push( @answers,Matrix->new_from_col_vecs([\@temp])); 434 while(scalar(@temp) > 0 ){ 435 pop @temp; 436 } 437 }else{ 438 $rh_ans->throw_error('EVAL','There is a syntax error in your answer.'); 439 } 440 } 441 } 442 $entry = ""; 443 }else{ 444 $paren = pop @paren_stack; 445 if( scalar(@paren_stack) > 0 ){ 446 #this uses ASCII to check if the parens match up 447 # in ASCII ord ( = 40 , ord ) = 41 , ord [ = 91 , 448 # ord ] = 93 , ord { = 123 , ord } = 125 449 if( (ord($char) - ord($paren) <= 2) ){ 450 $entry = $entry . $char; 451 }else{ 452 $rh_ans->throw_error('EVAL','There is a syntax error in your answer'); 453 } 454 } 455 } 456 } 457 }else{ 458 $rh_ans->{preview_text_string} .= "["; 459 $rh_ans->{preview_latex_string} .= "["; 460 $display_ans .= "["; 461 } 462 } 463 $rh_ans->{ra_student_ans} = \@answers; 464 $rh_ans->{student_ans} = $display_ans unless $rh_ans->{error_flag}; 465 $rh_ans; 466 } 467 468 sub ans_array_filter{ 469 my $rh_ans = shift; 470 my %options = @_; 471 $rh_ans->{ans_label} =~ /ArRaY(\d+)\[\d+,\d+,\d+\]/; 472 my $ans_num = $1; 473 my @keys = grep /ArRaY$ans_num/, keys(%{$main::inputs_ref}); 474 my $key; 475 my @array = (); 476 #my @latex = (); 477 my ($i,$j,$k) = (0,0,0); 478 479 #the keys aren't in order, so their info has to be put into the array before doing anything with it 480 foreach $key (@keys){ 481 $key =~ /ArRaY\d+\[(\d+),(\d+),(\d+)\]/; 482 ($i,$j,$k) = ($1,$2,$3); 483 $array[$i][$j][$k] = ${$main::inputs_ref}{'ArRaY'.$ans_num.'['.$i.','.$j.','.$k.']'}; 484 } 485 486 my $display_ans = ""; 487 488 for( $i=0; $i < scalar(@array) ; $i ++ ) 489 { 490 $display_ans .= " ["; 491 $rh_ans->{preview_text_string} .= ' ['; 492 $rh_ans->{preview_latex_string} .= ' ['; 493 for( $j = 0; $j < scalar( @{$array[$i]} ) ; $j++ ) 494 { 495 $display_ans .= " ["; 496 $rh_ans->{preview_text_string} .= ' ['; 497 $rh_ans->{preview_latex_string} .= ' ['; 498 for( $k = 0; $k < scalar( @{$array[$i][$j]} ) ; $k ++ ){ 499 my $entry = $array[$i][$j][$k]; 500 $entry = math_constants($entry); 501 # This parser code was origianally taken from PGanswermacros::check_syntax 502 # but parts of it needed to be slighty modified for this context 503 my $parser = new AlgParserWithImplicitExpand; 504 my $ret = $parser -> parse($entry); #for use with loops 505 506 if ( ref($ret) ) { ## parsed successfully 507 $parser -> tostring(); 508 $parser -> normalize(); 509 $entry = $parser -> tostring(); 510 $rh_ans->{preview_text_string} .= $entry.","; 511 $rh_ans->{preview_latex_string} .= $parser -> tolatex().","; 512 #$latex[$i][$j][$k] = "\\{".$parser -> tolatex()."\\}"; 513 514 } else { ## error in parsing 515 $rh_ans->{'student_ans'} = 'syntax error:'.$display_ans. $parser->{htmlerror}, 516 $rh_ans->{'ans_message'} = $display_ans.$parser -> {error_msg}, 517 $rh_ans->{'preview_text_string'} = '', 518 $rh_ans->{'preview_latex_string'} = '', 519 $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR"); 520 } 521 522 my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry); 523 if ($PG_eval_errors) { 524 $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ; 525 $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors); 526 last; 527 } else { 528 $entry = prfmt($inVal,$options{format}); 529 $display_ans .= $entry.","; 530 $array[$i][$j][$k] = $entry; 531 } 532 } 533 chop($rh_ans->{preview_text_string}); 534 chop($rh_ans->{preview_latex_string}); 535 chop($display_ans); 536 $rh_ans->{preview_text_string} .= '] ,'; 537 $rh_ans->{preview_latex_string} .= '] ,'; 538 $display_ans .= '] ,'; 539 540 } 541 chop($rh_ans->{preview_text_string}); 542 chop($rh_ans->{preview_latex_string}); 543 chop($display_ans); 544 $rh_ans->{preview_text_string} .= '] ,'; 545 $rh_ans->{preview_latex_string} .= '] ,'; 546 $display_ans .= '] ,'; 547 } 548 chop($rh_ans->{preview_text_string}); 549 chop($rh_ans->{preview_latex_string}); 550 chop($display_ans); 551 552 #for( $i = 0 ; $i < scalar( @latex ); $i++ ){ 553 # $latex[$i] = display_matrix($latex[$i]); 554 #} 555 #$rh_ans->{preview_latex_string} = mbox(\@latex); 556 my @temp = (); 557 for( $i = 0 ; $i < scalar( @array ); $i++ ){ 558 push @temp , display_matrix($array[$i], 'left'=>'.', 'right'=>'.'); 559 push @temp , "," unless $i == scalar(@array) - 1; 560 } 561 $rh_ans->{student_ans} = mbox(\@temp); 562 $rh_ans->{ra_student_ans} = \@array; 563 564 $rh_ans; 565 566 } 567 568 569 sub are_orthogonal_vecs{ 570 my ($vec_ref , %opts) = @_; 571 my @vecs = (); 572 if( ref($vec_ref) eq 'AnswerHash' ) 573 { 574 @vecs = @{$vec_ref->{ra_student_ans}}; 575 }else{ 576 @vecs = @{$vec_ref}; 577 } 578 my ($i,$j) = (0,0); 579 580 my $num = scalar(@vecs); 581 my $length = $vecs[0]->[1]; 582 583 for( ; $i < $num ; $i ++ ) 584 { 585 for( $j = $i+1; $j < $num ; $j++ ) 586 { 587 my $sum = 0; 588 my $k = 0; 589 590 for( ; $k < $length; $k++ ) { 591 $sum += $vecs[$i]->[0][$k][0]*$vecs[$j]->[0][$k][0]; 592 } 593 594 if( $sum > $main::functZeroLevelTolDefault ) 595 { 596 if( ref( $vec_ref ) eq 'AnswerHash' ){ 597 $vec_ref->{score} = 0; 598 if( $vec_ref->{help} =~ /orthogonal|orthonormal|verbose/ ) 599 { 600 $vec_ref->throw_error('EVAL','You have entered vectors which are not orthogonal. '); 601 }else{ 602 $vec_ref->throw_error('EVAL'); 603 } 604 return $vec_ref; 605 }else{ 606 return 0; 607 } 608 } 609 } 610 } 611 if( ref( $vec_ref ) eq 'AnswerHash' ){ 612 $vec_ref->{score} = 1; 613 $vec_ref; 614 }else{ 615 1; 616 } 617 } 618 619 sub are_unit_vecs{ 620 my ( $vec_ref,%opts ) = @_; 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 $i = 0; 630 my $num = scalar(@vecs); 631 my $length = $vecs[0]->[1]; 632 633 for( ; $i < $num ; $i ++ ) 634 { 635 my $sum = 0; 636 my $k = 0; 637 638 for( ; $k < $length; $k++ ) { 639 $sum += $vecs[$i]->[0][$k][0]*$vecs[$i]->[0][$k][0]; 640 } 641 if( abs(sqrt($sum) - 1) > $main::functZeroLevelTolDefault ) 642 { 643 if( ref( $vec_ref ) eq 'AnswerHash' ){ 644 $vec_ref->{score} = 0; 645 if( $vec_ref->{help} =~ /unit|orthonormal|verbose/ ) 646 { 647 $vec_ref->throw_error('EVAL','You have entered vector(s) which are not of unit length.'); 648 }else{ 649 $vec_ref->throw_error('EVAL'); 650 } 651 return $vec_ref; 652 }else{ 653 return 0; 654 } 655 656 } 657 } 658 659 if( ref( $vec_ref ) eq 'AnswerHash' ){ 660 $vec_ref->{score} = 1; 661 $vec_ref; 662 }else{ 663 1; 664 } 665 } 666 667 sub display_correct_vecs{ 668 my ( $vec_ref,%opts ) = @_; 669 my $corr_matrix; 670 my @vecs = (); 671 672 if( ref($vec_ref) eq 'AnswerHash' ) 673 { 674 $corr_matrix = Matrix->new_from_col_vecs($vec_ref->{correct_ans}); 675 }else{ 676 $corr_matrix = Matrix->new_from_col_vecs($vec_ref); 677 } 678 679 my @temp = (); 680 681 for( my $i = 0 ; $i < $corr_matrix->[2] ; $i++ ){ 682 push @temp, display_matrix($corr_matrix->column($i)); 683 push @temp, ","; 684 } 685 686 if( def(@temp) ) 687 { 688 pop @temp; 689 }else{ 690 @temp = [[" "]]; 691 } 692 693 694 695 mbox(\@temp); 696 697 } 698 699 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |