[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 1064 - (view) (download) (as text)

1 : gage 1064 #!/usr/local/bin/webwork-perl
2 :    
3 :     # This is extraAnswerEvaluators.pl
4 :    
5 :     # Most of the work is done in special namespaces
6 :     # At the end, we provide one global function, the interval answer evaluator
7 :    
8 :     # To do:
9 :     # Convert these to AnswerEvaluator objects
10 :     # Better error checking/messages
11 :     # Simplify checks so we don't make so much use of num_cmp and cplx_cmp.
12 :     # When they change, these functions may have to change.
13 :    
14 :     =head1 NAME
15 :    
16 :     extraAnswerEvaluators.pl -- located in the courseScripts directory
17 :    
18 :     =head1 SYNPOSIS
19 :    
20 :     Answer Evaluators for intervals, lists of numbers, lists of points,
21 :     and equations.
22 :    
23 :     interval_cmp() -- checks answers which are unions of intervals.
24 :     It can also be used for checking an ordered pair or
25 :     list of ordered pairs.
26 :    
27 :     number_list_cmp() -- checks a comma separated list of numbers. By use of
28 :     optional arguments, you can request that order be
29 :     important, that complex numbers be allowed, and
30 :     specify extra arguments to be sent to num_cmp (or
31 :     cplx_cmp) for checking individual entries.
32 :    
33 :     equation_cmp() -- provides a limited facility for checking equations.
34 :     It makes no pretense of checking to see if the real locus
35 :     of the student's equation matches the real locus of the
36 :     instructor's equation. The student's equation must be
37 :     of the same general type as the instructors to get credit.
38 :    
39 :    
40 :     =cut
41 :    
42 :     =head1 DESCRIPTION
43 :    
44 :     This file adds subroutines which create "answer evaluators" for checking student
45 :     answers of various "exotic" types.
46 :    
47 :     =cut
48 :    
49 :    
50 :     {
51 :     package Intervals;
52 :    
53 :     # We accept any of the following as infinity (case insensitive)
54 :     @infinitywords = ("i", "inf", "infty", "infinity");
55 :     $infinityre = join '|', @infinitywords;
56 :     $infinityre = "^([-+m]?)($infinityre)\$";
57 :    
58 :     sub new {
59 :     my $class = shift;
60 :     my $base_string = shift;
61 :     my $self = {};
62 :     $self->{'original'} = $base_string;
63 :     return bless $self, $class;
64 :     }
65 :    
66 :     # Not object oriented. It just returns the structure
67 :     sub new_interval { # must call with 4 arguments
68 :     my($l,$r,$lec, $rec) = @_;
69 :     return [[$l,$r],[$lec,$rec]];
70 :     }
71 :    
72 :     # error routine copied from AlgParser
73 :     sub error {
74 :     my($self, @args) = @_;
75 :     # we cheat to use error from algparser
76 :     my($ap) = new AlgParser();
77 :     $ap->inittokenizer($self->{'original'});
78 :     $ap->error(@args);
79 :     $self->{htmlerror} = $ap->{htmlerror};
80 :     $self->{error_msg} = $ap->{error_msg};
81 :     }
82 :    
83 :     # Determine if num_cmp detected a parsing/syntax type error
84 :    
85 :     sub has_errors {
86 :     my($ah) = shift;
87 :    
88 :     if($ah->{'student_ans'} =~ /error/) {
89 :     return 1;
90 :     }
91 :     my($am) = $ah->{'ans_message'};
92 :     if($am =~ /error/) {
93 :     return 2;
94 :     }
95 :     if($am =~ /must enter/) {
96 :     return 3;
97 :     }
98 :     if($am =~ /does not evaluate/) {
99 :     return 4;
100 :     }
101 :     return 0;
102 :     }
103 :    
104 :    
105 :     ## Parse a string into a bunch of intervals
106 :     ## We do it by hand to avoid problems of nested parentheses
107 :     ## This also builds a normalized version of the string, one with values,
108 :     ## and a latex version.
109 :     ##
110 :     ## Return value simply says whether or not this was successful
111 :     sub parse_intervals {
112 :     my($self) = shift;
113 :     my(%opts) = @_;
114 :     my($str) = $self->{'original'};
115 :     my(@ans_list) = ();
116 :     delete($opts{'sloppy'});
117 :     delete($opts{'ordered'});
118 :     my($unions) = 1;
119 :     if (defined($opts{'unions'}) and ($opts{'unions'} eq 'no')) {
120 :     $unions = 0;
121 :     }
122 :     # Sometimes we use this for lists of points
123 :     delete($opts{'unions'});
124 :     my($b1str,$b2str) = (', ', ', ');
125 :     if($unions) {
126 :     ($b1str,$b2str) = (' U ', ' \cup ');
127 :     }
128 :    
129 :     my($tmp_ae) = main::num_cmp(1, %opts);
130 :     $self->{'normalized'} = '';
131 :     $self->{'value'} = '';
132 :     $self->{'latex'} = '';
133 :     $self->{'htmlerror'} = '';
134 :     $self->{'error_msg'} = '';
135 :     my($pmi) = 0;
136 :     my(@cur) = ("","");
137 :     my($lb,$rb) = (0,0);
138 :     my($level,$spot,$hold,$char,$lr) = (0,0,0,"a",0);
139 :    
140 :     while ($spot < length($str)) {
141 :     $char = substr($str,$spot,1);
142 :     if ($char=~ /[\[(,)\]]/) { # Its a special character
143 :     if ($char eq ",") {
144 :     if ($level == 1) { # Level 1 comma
145 :     if ($lr == 1) {
146 :     $self->error("Not a valid interval; too many commas.",[$spot]);
147 :     return 0;
148 :     } else {
149 :     $lr=1;
150 :     $cur[0] = substr($str,$hold, $spot-$hold);
151 :     if($pmi = pminf($cur[0])) {
152 :     if($pmi<0) {
153 :     $self->{'value'} .= '-';
154 :     $self->{'normalized'} .= '-';
155 :     $self->{'latex'} .= '-';
156 :     }
157 :     $self->{'value'} .= 'Infinity, ';
158 :     $self->{'normalized'} .= 'Infinity, ';
159 :     $self->{'latex'} .= '\infty, ';
160 :     } else {
161 :     my($tmp_ah) = $tmp_ae->evaluate($cur[0]);
162 :     if(has_errors($tmp_ah)) {
163 :     $self->error("I could not parse your input correctly",[$hold, $spot]);
164 :     return 0;
165 :     }
166 :     $self->{'normalized'} .= $tmp_ah->{'preview_text_string'}.", ";
167 :     $self->{'value'} .= $tmp_ah->{'student_ans'}.", ";
168 :     $self->{'latex'} .= $tmp_ah->{'preview_latex_string'}.", ";
169 :     }
170 :     $hold = $spot+1;
171 :     }
172 :     }
173 :     } # end of comma
174 :     elsif ($char eq "[" or $char eq "(") { #opening
175 :     if ($level==0) {
176 :     $lr = 0;
177 :     if(scalar(@ans_list)) { # this is not the first interval
178 :     $self->{'normalized'} .= $b1str;
179 :     $self->{'value'} .= $b1str;
180 :     $self->{'latex'} .= $b2str;
181 :     }
182 :     $self->{'normalized'} .= "$char";
183 :     $self->{'value'} .= "$char";
184 :     $self->{'latex'} .= "$char";
185 :     $hold=$spot+1;
186 :     if ($char eq "[") {
187 :     $lb = 1;
188 :     } else {
189 :     $lb = 0;
190 :     }
191 :     }
192 :     $level++;
193 :     } # end of open paren
194 :     else { # must be closed paren
195 :     if ($level == 0) {
196 :     $self->error("Not a valid interval; extra $char when I expected a new interval to open.",[$spot]);
197 :     return 0;
198 :     } elsif ($level == 1) {
199 :     if ($lr != 1) {
200 :     $self->error("Not a valid interval; closing an interval without a right component.", [$spot]);
201 :     return 0;
202 :     } else {
203 :     $cur[1] = substr($str, $hold, $spot-$hold);
204 :     if($pmi = pminf($cur[1])) {
205 :     if($pmi<0) {
206 :     $self->{'value'} .= '-';
207 :     $self->{'normalized'} .= '-';
208 :     $self->{'latex'} .= '-';
209 :     }
210 :     $self->{'value'} .= "Infinity$char";
211 :     $self->{'normalized'} .= "Infinity$char";
212 :     $self->{'latex'} .= '\infty'."$char";
213 :     } else {
214 :     my($tmp_ah) = $tmp_ae->evaluate($cur[1]);
215 :     if(has_errors($tmp_ah)) {
216 :     $self->error("I could not parse your input correctly",[$hold, $spot]);
217 :     return 0;
218 :     }
219 :     $self->{'normalized'} .= $tmp_ah->{'preview_text_string'}."$char";
220 :     $self->{'value'} .= $tmp_ah->{'student_ans'}."$char";
221 :     $self->{'latex'} .= $tmp_ah->{'preview_latex_string'}."$char";
222 :     }
223 :     if ($char eq "]") {
224 :     $rb = 1;
225 :     } else {
226 :     $rb = 0;
227 :     }
228 :     push @ans_list, new_interval($cur[0], $cur[1], $lb, $rb);
229 :     }
230 :     }
231 :     $level--;
232 :     }
233 :     }
234 :     $spot++;
235 :     }
236 :    
237 :     if($level>0) {
238 :     $self->error("Your expression ended in the middle of an interval.",
239 :     [$hold, $spot]);
240 :     return 0;
241 :     }
242 :     $self->{'parsed'} = \@ans_list;
243 :     return 1;
244 :     }
245 :    
246 :     # Is the argument an exceptable +/- infinity
247 :     # Its sort of multiplies the input by 0 using 0 * oo = 1, 0 * (-oo) = -1.
248 :     sub pminf {
249 :     my($val) = shift;
250 :     $val = "\L$val"; # lowercase
251 :     $val =~ s/ //g; # remove space
252 :     if ($val =~ /$infinityre/) {
253 :     if (($1 eq '-') or ($1 eq 'm')) {
254 :     return -1;
255 :     } else {
256 :     return 1;
257 :     }
258 :     }
259 :     return 0;
260 :     }
261 :    
262 :     # inputs are now of type Intervals, and then options
263 :    
264 :     sub cmp_intervals {
265 :     my($in1) = shift;
266 :     my($in2) = shift;
267 :     my(%opts) = @_;
268 :     my($strict_ordering) = 0;
269 :     if (defined($opts{'ordering'}) && $opts{'ordering'} eq 'strict') {
270 :     $strict_ordering = 1;
271 :     }
272 :     delete($opts{'ordering'});
273 :    
274 :     my($issloppy) = 0;
275 :     if (defined($opts{'sloppy'}) && $opts{'sloppy'} eq 'yes') {
276 :     $issloppy = 1;
277 :     }
278 :     delete($opts{'sloppy'});
279 :    
280 :     delete($opts{'unions'});
281 :    
282 :    
283 :     my(@i1) = @{$in1->{'parsed'}};
284 :     my(@i2) = @{$in2->{'parsed'}};
285 :    
286 :     my($j,$pm10,$pm11,$pm20,$pm21);
287 :     # Same number of intervals?
288 :     if (scalar(@i1) != scalar(@i2)) {
289 :     return 0;
290 :     }
291 :     for ($j=0; $j<scalar(@i1);$j++) {
292 :     my($lbound) = 0;
293 :     my($ubound) = scalar(@i1)-1;
294 :     my($lookformatch) = 1;
295 :     if ($strict_ordering) {
296 :     $lbound = $j;
297 :     $ubound = $j;
298 :     }
299 :     for ($k=$lbound; $lookformatch && $k<=$ubound; $k++) {
300 :     # Do they all have correct inclusions ()[]?
301 :     if (! $issloppy and ($i1[$j]->[1][0] != $i2[$k]->[1][0] or
302 :     $i1[$j]->[1][1] != $i2[$k]->[1][1])) {
303 :     next;
304 :     }
305 :     $pm10 = pminf($i1[$j]->[0][0]);
306 :     $pm11 = pminf($i1[$j]->[0][1]);
307 :     $pm20 = pminf($i2[$k]->[0][0]);
308 :     $pm21 = pminf($i2[$k]->[0][1]);
309 :     if ($pm10 != $pm20) {
310 :     next;
311 :     }
312 :     if ($pm11 != $pm21) {
313 :     next;
314 :     }
315 :     # Now we deal with only numbers, no infinities
316 :     if ($pm10 == 0) {
317 :     # $opts{'correctAnswer'} = $i1[$j]->[0][0];
318 :     my $ae = main::num_cmp($i1[$j]->[0][0], %opts);
319 :     my $result = $ae->evaluate($i2[$k]->[0][0]);
320 :     if ($result->{score} == 0) {
321 :     next;
322 :     }
323 :     }
324 :     if ($pm11 == 0) {
325 :     # $opts{'correctAnswer'} = $i1[$j]->[0][1];
326 :     my $ae = main::num_cmp($i1[$j]->[0][1], %opts);
327 :     my $result = $ae->evaluate($i2[$k]->[0][1]);
328 :     if ($result->{score} == 0) {
329 :     next;
330 :     }
331 :     }
332 :     $lookformatch=0;
333 :     }
334 :     if ($lookformatch) { # still looking ...
335 :     return 0;
336 :     }
337 :     }
338 :     return 1;
339 :     }
340 :    
341 :     sub show_int {
342 :     my($intt) = shift;
343 :     my($intstring) = "";
344 :     return "|$intt->[0]->[0]%%$intt->[0]->[1]|";
345 :     }
346 :    
347 :    
348 :    
349 :     } # End of package Intervals
350 :    
351 :     {
352 :     package Interval_evaluator;
353 :    
354 :     sub nicify_string {
355 :     my $str = shift;
356 :    
357 :     $str = uc($str);
358 :     $str =~ s/\s//g; # remove white space
359 :     $str;
360 :     }
361 :    
362 :     ##### The answer evaluator
363 :    
364 :     sub interval_cmp {
365 :    
366 :     my $right_ans = shift;
367 :     my %opts = @_;
368 :    
369 :     $opts{'mode'} = 'std' unless defined($opts{'mode'});
370 :     $opts{'tolType'} = 'relative' unless defined($opts{'tolType'});
371 :    
372 :     my $ans_eval = sub {
373 :     my $student = shift;
374 :    
375 :     my $ans_hash = new AnswerHash(
376 :     'score'=>0,
377 :     'correct_ans'=>$right_ans,
378 :     'student_ans'=>$student,
379 :     'original_student_ans' => $student,
380 :     # 'type' => undef,
381 :     'ans_message'=>'',
382 :     'preview_text_string'=>'',
383 :     'preview_latex_string'=>'',
384 :     );
385 :     # Handle string matches separately
386 :     my($studentisstring, $correctisstring, $tststr) = (0,0,"");
387 :     my($nicestud, $nicecorrect) = (nicify_string($student),
388 :     nicify_string($right_ans));
389 :     if(defined($opts{'strings'})) {
390 :     for $tststr (@{$opts{'strings'}}) {
391 :     $tststr = nicify_string($tststr);
392 :     if(($tststr eq $nicestud)) {$studentisstring=1;}
393 :     if(($tststr eq $nicecorrect)) {$correctisstring=1;}
394 :     }
395 :     if($studentisstring) {
396 :     $ans_hash->{'preview_text_string'} = $student;
397 :     $ans_hash->{'preview_latex_string'} = $student;
398 :     }
399 :     }
400 :     my($student_int, $correct_int);
401 :     if(!$studentisstring) {
402 :     $student_int = new Intervals($student);
403 :     if(! $student_int->parse_intervals(%opts)) {
404 :     # Error in student input
405 :     $ans_hash->{'student_ans'} = "error: $student_int->{htmlerror}";
406 :     $ans_hash->{'ans_message'} = "$student_int->{error_msg}";
407 :     return $ans_hash;
408 :     }
409 :    
410 :     $ans_hash->{'student_ans'} = $student_int->{'value'};
411 :     $ans_hash->{'preview_text_string'} = $student_int->{'normalized'};
412 :     $ans_hash->{'preview_latex_string'} = $student_int->{'latex'};
413 :     }
414 :    
415 :     if(!$correctisstring) {
416 :     $correct_int = new Intervals($right_ans);
417 :     if(! $correct_int->parse_intervals(%opts)) {
418 :     # Cannot parse instuctor's answer!
419 :     $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem.";
420 :     return $ans_hash;
421 :     }
422 :     }
423 :     if($correctisstring || $studentisstring) {
424 :     if($nicestud eq $nicecorrect) {
425 :     $ans_hash -> setKeys('score' => 1);
426 :     }
427 :     } else {
428 :     if (Intervals::cmp_intervals($correct_int, $student_int, %opts)) {
429 :     $ans_hash -> setKeys('score' => 1);
430 :     }
431 :     }
432 :    
433 :     return $ans_hash;
434 :     };
435 :    
436 :     return $ans_eval;
437 :     }
438 :    
439 :     }
440 :    
441 :    
442 :     {
443 :     package Number_List;
444 :    
445 :     sub new {
446 :     my $class = shift;
447 :     my $base_string = shift;
448 :     my $self = {};
449 :     $self->{'original'} = $base_string;
450 :     return bless $self, $class;
451 :     }
452 :    
453 :     sub make_complex_number {
454 :     my $instring = shift;
455 :    
456 :     $instring = main::math_constants($instring);
457 :     $instring =~ s/e\^/exp /g;
458 :     my $parser = new AlgParserWithImplicitExpand;
459 :     my $ret = $parser -> parse($instring);
460 :     $parser -> tostring();
461 :     $parser -> normalize();
462 :     $instring = $parser -> tostring();
463 :     $instring =~ s/\bi\b/(i)/g;
464 :     my ($in,$PG_errors,$PG_errors_long) = main::PG_restricted_eval($instring);
465 :     return ($in+0*Complex1::i());
466 :     }
467 :    
468 :    
469 :    
470 :     sub parse_number_list {
471 :     my($self) = shift;
472 :     my(%opts) = @_;
473 :     my($str) = $self->{'original'};
474 :     my(@ans_list) = ();
475 :     my(@sort_list) = ();
476 :     delete($opts{'ordered'});
477 :    
478 :     my $complex=0;
479 :     if(defined($opts{'complex'}) &&
480 :     ($opts{'complex'} =~ /(yes|ok)/i)) {
481 :     $complex=1;
482 :     delete($opts{'mode'});
483 :     }
484 :     delete($opts{'complex'});
485 :     $self->{'normalized'} = '';
486 :     $self->{'value'} = '';
487 :     $self->{'latex'} = '';
488 :     $self->{'htmlerror'} = '';
489 :     $self->{'error_msg'} = '';
490 :     my($cur) = "";
491 :     my($level,$spot,$hold,$char) = (1,0,0,"a");
492 :     my($strt, $end) = (0, length($str));
493 :     my($specials) = '[\(\[\]\),\{\}]';
494 :     my($tmp_ae,$tmp_ae2);
495 :     if($complex) {
496 :     $tmp_ae = main::cplx_cmp(new Complex(1,0), %opts);
497 :     $tmp_ae2 = main::cplx_cmp(new Complex(1,0));
498 :     } else {
499 :     $tmp_ae = main::num_cmp(1, %opts);
500 :     $tmp_ae2 = main::num_cmp(1);
501 :     }
502 :    
503 :     while ($spot < $end) {
504 :     $char = substr($str,$spot,1);
505 :     if ($char=~ /$specials/) { # Its a special character
506 :     if ($char eq ",") {
507 :     if ($level == 1) { # Level 1 comma
508 :     $cur = substr($str,$hold, $spot-$hold);
509 :     my($tmp_ah);
510 :     $tmp_ah = $tmp_ae->evaluate($cur);
511 :     if(has_errors($tmp_ah)) {
512 :     $self->error("I could not parse your input correctly",[$hold, $spot]);
513 :     return 0;
514 :     }
515 :     $self->{'normalized'} .= (defined($tmp_ah->{'preview_text_string'}) ? $tmp_ah->{'preview_text_string'} : $tmp_ah->{'student_ans'}).", ";
516 :     $self->{'value'} .= $tmp_ah->{'student_ans'}.", ";
517 :     $self->{'latex'} .= (defined($tmp_ah->{'preview_latex_string'}) ? $tmp_ah->{'preview_latex_string'} : $tmp_ah->{'student_ans'}).", ";
518 :     $tmp_ah = $tmp_ae2->evaluate($cur);
519 :     $hold = $spot+1;
520 :     push @sort_list, [$cur,$tmp_ah->{'student_ans'}];
521 :     push @ans_list, $cur;
522 :     }
523 :     } # end of comma
524 :     elsif ($char eq "[" or $char eq "(" or $char eq "{") { #opening
525 :     $level++;
526 :     } # end of open paren
527 :     else { # must be closing paren
528 :     if ($level == 1) {
529 :     $self->error("Not a valid entry; unmatched $char.",[$spot]);
530 :     return 0;
531 :     } # end of level <= 1
532 :     $level--;
533 :     } # end of closing brace
534 :     }
535 :     $spot++;
536 :     }
537 :    
538 :     if($level>1) {
539 :     $self->error("Your expression has unmatched parens.",
540 :     [$hold, $spot]);
541 :     return 0;
542 :     }
543 :     $cur = substr($str,$hold, $spot-$hold);
544 :    
545 :     my($tmp_ah);
546 :     $tmp_ah = $tmp_ae->evaluate($cur);
547 :    
548 :     if(has_errors($tmp_ah)) {
549 :     $self->error("I could not parse your input correctly",[$hold, $spot]);
550 :     return 0;
551 :     }
552 :     if(not ($cur =~ /\w/)) { # Input was empty
553 :     $self->{'forsort'} = [];
554 :     return 1;
555 :     }
556 :    
557 :     $self->{'normalized'} .= defined($tmp_ah->{'preview_text_string'}) ? $tmp_ah->{'preview_text_string'} : $tmp_ah->{'student_ans'};
558 :     $self->{'value'} .= $tmp_ah->{'student_ans'};
559 :     $self->{'latex'} .= defined($tmp_ah->{'preview_latex_string'}) ? $tmp_ah->{'preview_latex_string'} : $tmp_ah->{'student_ans'};
560 :     if((3==4) && $complex) {
561 :     $tmp_ah =&{$tmp_ae2}($cur);
562 :     } else {
563 :     $tmp_ah = $tmp_ae2->evaluate($cur);
564 :     }
565 :     $hold = $spot+1;
566 :     push @sort_list, [$cur, $tmp_ah->{'student_ans'}];
567 :     push @ans_list, $cur;
568 :    
569 :     $self->{'parsed'} = \@ans_list;
570 :     $self->{'forsort'} = \@sort_list;
571 :     return 1;
572 :     }
573 :    
574 :     sub number_list_cmp {
575 :     my $right_ans = shift;
576 :     my %opts = @_;
577 :    
578 :     $opts{'mode'} = 'std' unless defined($opts{'mode'});
579 :     $opts{'tolType'} = 'relative' unless defined($opts{'tolType'});
580 :    
581 :     my $ans_eval = sub {
582 :     my $student = shift;
583 :    
584 :     my $ans_hash = new AnswerHash(
585 :     'score'=>0,
586 :     'correct_ans'=>$right_ans,
587 :     'student_ans'=>$student,
588 :     'original_student_ans' => $student,
589 :     # 'type' => undef,
590 :     'ans_message'=>'',
591 :     'preview_text_string'=>'',
592 :     'preview_latex_string'=>'',
593 :     );
594 :     my $student_list = new Number_List($student);
595 :     if(! $student_list->parse_number_list(%opts)) {
596 :     # Error in student input
597 :     $ans_hash->{'student_ans'} = "error: $student_list->{htmlerror}";
598 :     $ans_hash->{'ans_message'} = "$student_list->{error_msg}";
599 :     return $ans_hash;
600 :     }
601 :    
602 :     $ans_hash->{'student_ans'} = $student_list->{'value'};
603 :     $ans_hash->{'preview_text_string'} = $student_list->{'normalized'};
604 :     $ans_hash->{'preview_latex_string'} = $student_list->{'latex'};
605 :    
606 :     my $correct_list = new Number_List($right_ans);
607 :     if(! $correct_list->parse_number_list(%opts)) {
608 :     # Cannot parse instuctor's answer!
609 :     $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem.";
610 :     return $ans_hash;
611 :     }
612 :     if (cmp_numlists($correct_list, $student_list, %opts)) {
613 :     $ans_hash -> setKeys('score' => 1);
614 :     }
615 :    
616 :     return $ans_hash;
617 :     };
618 :    
619 :     return $ans_eval;
620 :     }
621 :    
622 :     sub sorting_sub {
623 :     $_[0]->[1] <=> $_[1]->[1];
624 :     }
625 :    
626 :     sub cmp_numlists {
627 :     my($in1) = shift;
628 :     my($in2) = shift;
629 :     my(%opts) = @_;
630 :     my($strict_ordering) = 0;
631 :     if (defined($opts{'ordered'}) && ($opts{'ordered'} eq 'yes')) {
632 :     $strict_ordering = 1;
633 :     }
634 :     delete($opts{'ordered'});
635 :    
636 :     my $complex=0;
637 :     if(defined($opts{'complex'}) &&
638 :     ($opts{'complex'} =~ /(yes|ok)/i)) {
639 :     $complex=1;
640 :     delete($opts{'mode'});
641 :     }
642 :     delete($opts{'complex'});
643 :    
644 :     my(@fs1) = @{$in1->{'forsort'}};
645 :     my(@fs2) = @{$in2->{'forsort'}};
646 :    
647 :    
648 :     # Same number of values?
649 :     if (scalar(@fs1) != scalar(@fs2)) {
650 :     return 0;
651 :     }
652 :    
653 :     my($j);
654 :     if($complex) {
655 :     for $j (@fs1) {$j->[1] = make_complex_number($j->[1]);}
656 :     for $j (@fs2) {$j->[1] = make_complex_number($j->[1]);}
657 :     }
658 :    
659 :     if($strict_ordering==0) {
660 :     @fs1 = main::PGsort(sub {$_[0]->[1] <=> $_[1]->[1];}, @fs1);
661 :     @fs2 = main::PGsort(sub {$_[0]->[1] <=> $_[1]->[1];}, @fs2);
662 :     }
663 :    
664 :     for ($j=0; $j<scalar(@fs1);$j++) {
665 :     my $ae;
666 :     if($complex) {
667 :     $ae = main::cplx_cmp($fs1[$j]->[1], %opts);
668 :     } else {
669 :     $ae = main::num_cmp($fs1[$j]->[0], %opts);
670 :     }
671 :     my $result;
672 :     if($complex) {
673 :     $result =$ae->evaluate($fs2[$j]->[1]);
674 :     } else {
675 :     $result = $ae->evaluate($fs2[$j]->[0]);
676 :     }
677 :     if ($result->{score} == 0) {
678 :     return 0;
679 :     }
680 :     }
681 :     return 1;
682 :     }
683 :    
684 :     # error routine copied from AlgParser
685 :     sub error {
686 :     my($self, @args) = @_;
687 :     # we cheat to use error from algparser
688 :     my($ap) = new AlgParser();
689 :     $ap->inittokenizer($self->{'original'});
690 :     $ap->error(@args);
691 :     $self->{htmlerror} = $ap->{htmlerror};
692 :     $self->{error_msg} = $ap->{error_msg};
693 :     }
694 :    
695 :     sub has_errors {
696 :     my($ah) = shift;
697 :    
698 :     if($ah->{'student_ans'} =~ /error/) {
699 :     return 1;
700 :     }
701 :     my($am) = $ah->{'ans_message'};
702 :     if($am =~ /error/) {
703 :     return 2;
704 :     }
705 :     if($am =~ /must enter/) {
706 :     return 3;
707 :     }
708 :     if($am =~ /does not evaluate/) {
709 :     return 4;
710 :     }
711 :     return 0;
712 :     }
713 :    
714 :     # Syntax is
715 :     # interval_cmp("[1,2) U [3, infty)", options)
716 :     # where options are key/value pairs for num_cmp. Also, we allow the option
717 :     # 'ordering' which can be 'strict', which means that we do not want to test rearrangements
718 :     # of the intervals.
719 :    
720 :    
721 :     }
722 :    
723 :     {
724 :     package Equation_eval;
725 :    
726 :     sub split_eqn {
727 :     my $instring = shift;
728 :    
729 :     split /=/, $instring;
730 :     }
731 :    
732 :    
733 :     sub equation_cmp {
734 :     my $right_ans = shift;
735 :     my %opts = @_;
736 :     my $vars = ['x','y'];
737 :    
738 :    
739 :     $vars = $opts{'vars'} if defined($opts{'vars'});
740 :    
741 :     my $ans_eval = sub {
742 :     my $student = shift;
743 :    
744 :     my $ans_hash = new AnswerHash(
745 :     'score'=>0,
746 :     'correct_ans'=>$right_ans,
747 :     'student_ans'=>$student,
748 :     'original_student_ans' => $student,
749 :     # 'type' => undef,
750 :     'ans_message'=>'',
751 :     'preview_text_string'=>'',
752 :     'preview_latex_string'=>'',
753 :     );
754 :    
755 :     if(! ($student =~ /\S/)) { return $ans_hash; }
756 :    
757 :     my @right= split_eqn($right_ans);
758 :     if(scalar(@right) != 2) {
759 :     $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem.";
760 :     return $ans_hash;
761 :     }
762 :     my @studsplit = split_eqn($student);
763 :     if(scalar(@studsplit) != 2) {
764 :     $ans_hash->{'ans_message'} = "You did not enter an equation (with an equals sign and two sides).";
765 :     return $ans_hash;
766 :     }
767 :    
768 :     # Next we should do syntax checks on everyone
769 :    
770 :     my $ah = new AnswerHash;
771 :     $ah->input($right[0]);
772 :     $ah=main::check_syntax($ah);
773 :     if($ah->{error_flag}) {
774 :     $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem.";
775 :     return $ans_hash;
776 :     }
777 :    
778 :     $ah->input($right[1]);
779 :     $ah=main::check_syntax($ah);
780 :     if($ah->{error_flag}) {
781 :     $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem.";
782 :     return $ans_hash;
783 :     }
784 :    
785 :     # Correct answer checks out, now check student's syntax
786 :    
787 :     my @prevs = ("","");
788 :     my @prevtxt = ("","");
789 :     $ah->input($studsplit[0]);
790 :     $ah=main::check_syntax($ah);
791 :     if($ah->{error_flag}) {
792 :     $ans_hash->{'ans_message'} = "Syntax error on the left side of your equation.";
793 :     return $ans_hash;
794 :     }
795 :     $prevs[0] = $ah->{'preview_latex_string'};
796 :     $prevstxt[0] = $ah->{'preview_text_string'};
797 :    
798 :    
799 :     $ah->input($studsplit[1]);
800 :     $ah=main::check_syntax($ah);
801 :     if($ah->{error_flag}) {
802 :     $ans_hash->{'ans_message'} = "Syntax error on the right side of your equation.";
803 :     return $ans_hash;
804 :     }
805 :     $prevs[1] = $ah->{'preview_latex_string'};
806 :     $prevstxt[1] = $ah->{'preview_text_string'};
807 :    
808 :     $ans_hash->{'preview_latex_string'} = "$prevs[0] = $prevs[1]";
809 :     $ans_hash->{'preview_text_string'} = "$prevstxt[0] = $prevstxt[1]";
810 :    
811 :    
812 :     # Check for answer equivalent to 0=0
813 :     # Could be false positive below because of parameter
814 :     my $ae = main::fun_cmp("0", %opts);
815 :     my $res = $ae->evaluate("$studsplit[0]-($studsplit[1])");
816 :     if($res->{'score'}==1) {
817 :     # Student is 0=0, is correct answer also like this?
818 :     $res = $ae->evaluate("$right[0]-($right[1])");
819 :     if($res->{'score'}==1) {
820 :     $ans_hash-> setKeys('score' => $res->{'score'});
821 :     }
822 :     return $ans_hash;
823 :     }
824 :    
825 :     # Maybe answer really is 0=0, and student got it wrong, so check that
826 :     $res = $ae->evaluate("$right[0]-($right[1])");
827 :     if($res->{'score'}==1) {
828 :     return $ans_hash;
829 :     }
830 :    
831 :     # Finally, use fun_cmp to check the answers
832 :    
833 :     $ae = main::fun_cmp("o*($right[0]-($right[1]))", vars=>$vars, params=>['o'], %opts);
834 :     $res= $ae->evaluate("$studsplit[0]-($studsplit[1])");
835 :     $ans_hash-> setKeys('score' => $res->{'score'});
836 :    
837 :     return $ans_hash;
838 :     };
839 :    
840 :     return $ans_eval;
841 :     }
842 :     }
843 :    
844 :     =head3 interval_cmp ()
845 :    
846 :     Compares an interval or union of intervals. Typical invocations are
847 :    
848 :     interval_cmp("(2, 3] U(7, 11)")
849 :    
850 :     The U is used for union symbol. In fact, any garbage (or nothing at all)
851 :     can go between intervals. It makes sure open/closed parts of intervals
852 :     are correct, unless you don't like that. To have it ignore the difference
853 :     between open and closed endpoints, use
854 :    
855 :     interval_cmp("(2, 3] U(7, 11)", sloppy=>'yes')
856 :    
857 :     interval_cmp uses num_cmp on the endpoints. You can pass optional
858 :     arguments for num_cmp, so to change the tolerance, you can use
859 :    
860 :     interval_cmp("(2, 3] U(3+4, 11)", relTol=>3)
861 :    
862 :     The intervals can be listed in any order, unless you want to force a
863 :     particular order, which is signaled as
864 :    
865 :     interval_cmp("(2, 3] U(3+4, 11)", ordered=>'strict')
866 :    
867 :     You can specify infinity as an endpoint. It will do a case-insensitive
868 :     string match looking for I, Infinity, Infty, or Inf. You can prepend a +
869 :     or -, as in
870 :    
871 :     interval_cmp("(-inf, 3] U [e^10, infinity)")
872 :     or
873 :     interval_cmp("(-INF, 3] U [e^10, +I)")
874 :    
875 :     If the question might have an empty set as the answer, you can use
876 :     the strings option to allow for it. So
877 :    
878 :     interval_cmp("$ans", strings=>['empty'])
879 :    
880 :     will not generate an error message if the student enters the string
881 :     empty. Better still, it will mark a student answer of "empty" as correct
882 :     iff this matches $ans.
883 :    
884 :     You can use interval_cmp for ordered pairs, or lists of ordered pairs.
885 :     Internally, this is just a distinction of whether to put nice union symbols
886 :     between intervals, or commas. To get commas, use
887 :    
888 :     interval_cmp("(1,2), (2,3), (4,-1)", unions=>'no')
889 :    
890 :     Note that interval_cmp makes no attempt at simplifying overlapping intervals.
891 :     This becomes an important feature when you are really checking lists of
892 :     ordered pairs.
893 :    
894 :     =cut
895 :    
896 :     sub interval_cmp {
897 :     Interval_evaluator::interval_cmp(@_);
898 :     }
899 :    
900 :     =head3 number_list_cmp ()
901 :    
902 :     Checks an answer which is a comma-separated list of numbers. The actual
903 :     numbers are fed to num_cmp, so all of the flexibilty of num_cmp carries
904 :     over (values can be expressions to be evaluated). For example,
905 :    
906 :     number_list_cmp("1, -2")
907 :    
908 :     will accept "1, -2", "-2, 1", or "-1-1,sqrt(1)".
909 :    
910 :     number_list_cmp("1^2 + 1, 2^2 + 1, 3^2 + 1", ordered=>'strict')
911 :    
912 :     will accept "2, 5, 10", but not "5, 2, 10".
913 :    
914 :     If you want to allow complex number entries, complex=>'ok' will cause it
915 :     to use cplx_cmp instead:
916 :    
917 :     number_list_cmp("2, -2, 2i, -2i", complex=>'ok')
918 :    
919 :     In cases where you set complex=>'ok', be sure the problem file loads
920 :     PGcomplexmacros.pl.
921 :    
922 :     Optional arguements for num_cmp (resp. cplx_cmp) can be used as well,
923 :     such as
924 :    
925 :     number_list_cmp("cos(3), sqrt(111)", relTol => 3)
926 :    
927 :     The strings=>['hello'] argument is treated specially. It can be used to
928 :     replace the entire answer. So
929 :    
930 :     number_list_cmp("cos(3), sqrt(111)", strings=>['none'])
931 :    
932 :     will mark "none" wrong, but not generate an error. On the other hand,
933 :    
934 :     number_list_cmp("none", strings=>['none'])
935 :    
936 :     will makr "none" as correct.
937 :    
938 :     =cut
939 :    
940 :     sub number_list_cmp {
941 :     Number_List::number_list_cmp(@_);
942 :     }
943 :    
944 :     =head3 equation_cmp ()
945 :    
946 :     Compares an equation. This really piggy-backs off of fun_cmp. It looks
947 :     at LHS-RHS of the equations to see if they agree up to constant multiple.
948 :     It also guards against an answer of 0=0 (which technically gives a constant
949 :     multiple of any equation). It is best suited to situations such as checking
950 :     the equation of a line which might be vertical and you don't want to give
951 :     that away, or checking equations of ellipses where the students answer should
952 :     be quadratic.
953 :    
954 :     Typical invocation would be:
955 :    
956 :     equation_com("x^2+(y-1)^2 = 11", vars=>['x','y'])
957 :    
958 :     =cut
959 :    
960 :     sub equation_cmp {
961 :     Equation_eval::equation_cmp(@_);
962 :     }
963 :    

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9