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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : sh002i 5568 ################################################################################
2 :     # WeBWorK Online Homework Delivery System
3 :     # Copyright 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
4 : gage 6058 # $CVSHeader$
5 : sh002i 5568 #
6 :     # This program is free software; you can redistribute it and/or modify it under
7 :     # the terms of either: (a) the GNU General Public License as published by the
8 :     # Free Software Foundation; either version 2, or (at your option) any later
9 :     # version, or (b) the "Artistic License" which comes with this package.
10 :     #
11 :     # This program is distributed in the hope that it will be useful, but WITHOUT
12 :     # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
13 :     # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
14 :     # Artistic License for more details.
15 :     ################################################################################
16 : gage 1064
17 :     =head1 NAME
18 :    
19 : sh002i 5568 extraAnswerEvaluators.pl - Answer evaluators for intervals, lists of numbers,
20 :     and lists of points.
21 :    
22 : gage 1064 =head1 SYNPOSIS
23 :    
24 : sh002i 5568 interval_cmp() -- checks answers which are unions of intervals. It can also
25 :     be used for checking an ordered pair or list of ordered
26 :     pairs.
27 : gage 1064
28 :     number_list_cmp() -- checks a comma separated list of numbers. By use of
29 :     optional arguments, you can request that order be
30 : sh002i 5568 important, that complex numbers be allowed, and specify
31 :     extra arguments to be sent to num_cmp (or cplx_cmp) for
32 :     checking individual entries.
33 : apizer 1080
34 : sh002i 5568 equation_cmp() -- provides a limited facility for checking equations. It
35 :     makes no pretense of checking to see if the real locus of
36 :     the student's equation matches the real locus of the
37 :     instructor's equation. The student's equation must be of
38 :     the same general type as the instructors to get credit.
39 : gage 1064
40 :     =head1 DESCRIPTION
41 :    
42 :     This file adds subroutines which create "answer evaluators" for checking student
43 :     answers of various "exotic" types.
44 :    
45 :     =cut
46 :    
47 : sh002i 5658 # ^uses loadMacros
48 : sh002i 5568 loadMacros('MathObjects.pl');
49 :    
50 : gage 1064 {
51 : sh002i 5658 # ^package Equation_eval
52 : gage 1064 package Equation_eval;
53 : jj 3489
54 : sh002i 5658 # ^function split_eqn
55 : gage 1064 sub split_eqn {
56 :     my $instring = shift;
57 : jj 3489
58 :     split /=/, $instring;
59 : gage 1064 }
60 : jj 3489
61 : gage 5640 #FIXME -- this could be improved so that
62 :     # 1. it uses an answer evaluator object instead of a sub routine
63 :     # 2. it provides error messages when previous answers are equivalent
64 : sh002i 5658 # ^function equation_cmp
65 :     # ^uses AnswerHash::new
66 :     # ^uses split_eqn
67 :     # ^uses main::check_syntax
68 :     # ^uses main::fun_cmp
69 : gage 1064 sub equation_cmp {
70 :     my $right_ans = shift;
71 :     my %opts = @_;
72 :     my $vars = ['x','y'];
73 :    
74 : apizer 1080
75 : gage 1064 $vars = $opts{'vars'} if defined($opts{'vars'});
76 :    
77 :     my $ans_eval = sub {
78 :     my $student = shift;
79 : gage 5640 my %response_options = @_;
80 : gage 1064 my $ans_hash = new AnswerHash(
81 : gage 5640 'score'=>0,
82 :     'correct_ans'=>$right_ans,
83 :     'student_ans'=>$student,
84 :     'original_student_ans' => $student,
85 :     'type' => 'equation_cmp',
86 :     'ans_message'=>'',
87 :     'preview_text_string'=>'',
88 :     'preview_latex_string'=>'',
89 :     );
90 : gage 1064
91 :     if(! ($student =~ /\S/)) { return $ans_hash; }
92 : apizer 1080
93 : gage 1064 my @right= split_eqn($right_ans);
94 :     if(scalar(@right) != 2) {
95 :     $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem.";
96 :     return $ans_hash;
97 :     }
98 :     my @studsplit = split_eqn($student);
99 :     if(scalar(@studsplit) != 2) {
100 :     $ans_hash->{'ans_message'} = "You did not enter an equation (with an equals sign and two sides).";
101 :     return $ans_hash;
102 :     }
103 :    
104 :     # Next we should do syntax checks on everyone
105 :    
106 :     my $ah = new AnswerHash;
107 :     $ah->input($right[0]);
108 :     $ah=main::check_syntax($ah);
109 :     if($ah->{error_flag}) {
110 :     $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem.";
111 :     return $ans_hash;
112 :     }
113 : apizer 1080
114 : gage 1064 $ah->input($right[1]);
115 :     $ah=main::check_syntax($ah);
116 :     if($ah->{error_flag}) {
117 :     $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem.";
118 :     return $ans_hash;
119 :     }
120 :    
121 :     # Correct answer checks out, now check student's syntax
122 :    
123 :     my @prevs = ("","");
124 :     my @prevtxt = ("","");
125 :     $ah->input($studsplit[0]);
126 :     $ah=main::check_syntax($ah);
127 :     if($ah->{error_flag}) {
128 :     $ans_hash->{'ans_message'} = "Syntax error on the left side of your equation.";
129 :     return $ans_hash;
130 :     }
131 :     $prevs[0] = $ah->{'preview_latex_string'};
132 :     $prevstxt[0] = $ah->{'preview_text_string'};
133 : apizer 1080
134 :    
135 : gage 1064 $ah->input($studsplit[1]);
136 :     $ah=main::check_syntax($ah);
137 :     if($ah->{error_flag}) {
138 :     $ans_hash->{'ans_message'} = "Syntax error on the right side of your equation.";
139 :     return $ans_hash;
140 :     }
141 :     $prevs[1] = $ah->{'preview_latex_string'};
142 :     $prevstxt[1] = $ah->{'preview_text_string'};
143 :    
144 :     $ans_hash->{'preview_latex_string'} = "$prevs[0] = $prevs[1]";
145 :     $ans_hash->{'preview_text_string'} = "$prevstxt[0] = $prevstxt[1]";
146 : apizer 1080
147 :    
148 : gage 1064 # Check for answer equivalent to 0=0
149 :     # Could be false positive below because of parameter
150 :     my $ae = main::fun_cmp("0", %opts);
151 :     my $res = $ae->evaluate("$studsplit[0]-($studsplit[1])");
152 :     if($res->{'score'}==1) {
153 :     # Student is 0=0, is correct answer also like this?
154 :     $res = $ae->evaluate("$right[0]-($right[1])");
155 :     if($res->{'score'}==1) {
156 :     $ans_hash-> setKeys('score' => $res->{'score'});
157 :     }
158 :     return $ans_hash;
159 :     }
160 :    
161 :     # Maybe answer really is 0=0, and student got it wrong, so check that
162 :     $res = $ae->evaluate("$right[0]-($right[1])");
163 :     if($res->{'score'}==1) {
164 :     return $ans_hash;
165 :     }
166 :    
167 :     # Finally, use fun_cmp to check the answers
168 : apizer 1080
169 : gage 1064 $ae = main::fun_cmp("o*($right[0]-($right[1]))", vars=>$vars, params=>['o'], %opts);
170 : gage 5640 $res= $ae->evaluate("$studsplit[0]-($studsplit[1])",%response_options);
171 : gage 1064 $ans_hash-> setKeys('score' => $res->{'score'});
172 : apizer 1080
173 : gage 1064 return $ans_hash;
174 :     };
175 :    
176 :     return $ans_eval;
177 :     }
178 :     }
179 : sh002i 5658 # ^package main
180 : gage 1064
181 : sh002i 5658 # ^function mode2context
182 :     # ^uses Parser::Context::getCopy
183 :     # ^uses %context
184 :     # ^uses $numZeroLevelTolDefault
185 :     # ^uses $numAbsTolDefault
186 :     # ^uses $numRelPercentTolDefault
187 :     # ^uses $numFormatDefault
188 : jj 3506 sub mode2context {
189 :     my $mode = shift;
190 : jj 3513 my %options = @_;
191 : jj 3506 my $context;
192 :     for ($mode) {
193 : dpvc 4928 /^strict$/i and do {
194 :     $context = Parser::Context->getCopy(\%main::context,"LimitedNumeric");
195 : jj 3506 $context->operators->redefine(',');
196 :     last;
197 :     };
198 : dpvc 4928 /^arith$/i and do {
199 :     $context = Parser::Context->getCopy(\%main::context,"LegacyNumeric");
200 : jj 3506 $context->functions->disable('All');
201 :     last;
202 :     };
203 : dpvc 4928 /^frac$/i and do {
204 :     $context = Parser::Context->getCopy(\%main::context,"LimitedNumeric-Fraction");
205 : jj 3506 $context->operators->redefine(',');
206 :     last;
207 :     };
208 :    
209 :     # default
210 : dpvc 4928 $context = Parser::Context->getCopy(\%main::context,"LegacyNumeric");
211 : jj 3506 }
212 : jj 3513 # If we are using complex numbers, then we ignore the other mode parts
213 :     if(defined($options{'complex'}) &&
214 :     ($options{'complex'} =~ /(yes|ok)/i)) {
215 :     #$context->constants->redefine('i', from=>'Complex');
216 :     #$context->functions->redefine(['arg','mod','Re','Im','conj', 'sqrt', 'log'], from=>'Complex');
217 :     #$context->operators->redefine(['^', '**'], from=>'Complex');
218 : dpvc 4963 $context = Parser::Context->getCopy(\%main::context,"Complex");
219 : jj 3513 }
220 : jj 3506 $options{tolType} = $options{tolType} || 'relative';
221 : jj 3557 $options{tolType} = 'absolute' if defined($options{tol});
222 : jj 3506 $options{zeroLevel} = $options{zeroLevel} || $options{zeroLevelTol} ||
223 :     $main::numZeroLevelTolDefault;
224 : jj 3557 if ($options{tolType} eq 'absolute' or defined($options{abstol})) {
225 :     $options{tolerance} = $options{tolerance} || $options{tol} ||
226 :     $options{reltol} || $options{relTol} || $options{abstol} ||
227 :     $main::numAbsTolDefault;
228 : jj 3506 $context->flags->set(
229 :     tolerance => $options{tolerance},
230 :     tolType => 'absolute',
231 :     );
232 :     } else {
233 : jj 3557 $options{tolerance} = $options{tolerance} || $options{tol} ||
234 :     $options{reltol} || $options{relTol} || $options{abstol} ||
235 :     $main::numRelPercentTolDefault;
236 : jj 3506 $context->flags->set(
237 :     tolerance => .01*$options{tolerance},
238 :     tolType => 'relative',
239 :     );
240 :     }
241 :     $context->flags->set(
242 :     zeroLevel => $options{zeroLevel},
243 : dpvc 3555 zeroLevelTol => $options{zeroLevelTol} || $main::numZeroLevelTolDefault,
244 : jj 3506 );
245 :     $context->{format}{number} = $options{'format'} || $main::numFormatDefault;
246 :     return($context);
247 :     }
248 :    
249 : sh002i 5568 =head1 MACROS
250 : gage 1064
251 : sh002i 5568 =head2 interval_cmp
252 :    
253 : gage 1064 Compares an interval or union of intervals. Typical invocations are
254 :    
255 : sh002i 5568 interval_cmp("(2, 3] U(7, 11)")
256 : gage 1064
257 : sh002i 5568 The U is used for union symbol. In fact, any garbage (or nothing at all) can go
258 :     between intervals. It makes sure open/closed parts of intervals are correct,
259 :     unless you don't like that. To have it ignore the difference between open and
260 :     closed endpoints, use
261 : gage 1064
262 : sh002i 5568 interval_cmp("(2, 3] U(7, 11)", sloppy=>'yes')
263 : gage 1064
264 : sh002i 5568 interval_cmp uses num_cmp on the endpoints. You can pass optional arguments for
265 :     num_cmp, so to change the tolerance, you can use
266 : gage 1064
267 : sh002i 5568 interval_cmp("(2, 3] U(3+4, 11)", relTol=>3)
268 : gage 1064
269 :     The intervals can be listed in any order, unless you want to force a
270 :     particular order, which is signaled as
271 :    
272 : sh002i 5568 interval_cmp("(2, 3] U(3+4, 11)", ordered=>'strict')
273 : gage 1064
274 :     You can specify infinity as an endpoint. It will do a case-insensitive
275 :     string match looking for I, Infinity, Infty, or Inf. You can prepend a +
276 :     or -, as in
277 :    
278 : sh002i 5568 interval_cmp("(-inf, 3] U [e^10, infinity)")
279 :    
280 : gage 1064 or
281 :    
282 : sh002i 5568 interval_cmp("(-INF, 3] U [e^10, +I)")
283 :    
284 : gage 1064 If the question might have an empty set as the answer, you can use
285 :     the strings option to allow for it. So
286 :    
287 : sh002i 5568 interval_cmp("$ans", strings=>['empty'])
288 : gage 1064
289 :     will not generate an error message if the student enters the string
290 :     empty. Better still, it will mark a student answer of "empty" as correct
291 :     iff this matches $ans.
292 :    
293 :     You can use interval_cmp for ordered pairs, or lists of ordered pairs.
294 :     Internally, this is just a distinction of whether to put nice union symbols
295 :     between intervals, or commas. To get commas, use
296 :    
297 : sh002i 5568 interval_cmp("(1,2), (2,3), (4,-1)", unions=>'no')
298 : gage 1064
299 :     Note that interval_cmp makes no attempt at simplifying overlapping intervals.
300 :     This becomes an important feature when you are really checking lists of
301 :     ordered pairs.
302 :    
303 : jj 3489 Now we use the Parser package for checking intervals (or lists of
304 :     points if unions=>'no'). So, one can specify the Parser options
305 :     showCoordinateHints, showHints, partialCredit, and/or showLengthHints
306 :     as optional arguments:
307 :    
308 : sh002i 5568 interval_cmp("(1,2), (2,3), (4,-1)", unions=>'no', partialCredit=>1)
309 : jj 3489
310 :     Also, set differences and 'R' for all real numbers now work too since they work
311 :     for Parser Intervals and Unions.
312 :    
313 : gage 1064 =cut
314 :    
315 : sh002i 5658 # ^function interval_cmp
316 :     # ^uses Context
317 :     # ^uses mode2context
318 :     # ^uses List
319 :     # ^uses Union
320 : jj 3489 sub interval_cmp {
321 : jj 3462 my $correct_ans = shift;
322 :    
323 :     my %opts = @_;
324 :    
325 : jj 3489 my $mode = $opts{mode} || 'std';
326 : jj 3462 my %options = (debug => $opts{debug});
327 : jj 3506 my $ans_type = ''; # set to List, Union, or String below
328 : jj 3462
329 :     #
330 :     # Get an apppropriate context based on the mode
331 :     #
332 :     my $oldContext = Context();
333 : jj 3506 my $context = mode2context($mode, %opts);
334 : jj 3489
335 : jj 3462 if(defined($opts{unions}) and $opts{unions} eq 'no' ) {
336 : jj 3463 # This is really a list of points, not intervals at all
337 : jj 3462 $ans_type = 'List';
338 : jj 3489 $context->parens->redefine('(');
339 :     $context->parens->redefine('[');
340 : jj 3506 $context->parens->redefine('{');
341 :     $context->operators->redefine('u',using=>',');
342 :     $context->operators->set(u=>{string=>", ", TeX=>',\,'});
343 : jj 3462 } else {
344 : jj 3489 $context->parens->redefine('(', from=>'Interval');
345 :     $context->parens->redefine('[', from=>'Interval');
346 :     $context->parens->redefine('{', from=>'Interval');
347 : jj 3506
348 : jj 3513 $context->constants->redefine('R',from=>'Interval');
349 : jj 3489 $context->operators->redefine('U',from=>"Interval");
350 :     $context->operators->redefine('u',from=>"Interval",using=>"U");
351 : jj 3506 $ans_type = 'Union';
352 : jj 3462 }
353 : jj 3506 # Take optional arguments intended for List, or Union
354 : jj 3489 for my $o qw( showCoordinateHints showHints partialCredit showLengthHints ) {
355 :     $options{$o} = $opts{$o} || 0;
356 :     }
357 : jj 3513 $options{showUnionReduceWarnings} = $opts{showUnionReduceWarnings};
358 :     $options{studentsMustReduceUnions} = $opts{studentsMustReduceUnions};
359 :     if(defined($opts{ordered}) and $opts{ordered}) {
360 :     $options{ordered} = 1;
361 :     # Force this option if the the union must be ordered
362 :     $options{studentsMustReduceUnions} = 1;
363 :     }
364 : jj 3462 if (defined($opts{'sloppy'}) && $opts{'sloppy'} eq 'yes') {
365 :     $options{requireParenMatch} = 0;
366 :     }
367 : jj 3489 # historically we allow more infinities
368 : jj 3463 $context->strings->add(
369 :     'i' => {alias=>'infinity'},
370 :     'infty' => {alias=>'infinity'},
371 :     'minfinity' => {infinite=>1, negative=>1},
372 :     'minfty' => {alias=>'minfinity'},
373 :     'minf' => {alias=>'minfinity'},
374 :     'mi' => {alias=>'minfinity'},
375 : jj 3513 );
376 : jj 3489 # Add any strings
377 :     if ($opts{strings}) {
378 :     foreach my $string (@{$opts{strings}}) {
379 :     $string = uc($string);
380 :     $context->strings->add($string) unless
381 :     defined($context->strings->get($string));
382 :     $ans_type = 'String' if $string eq uc($correct_ans);
383 :     }
384 :     }
385 : dpvc 3870 # Add any variables
386 :     $opts{vars} = $opts{var} if ($opts{var});
387 :     if ($opts{vars}) {
388 :     $context->variables->are(); # clear old vars
389 :     $opts{vars} = [$opts{vars}] unless ref($opts{vars}) eq 'ARRAY';
390 :     foreach my $v (@{$opts{vars}}) {
391 :     $context->variables->add($v=>'Real')
392 :     unless $context->variables->get($v);
393 :     }
394 :     }
395 :    
396 : jj 3506 my $ans_eval;
397 : jj 3462 Context($context);
398 :     if($ans_type eq 'List') {
399 :     $ans_eval = List($correct_ans)->cmp(%options);
400 :     } elsif($ans_type eq 'Union') {
401 :     $ans_eval = Union($correct_ans)->cmp(%options);
402 : jj 3489 } elsif($ans_type eq 'String') {
403 :     $ans_eval = List($correct_ans)->cmp(%options);
404 : jj 3462 } else {
405 : jj 3463 warn "Bug -- should not be here in interval_cmp";
406 : jj 3462 }
407 :    
408 :     Context($oldContext);
409 :     return($ans_eval);
410 :     }
411 :    
412 : sh002i 5568 =head2 number_list_cmp
413 : gage 1064
414 :     Checks an answer which is a comma-separated list of numbers. The actual
415 :     numbers are fed to num_cmp, so all of the flexibilty of num_cmp carries
416 :     over (values can be expressions to be evaluated). For example,
417 :    
418 : sh002i 5568 number_list_cmp("1, -2")
419 : gage 1064
420 :     will accept "1, -2", "-2, 1", or "-1-1,sqrt(1)".
421 :    
422 : sh002i 5568 number_list_cmp("1^2 + 1, 2^2 + 1, 3^2 + 1", ordered=>'strict')
423 : gage 1064
424 :     will accept "2, 5, 10", but not "5, 2, 10".
425 :    
426 :     If you want to allow complex number entries, complex=>'ok' will cause it
427 :     to use cplx_cmp instead:
428 :    
429 : sh002i 5568 number_list_cmp("2, -2, 2i, -2i", complex=>'ok')
430 : gage 1064
431 :     In cases where you set complex=>'ok', be sure the problem file loads
432 :     PGcomplexmacros.pl.
433 :    
434 :     Optional arguements for num_cmp (resp. cplx_cmp) can be used as well,
435 :     such as
436 :    
437 : sh002i 5568 number_list_cmp("cos(3), sqrt(111)", relTol => 3)
438 : gage 1064
439 :     The strings=>['hello'] argument is treated specially. It can be used to
440 :     replace the entire answer. So
441 :    
442 : sh002i 5568 number_list_cmp("cos(3), sqrt(111)", strings=>['none'])
443 : gage 1064
444 :     will mark "none" wrong, but not generate an error. On the other hand,
445 :    
446 : sh002i 5568 number_list_cmp("none", strings=>['none'])
447 : gage 1064
448 : jj 3455 will mark "none" as correct.
449 : gage 1064
450 : jj 3489 One can also specify optionnal arguments for Parser's List checker: showHints,
451 :     partialCredit, and showLengthHints, as in:
452 :    
453 : sh002i 5568 number_list_cmp("cos(3), sqrt(111)", partialCredit=>1)
454 : jj 3489
455 : gage 1064 =cut
456 :    
457 : sh002i 5658 # ^function number_list_cmp
458 :     # ^uses Context
459 :     # ^uses mode2context
460 :     # ^uses List
461 : gage 1064 sub number_list_cmp {
462 : jj 3455 my $list = shift;
463 : dpvc 5566
464 : jj 3455 my %num_params = @_;
465 : dpvc 5566
466 : jj 3462 my $mode = $num_params{mode} || 'std';
467 :     my %options = (debug => $num_params{debug});
468 : dpvc 5566
469 : jj 3462 #
470 :     # Get an apppropriate context based on the mode
471 :     #
472 : jj 3455 my $oldContext = Context();
473 : jj 3506 my $context = mode2context($mode, %num_params);
474 : dpvc 5566
475 : jj 3489 #$context->strings->clear;
476 : jj 3463 if ($num_params{strings}) {
477 : jj 3462 foreach my $string (@{$num_params{strings}}) {
478 :     my %tex = ($string =~ m/(-?)inf(inity)?/i)? (TeX => "$1\\infty"): ();
479 : jj 3489 $string = uc($string);
480 :     $context->strings->add($string => {%tex}) unless
481 :     defined($context->strings->get($string));
482 : jj 3462 }
483 :     }
484 : dpvc 5566
485 :     $options{ordered} = 1 if defined($num_params{ordered});
486 : jj 3463 # These didn't exist before in number_list_cmp so they behaved like
487 :     # in List()->cmp. Now they can be optionally set
488 : jj 3489 for my $o qw( showHints partialCredit showLengthHints ) {
489 :     $options{$o} = $num_params{$o} || 0;
490 :     }
491 : dpvc 5566
492 : jj 3455 Context($context);
493 : jj 3462 my $ans_eval = List($list)->cmp(%options);
494 : jj 3455 Context($oldContext);
495 :     return($ans_eval);
496 : gage 1064 }
497 :    
498 : jj 3455
499 : sh002i 5568 =heads equation_cmp
500 : gage 1064
501 :     Compares an equation. This really piggy-backs off of fun_cmp. It looks
502 :     at LHS-RHS of the equations to see if they agree up to constant multiple.
503 :     It also guards against an answer of 0=0 (which technically gives a constant
504 :     multiple of any equation). It is best suited to situations such as checking
505 :     the equation of a line which might be vertical and you don't want to give
506 :     that away, or checking equations of ellipses where the students answer should
507 :     be quadratic.
508 :    
509 :     Typical invocation would be:
510 :    
511 : sh002i 5568 equation_com("x^2+(y-1)^2 = 11", vars=>['x','y'])
512 : gage 1064
513 :     =cut
514 :    
515 : sh002i 5658 # ^function equation_cmp
516 :     # ^uses Equation_eval::equation_cmp
517 : gage 1064 sub equation_cmp {
518 :     Equation_eval::equation_cmp(@_);
519 :     }

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9