[system] / trunk / pg / macros / PGasu.pl Repository:
ViewVC logotype

Annotation of /trunk/pg/macros/PGasu.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1943 - (view) (download) (as text)

1 : jj 1941 ###
2 :    
3 : gage 1834 =head1 NAME
4 : gage 1064
5 : jj 1941 PGasu.pl -- located in the pg/macros directory
6 : apizer 1080
7 : gage 1834 =head1 SYNPOSIS
8 :    
9 :    
10 :     Macros contributed by John Jones
11 :    
12 :     =cut
13 :    
14 :    
15 : gage 1064 # Answer evaluator which always marks things correct
16 : gage 1834
17 :     =head3 auto_right()
18 :    
19 : jj 1943 =pod
20 : gage 1834
21 : jj 1943 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 : gage 1834 =cut
32 :    
33 : gage 1064 sub auto_right {
34 : jj 1943 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 : apizer 1080
46 : jj 1943 return $answerEvaluator;
47 : gage 1064 }
48 :    
49 : jj 1943 # used in auto_right above
50 : gage 1064
51 : jj 1943 sub auto_right_checker {
52 :     my $ans = shift;
53 :     $ans->score(1);
54 :     return($ans);
55 :     }
56 : gage 1834
57 :    
58 : jj 1943 =head3 no_decs()
59 : gage 1834
60 : jj 1943 =pod
61 : gage 1834
62 : jj 1943 Can be wrapped around an numerical evaluation. It marks the answer wrong
63 :     if it contains a decimal point. Usage:
64 : apizer 1080
65 : jj 1943 ANS(no_decs(num_cmp("sqrt(3)")));
66 : gage 1064
67 : jj 1943 This will accept "sqrt(3)" or "3^(1/2)" as answers, but not 1.7320508
68 : gage 1834
69 :     =cut
70 :    
71 :    
72 : gage 1064 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 : gage 1834 =head3 must_include()
83 :    
84 : jj 1943 =pod
85 : gage 1834
86 : jj 1943 Wrapper for other answer evaluators. It insists that a string is part of
87 :     the answer to be marked right.
88 :    
89 : gage 1834 =cut
90 :    
91 : gage 1064 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 : jj 1943
100 : gage 1834 =head3 no_trig_fun()
101 : gage 1064
102 : jj 1943 Wrapper for other answer evaluators. It marks the answer wrong if
103 :     it contains one of the six basic trig functions.
104 : gage 1834
105 : jj 1943 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 : gage 1834
108 :     =cut
109 :    
110 : gage 1064 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 : gage 1834 =head3 no_trig()
125 : gage 1064
126 : gage 1834
127 :    
128 :     =cut
129 :    
130 : gage 1064 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 : gage 1834 =head3 exact_no_trig()
145 :    
146 :    
147 :    
148 :     =cut
149 :    
150 : gage 1064 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 : gage 1834
166 :     =head3 must_have_filter()
167 :    
168 : jj 1943 =pod
169 : gage 1834
170 : jj 1943 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 : gage 1834
175 : jj 1943 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 : gage 1834
179 :     =cut
180 :    
181 :    
182 : gage 1064 # 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 : apizer 1080
207 : gage 1064 return $is_ok unless defined($num);
208 : apizer 1080
209 : gage 1064 if (($yesno and ($num =~ /$str/)) or (!($yesno) and !($num=~ /$str/))) {
210 :     $is_ok = 1;
211 :     }
212 : apizer 1080
213 : gage 1064 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 : apizer 1080
229 : gage 1064 } else {
230 :     return $is_ok;
231 :     }
232 :     };
233 :     return $newfilt;
234 :     }
235 :    
236 : gage 1834 =head3 raw_student_answer_filter()
237 :    
238 :    
239 :    
240 :     =cut
241 :    
242 :    
243 : gage 1064 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 : apizer 1080 # warn "2nd time ... answer was ".$rh_ans->{student_ans};
249 :    
250 : gage 1064 return $rh_ans;
251 :     }
252 :    
253 : gage 1834 =head3 no_decimal_list()
254 :    
255 :    
256 :    
257 :     =cut
258 :    
259 :    
260 : gage 1064 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 : gage 1834 =head3 no_decimals()
288 :    
289 :    
290 :    
291 :     =cut
292 :    
293 :    
294 : gage 1064 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 : gage 1834 =head3 with_comments()
321 :    
322 :    
323 :     # Wrapper for an answer evaluator which can also supply comments
324 :    
325 :     =cut
326 :    
327 : gage 1064 # Wrapper for an answer evaluator which can also supply comments
328 : gage 1834
329 :    
330 : gage 1064 sub with_comments {
331 :     my ($old_evaluator, $cmt) = @_;
332 : apizer 1080
333 : gage 1064 # $mdm = $main::displayMode;
334 :     # $main::displayMode = 'HTML_tth';
335 :     # $cmt = EV2($cmt);
336 :     # $main::displayMode =$mdm;
337 : apizer 1080
338 : gage 1064 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 : apizer 1080
350 : gage 1064 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 : gage 1834
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 : gage 1064 # 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 : jj 1943 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 : apizer 1080
397 : jj 1943 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 : gage 1064 $ans_evaluator;
415 :     }
416 :    
417 : jj 1943
418 : gage 1834 =head3 nicestring
419 :    
420 : jj 1943 =pod
421 : gage 1834
422 : jj 1943 A formatting function for dealing with 1, -1, and 0 coefficients in
423 :     linear combinations.
424 : gage 1834
425 : jj 1943 Usage:
426 :    
427 :     $a = nicestring([0,1,-1,2], ['x', 'y', 'z', 'w']);
428 :    
429 :     produces "y-z+ 2w" in $a.
430 :    
431 :     As a shorthand for polynomials,
432 :    
433 :     $b = nicestring([1,2, -1, 0, 3]);
434 :    
435 :     produces 'x^4 + 2 x^3 - x^2 + 3' in $b.
436 :    
437 :    
438 : gage 1834 =cut
439 :    
440 :    
441 : gage 1064 sub nicestring {
442 :     my($thingy) = shift;
443 :     my(@coefs) = @{$thingy};
444 :     my $n = scalar(@coefs);
445 :     $thingy = shift;
446 :     my(@others);
447 :     if(defined($thingy)) {
448 :     @others = @{$thingy};
449 :     } else {
450 :     my($j);
451 :     for $j (1..($n-2)) {
452 :     $others[$j-1] = "x^".($n-$j);
453 :     }
454 :     if($n>=2) { $others[$n-2] = "x";}
455 :     $others[$n-1] = "";
456 :     }
457 :     my($j, $k)=(0,0);
458 :     while(($k<$n) && ($coefs[$k]==0)) {$k++;}
459 :     if($k==$n) {return("0");}
460 :     my $ans;
461 :     if($coefs[$k]==1) {$ans = ($others[$k]) ? "$others[$k]" : "1";}
462 :     elsif($coefs[$k]== -1) {$ans = ($others[$k]) ? "- $others[$k]" : "-1"}
463 :     else { $ans = "$coefs[$k] $others[$k]";}
464 :     $k++;
465 :     for $j ($k..($n-1)) {
466 :     if($coefs[$j] != 0) {
467 :     if($coefs[$j] == 1) {
468 :     $ans .= ($others[$j]) ? "+ $others[$j]" : "+ 1";
469 :     } elsif($coefs[$j] == -1) {
470 :     $ans .= ($others[$j]) ? "- $others[$j]" : "-1";
471 :     } else {
472 :     $ans .= "+ $coefs[$j] $others[$j]";
473 :     }
474 :     }
475 :     }
476 :     return($ans);
477 :     }
478 :    
479 :    
480 : jj 1943 =head3 weighted_partial_grader
481 : gage 1834
482 : jj 1943 =pod
483 : gage 1834
484 : jj 1943 This is a grader which weights the different parts of the problem
485 :     differently. The weights passed to it through the environment. In
486 :     the problem:
487 : gage 1834
488 : jj 1943 $ENV{'partial_weights'} = [.2,.2,.2,.3];
489 : gage 1834
490 : jj 1943 This will soon be superceded by a better grader.
491 : gage 1834
492 :     =cut
493 :    
494 : jj 1943 sub weighted_partial_grader {
495 :     my $rh_evaluated_answers = shift;
496 :     my $rh_problem_state = shift;
497 :     my %form_options = @_;
498 :     my %evaluated_answers = %{$rh_evaluated_answers};
499 :     # The hash $rh_evaluated_answers typically contains:
500 :     # 'answer1' => 34, 'answer2'=> 'Mozart', etc.
501 :    
502 :     # By default the old problem state is simply passed back out again.
503 :     my %problem_state = %$rh_problem_state;
504 :    
505 :    
506 :     # %form_options might include
507 :     # The user login name
508 :     # The permission level of the user
509 :     # The studentLogin name for this psvn.
510 :     # Whether the form is asking for a refresh or
511 :     # is submitting a new answer.
512 :    
513 :     # initial setup of the answer
514 :     my $total=0;
515 :     my %problem_result = ( score => 0,
516 :     errors => '',
517 :     type => 'custom_problem_grader',
518 :     msg => $ENV{'grader_message'}
519 :     );
520 : gage 1834
521 : gage 1064
522 : jj 1943 # Return unless answers have been submitted
523 :     unless ($form_options{answers_submitted} == 1) {
524 :     return(\%problem_result,\%problem_state);
525 :     }
526 :     # Answers have been submitted -- process them.
527 :    
528 :     ########################################################
529 :     # Here's where we compute the score. The variable #
530 :     # $numright is the number of correct answers. #
531 :     ########################################################
532 : gage 1064
533 : gage 1834
534 : jj 1943 my $numright=0;
535 :     my $i;
536 :     my $ans_ref;
537 : gage 1834
538 : jj 1943 warn "Partial value weights not defined" if not defined($ENV{'partial_weights'});
539 :     my @partial_weights = @{$ENV{'partial_weights'}};
540 :     my $total_weight=0;
541 : gage 1834
542 : jj 1943 # Renormalize weights so they add to 1
543 :     for $i (@partial_weights) { $total_weight += $i; }
544 :     warn("Weights do not add to a positive number") unless ($total_weight >0);
545 :     for $i (0..$#partial_weights) { $partial_weights[$i] /= $total_weight; }
546 : gage 1834
547 : jj 1943 $i = 1;
548 :     while (defined($ans_ref = $evaluated_answers{'AnSwEr'."$i"})) {
549 :     $total += $ans_ref->{score}*$partial_weights[$i-1];
550 :     $i++;
551 :     }
552 :    
553 :     $problem_result{score} = $total;
554 :     # increase recorded score if the current score is greater.
555 :     $problem_state{recorded_score} = $problem_result{score} if $problem_result{score} > $problem_state{recorded_score};
556 : gage 1834
557 : jj 1943 $problem_state{num_of_correct_ans}++ if $total == 1;
558 :     $problem_state{num_of_incorrect_ans}++ if $total < 1 ;
559 :    
560 :     (\%problem_result, \%problem_state);
561 : gage 1064 }
562 :    
563 : jj 1943 1;
564 : gage 1834
565 : gage 1064 ## Local Variables:
566 :     ## mode: CPerl
567 :     ## font-lock-mode: t
568 :     ## End:

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9