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