Parent Directory
| 
Revision Log
Catch errors which get thrown by other filters.
1 ### 2 3 =head1 NAME 4 5 PGasu.pl -- located in the pg/macros directory 6 7 =head1 SYNPOSIS 8 9 10 Macros contributed by John Jones 11 12 =cut 13 14 15 # Answer evaluator which always marks things correct 16 17 =head3 auto_right() 18 19 =pod 20 21 Usage: ANS(auto_right()); 22 or 23 ANS(auto_right("this answer can be left blank")); 24 25 This answer checker marks any answer correct. It is useful when you want 26 to leave multiple answer blanks, only some of which will be used. If you 27 turn off showing partial correct answers and partial credit, the effect is 28 not visible to the students. The comment in the second case is what will 29 be displayed as the correct answer. This helps avoid confusion. 30 31 =cut 32 33 sub auto_right { 34 my $cmt = shift; 35 my %params = @_; 36 $cmt = '' unless defined($cmt); 37 38 my $answerEvaluator = new AnswerEvaluator; 39 $answerEvaluator->ans_hash( 40 type => "auto_right", 41 correct_ans => "$cmt" 42 ); 43 $answerEvaluator->install_pre_filter('reset'); 44 $answerEvaluator->install_evaluator(\&auto_right_checker,%params); 45 46 return $answerEvaluator; 47 } 48 49 # used in auto_right above 50 51 sub auto_right_checker { 52 my $ans = shift; 53 $ans->score(1); 54 return($ans); 55 } 56 57 58 =head3 no_decs() 59 60 =pod 61 62 Can be wrapped around an numerical evaluation. It marks the answer wrong 63 if it contains a decimal point. Usage: 64 65 ANS(no_decs(num_cmp("sqrt(3)"))); 66 67 This will accept "sqrt(3)" or "3^(1/2)" as answers, but not 1.7320508 68 69 =cut 70 71 72 sub no_decs { 73 my ($old_evaluator) = @_; 74 75 my $msg= "Your answer contains a decimal. You must provide an exact answer, e.g. sqrt(5)/3"; 76 $old_evaluator->install_pre_filter(must_have_filter(".", 'no', $msg)); 77 $old_evaluator->install_post_filter(\&raw_student_answer_filter); 78 $old_evaluator->install_post_filter(\&catch_errors_filter); 79 80 return $old_evaluator; 81 } 82 83 =head3 must_include() 84 85 =pod 86 87 Wrapper for other answer evaluators. It insists that a string is part of 88 the answer to be marked right. 89 90 =cut 91 92 sub must_include { 93 my ($old_evaluator) = shift; 94 my $muststr = shift; 95 96 $old_evaluator->install_pre_filter(must_have_filter($muststr)); 97 $old_evaluator->install_post_filter(\&raw_student_answer_filter); 98 $old_evaluator->install_post_filter(\&catch_errors_filter); 99 return $old_evaluator; 100 } 101 102 =head3 no_trig_fun() 103 104 Wrapper for other answer evaluators. It marks the answer wrong if 105 it contains one of the six basic trig functions. 106 107 This is useful if you want students to report the value of sin(pi/4), 108 but you don't want to allow "sin(pi/4)" as the answer. 109 110 =cut 111 112 sub no_trig_fun { 113 my ($ans) = shift; 114 my $new_eval = fun_cmp($ans); 115 my ($msg) = "Your answer to this problem may not contain a trig function."; 116 $new_eval->install_pre_filter(must_have_filter("sin", 'no', $msg)); 117 $new_eval->install_pre_filter(must_have_filter("cos", 'no', $msg)); 118 $new_eval->install_pre_filter(must_have_filter("tan", 'no', $msg)); 119 $new_eval->install_pre_filter(must_have_filter("sec", 'no', $msg)); 120 $new_eval->install_pre_filter(must_have_filter("csc", 'no', $msg)); 121 $new_eval->install_pre_filter(must_have_filter("cot", 'no', $msg)); 122 123 $new_eval->install_post_filter(\&catch_errors_filter); 124 return $new_eval; 125 } 126 127 =head3 no_trig() 128 129 130 131 =cut 132 133 sub no_trig { 134 my ($ans) = shift; 135 my $new_eval = num_cmp($ans); 136 my ($msg) = "Your answer to this problem may not contain a trig function."; 137 $new_eval->install_pre_filter(must_have_filter("sin", 'no', $msg)); 138 $new_eval->install_pre_filter(must_have_filter("cos", 'no', $msg)); 139 $new_eval->install_pre_filter(must_have_filter("tan", 'no', $msg)); 140 $new_eval->install_pre_filter(must_have_filter("sec", 'no', $msg)); 141 $new_eval->install_pre_filter(must_have_filter("csc", 'no', $msg)); 142 $new_eval->install_pre_filter(must_have_filter("cot", 'no', $msg)); 143 144 $new_eval->install_post_filter(\&catch_errors_filter); 145 return $new_eval; 146 } 147 148 =head3 exact_no_trig() 149 150 151 152 =cut 153 154 sub exact_no_trig { 155 my ($ans) = shift; 156 my $old_eval = num_cmp($ans); 157 my $new_eval = no_decs($old_eval); 158 my ($msg) = "Your answer to this problem may not contain a trig function."; 159 $new_eval->install_pre_filter(must_have_filter("sin", 'no', $msg)); 160 $new_eval->install_pre_filter(must_have_filter("cos", 'no', $msg)); 161 $new_eval->install_pre_filter(must_have_filter("tan", 'no', $msg)); 162 $new_eval->install_pre_filter(must_have_filter("sec", 'no', $msg)); 163 $new_eval->install_pre_filter(must_have_filter("csc", 'no', $msg)); 164 $new_eval->install_pre_filter(must_have_filter("cot", 'no', $msg)); 165 166 return $new_eval; 167 } 168 169 170 =head3 must_have_filter() 171 172 =pod 173 174 Filter for checking that an answer has (or doesn't have) a certain 175 string in it. This can be used to screen answers where you want them 176 in a particular form (e.g., if you allow most functions, but not trig 177 functions in the answer, or if the answer must include some string). 178 179 First argument is the string to have, or not have 180 Second argument is optional, and tells us whether yes or no 181 Third argument is the error message to produce (if any). 182 183 =cut 184 185 186 # First argument is the string to have, or not have 187 # Second argument is optional, and tells us whether yes or no 188 # Third argument is the error message to produce (if any). 189 sub must_have_filter { 190 my $str = shift; 191 my $yesno = shift; 192 my $errm = shift; 193 194 $str =~ s/\./\\./g; 195 if(!defined($yesno)) { 196 $yesno=1; 197 } else { 198 $yesno = ($yesno eq 'no') ? 0 :1; 199 } 200 201 my $newfilt = sub { 202 my $num = shift; 203 my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ; 204 my ($rh_ans); 205 if ($process_ans_hash) { 206 $rh_ans = $num; 207 $num = $rh_ans->{original_student_ans}; 208 } 209 my $is_ok = 0; 210 211 return $is_ok unless defined($num); 212 213 if (($yesno and ($num =~ /$str/)) or (!($yesno) and !($num=~ /$str/))) { 214 $is_ok = 1; 215 } 216 217 if ($process_ans_hash) { 218 if ($is_ok == 1 ) { 219 $rh_ans->{original_student_ans}=$num; 220 return $rh_ans; 221 } else { 222 if(defined($errm)) { 223 $rh_ans->{ans_message} = $errm; 224 $rh_ans->{student_ans} = $rh_ans->{original_student_ans}; 225 # $rh_ans->{student_ans} = "Your answer was \"$rh_ans->{original_student_ans}\". $errm"; 226 $rh_ans->throw_error('SYNTAX', $errm); 227 } else { 228 $rh_ans->throw_error('NUMBER', ""); 229 } 230 return $rh_ans; 231 } 232 233 } else { 234 return $is_ok; 235 } 236 }; 237 return $newfilt; 238 } 239 240 =head3 catch_errors_filter() 241 242 =cut 243 244 sub catch_errors_filter { 245 my ($rh_ans) = shift; 246 if ($rh_ans->catch_error('SYNTAX') ) { 247 $rh_ans->{ans_message} = $rh_ans->{error_message}; 248 $rh_ans->clear_error('SYNTAX'); 249 } 250 if ($rh_ans->catch_error('NUMBER') ) { 251 $rh_ans->{ans_message} = $rh_ans->{error_message}; 252 $rh_ans->clear_error('NUMBER'); 253 } 254 $rh_ans; 255 } 256 257 =head3 raw_student_answer_filter() 258 259 260 261 =cut 262 263 264 sub raw_student_answer_filter { 265 my ($rh_ans) = shift; 266 # warn "answer was ".$rh_ans->{student_ans}; 267 $rh_ans->{student_ans} = $rh_ans->{original_student_ans} 268 unless ($rh_ans->{student_ans} =~ /[a-zA-Z]/); 269 # warn "2nd time ... answer was ".$rh_ans->{student_ans}; 270 271 return $rh_ans; 272 } 273 274 =head3 no_decimal_list() 275 276 277 278 =cut 279 280 281 sub no_decimal_list { 282 my ($ans) = shift; 283 my (%jopts) = @_; 284 my $old_evaluator = number_list_cmp($ans); 285 286 my $answer_evaluator = sub { 287 my $tried = shift; 288 my $ans_hash; 289 if ( ref($old_evaluator) eq 'AnswerEvaluator' ) { # new style 290 $ans_hash = $old_evaluator->evaluate($tried); 291 } elsif (ref($old_evaluator) eq 'CODE' ) { #old style 292 $ans_hash = &$old_evaluator($tried); 293 } 294 if(defined($jopts{'must'}) && ! ($tried =~ /$jopts{'must'}/)) { 295 $ans_hash->{score}=0; 296 $ans_hash->setKeys( 'ans_message' => 'Your answer needs to be exact.'); 297 } 298 if($tried =~ /\./) { 299 $ans_hash->{score}=0; 300 $ans_hash->setKeys( 'ans_message' => 'You may not use decimals in your answer.'); 301 } 302 return $ans_hash; 303 }; 304 return $answer_evaluator; 305 } 306 307 308 =head3 no_decimals() 309 310 311 312 =cut 313 314 315 sub no_decimals { 316 my ($ans) = shift; 317 my (%jopts) = @_; 318 my $old_evaluator = std_num_cmp($ans); 319 320 my $answer_evaluator = sub { 321 my $tried = shift; 322 my $ans_hash; 323 if ( ref($old_evaluator) eq 'AnswerEvaluator' ) { # new style 324 $ans_hash = $old_evaluator->evaluate($tried); 325 } elsif (ref($old_evaluator) eq 'CODE' ) { #old style 326 $ans_hash = &$old_evaluator($tried); 327 } 328 if(defined($jopts{'must'}) && ! ($tried =~ /$jopts{'must'}/)) { 329 $ans_hash->{score}=0; 330 $ans_hash->setKeys( 'ans_message' => 'Your answer needs to be exact.'); 331 } 332 if($tried =~ /\./) { 333 $ans_hash->{score}=0; 334 $ans_hash->setKeys( 'ans_message' => 'You may not use decimals in your answer.'); 335 } 336 return $ans_hash; 337 }; 338 return $answer_evaluator; 339 } 340 341 =head3 with_comments() 342 343 344 # Wrapper for an answer evaluator which can also supply comments 345 346 =cut 347 348 # Wrapper for an answer evaluator which can also supply comments 349 350 351 sub with_comments { 352 my ($old_evaluator, $cmt) = @_; 353 354 # $mdm = $main::displayMode; 355 # $main::displayMode = 'HTML_tth'; 356 # $cmt = EV2($cmt); 357 # $main::displayMode =$mdm; 358 359 my $ans_evaluator = sub { 360 my $tried = shift; 361 my $ans_hash; 362 363 if ( ref($old_evaluator) eq 'AnswerEvaluator' ) { # new style 364 $ans_hash = $old_evaluator->evaluate($tried); 365 } elsif (ref($old_evaluator) eq 'CODE' ) { #old style 366 $ans_hash = &$old_evaluator($tried); 367 } else { 368 warn "There is a problem using the answer evaluator"; 369 } 370 371 if($ans_hash->{score}>0) { 372 $ans_hash -> setKeys( 'ans_message' => $cmt); 373 } 374 return $ans_hash; 375 }; 376 377 $ans_evaluator; 378 } 379 380 381 =head3 pc_evaluator() 382 383 384 # Wrapper for multiple answer evaluators, it takes a list of the following as inputs 385 # [answer_evaluator, partial credit factor, comment] 386 # it applies evaluators from the list until it hits one with positive credit, 387 # weights it by the partial credit factor, and throws in its comment 388 389 390 =cut 391 392 393 # Wrapper for multiple answer evaluators, it takes a list of the following as inputs 394 # [answer_evaluator, partial credit factor, comment] 395 # it applies evaluators from the list until it hits one with positive credit, 396 # weights it by the partial credit factor, and throws in its comment 397 398 sub pc_evaluator { 399 my @ev_list; 400 if(ref($_[0]) ne 'ARRAY') { 401 warn "Improper input to pc_evaluator"; 402 } 403 if(ref($_[0]->[0]) ne 'ARRAY') { 404 @ev_list = @_; 405 } else { 406 @ev_list = @{$_[0]}; 407 } 408 409 my $ans_evaluator = sub { 410 my $tried = shift; 411 my $ans_hash; 412 for($j=0;$j<scalar(@ev_list); $j++) { 413 my $old_evaluator = $ev_list[$j][0]; 414 my $cmt = $ev_list[$j][2]; 415 my $weight = $ev_list[$j][1]; 416 $weight = 1 unless defined($weight); 417 418 if ( ref($old_evaluator) eq 'AnswerEvaluator' ) { # new style 419 $ans_hash = $old_evaluator->evaluate($tried); 420 } elsif (ref($old_evaluator) eq 'CODE' ) { #old style 421 $ans_hash = &$old_evaluator($tried); 422 } else { 423 warn "There is a problem using the answer evaluator"; 424 } 425 426 if($ans_hash->{score}>0) { 427 $ans_hash -> setKeys( 'ans_message' => $cmt) if defined($cmt); 428 $ans_hash->{score} *= $weight; 429 return $ans_hash; 430 }; 431 }; 432 return $ans_hash; 433 }; 434 435 $ans_evaluator; 436 } 437 438 439 440 =head3 weighted_partial_grader 441 442 =pod 443 444 This is a grader which weights the different parts of the problem 445 differently. The weights passed to it through the environment. In 446 the problem: 447 448 $ENV{'partial_weights'} = [.2,.2,.2,.3]; 449 450 This will soon be superceded by a better grader. 451 452 =cut 453 454 sub weighted_partial_grader { 455 my $rh_evaluated_answers = shift; 456 my $rh_problem_state = shift; 457 my %form_options = @_; 458 my %evaluated_answers = %{$rh_evaluated_answers}; 459 # The hash $rh_evaluated_answers typically contains: 460 # 'answer1' => 34, 'answer2'=> 'Mozart', etc. 461 462 # By default the old problem state is simply passed back out again. 463 my %problem_state = %$rh_problem_state; 464 465 466 # %form_options might include 467 # The user login name 468 # The permission level of the user 469 # The studentLogin name for this psvn. 470 # Whether the form is asking for a refresh or 471 # is submitting a new answer. 472 473 # initial setup of the answer 474 my $total=0; 475 my %problem_result = ( score => 0, 476 errors => '', 477 type => 'custom_problem_grader', 478 msg => $ENV{'grader_message'} 479 ); 480 481 482 # Return unless answers have been submitted 483 unless ($form_options{answers_submitted} == 1) { 484 return(\%problem_result,\%problem_state); 485 } 486 # Answers have been submitted -- process them. 487 488 ######################################################## 489 # Here's where we compute the score. The variable # 490 # $numright is the number of correct answers. # 491 ######################################################## 492 493 494 my $numright=0; 495 my $i; 496 my $ans_ref; 497 498 warn "Partial value weights not defined" if not defined($ENV{'partial_weights'}); 499 my @partial_weights = @{$ENV{'partial_weights'}}; 500 my $total_weight=0; 501 502 # Renormalize weights so they add to 1 503 for $i (@partial_weights) { $total_weight += $i; } 504 warn("Weights do not add to a positive number") unless ($total_weight >0); 505 for $i (0..$#partial_weights) { $partial_weights[$i] /= $total_weight; } 506 507 $i = 1; 508 while (defined($ans_ref = $evaluated_answers{'AnSwEr'."$i"})) { 509 $total += $ans_ref->{score}*$partial_weights[$i-1]; 510 $i++; 511 } 512 513 $problem_result{score} = $total; 514 # increase recorded score if the current score is greater. 515 $problem_state{recorded_score} = $problem_result{score} if $problem_result{score} > $problem_state{recorded_score}; 516 517 $problem_state{num_of_correct_ans}++ if $total == 1; 518 $problem_state{num_of_incorrect_ans}++ if $total < 1 ; 519 520 (\%problem_result, \%problem_state); 521 } 522 523 1; 524 525 ## Local Variables: 526 ## mode: CPerl 527 ## font-lock-mode: t 528 ## End:
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |