[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 2155 - (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
419 : jj 1943 =head3 weighted_partial_grader
420 : gage 1834
421 : jj 1943 =pod
422 : gage 1834
423 : jj 1943 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 : gage 1834
427 : jj 1943 $ENV{'partial_weights'} = [.2,.2,.2,.3];
428 : gage 1834
429 : jj 1943 This will soon be superceded by a better grader.
430 : gage 1834
431 :     =cut
432 :    
433 : jj 1943 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 : gage 1834
460 : gage 1064
461 : jj 1943 # 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 : gage 1064
472 : gage 1834
473 : jj 1943 my $numright=0;
474 :     my $i;
475 :     my $ans_ref;
476 : gage 1834
477 : jj 1943 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 : gage 1834
481 : jj 1943 # 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 : gage 1834
486 : jj 1943 $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 : gage 1834
496 : jj 1943 $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 : gage 1064 }
501 :    
502 : jj 1943 1;
503 : gage 1834
504 : gage 1064 ## 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