Parent Directory
| 
Revision Log
Revision 3462 - (view) (download) (as text)
| 1 : | jj | 3455 | loadMacros('Parser.pl'); |
| 2 : | gage | 1064 | |
| 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 : | apizer | 1080 | |
| 27 : | gage | 1064 | 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 : | apizer | 1080 | |
| 33 : | gage | 1064 | 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 : | apizer | 1080 | |
| 53 : | gage | 1064 | # 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 : | apizer | 1080 | |
| 129 : | gage | 1064 | 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 : | apizer | 1080 | |
| 237 : | gage | 1064 | 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 : | apizer | 1080 | |
| 362 : | gage | 1064 | ##### 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 : | apizer | 1080 | |
| 372 : | gage | 1064 | my $ans_eval = sub { |
| 373 : | my $student = shift; | ||
| 374 : | apizer | 1080 | |
| 375 : | gage | 1064 | my $ans_hash = new AnswerHash( |
| 376 : | gage | 3320 | '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 : | gage | 1064 | # 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 : | apizer | 1080 | |
| 410 : | gage | 1064 | $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 : | package Equation_eval; | ||
| 443 : | |||
| 444 : | sub split_eqn { | ||
| 445 : | my $instring = shift; | ||
| 446 : | |||
| 447 : | split /=/, $instring; | ||
| 448 : | } | ||
| 449 : | apizer | 1080 | |
| 450 : | |||
| 451 : | gage | 1064 | sub equation_cmp { |
| 452 : | my $right_ans = shift; | ||
| 453 : | my %opts = @_; | ||
| 454 : | my $vars = ['x','y']; | ||
| 455 : | |||
| 456 : | apizer | 1080 | |
| 457 : | gage | 1064 | $vars = $opts{'vars'} if defined($opts{'vars'}); |
| 458 : | |||
| 459 : | my $ans_eval = sub { | ||
| 460 : | my $student = shift; | ||
| 461 : | apizer | 1080 | |
| 462 : | gage | 1064 | my $ans_hash = new AnswerHash( |
| 463 : | 'score'=>0, | ||
| 464 : | 'correct_ans'=>$right_ans, | ||
| 465 : | 'student_ans'=>$student, | ||
| 466 : | 'original_student_ans' => $student, | ||
| 467 : | # 'type' => undef, | ||
| 468 : | 'ans_message'=>'', | ||
| 469 : | 'preview_text_string'=>'', | ||
| 470 : | 'preview_latex_string'=>'', | ||
| 471 : | ); | ||
| 472 : | |||
| 473 : | if(! ($student =~ /\S/)) { return $ans_hash; } | ||
| 474 : | apizer | 1080 | |
| 475 : | gage | 1064 | my @right= split_eqn($right_ans); |
| 476 : | if(scalar(@right) != 2) { | ||
| 477 : | $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem."; | ||
| 478 : | return $ans_hash; | ||
| 479 : | } | ||
| 480 : | my @studsplit = split_eqn($student); | ||
| 481 : | if(scalar(@studsplit) != 2) { | ||
| 482 : | $ans_hash->{'ans_message'} = "You did not enter an equation (with an equals sign and two sides)."; | ||
| 483 : | return $ans_hash; | ||
| 484 : | } | ||
| 485 : | |||
| 486 : | # Next we should do syntax checks on everyone | ||
| 487 : | |||
| 488 : | my $ah = new AnswerHash; | ||
| 489 : | $ah->input($right[0]); | ||
| 490 : | $ah=main::check_syntax($ah); | ||
| 491 : | if($ah->{error_flag}) { | ||
| 492 : | $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem."; | ||
| 493 : | return $ans_hash; | ||
| 494 : | } | ||
| 495 : | apizer | 1080 | |
| 496 : | gage | 1064 | $ah->input($right[1]); |
| 497 : | $ah=main::check_syntax($ah); | ||
| 498 : | if($ah->{error_flag}) { | ||
| 499 : | $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem."; | ||
| 500 : | return $ans_hash; | ||
| 501 : | } | ||
| 502 : | |||
| 503 : | # Correct answer checks out, now check student's syntax | ||
| 504 : | |||
| 505 : | my @prevs = ("",""); | ||
| 506 : | my @prevtxt = ("",""); | ||
| 507 : | $ah->input($studsplit[0]); | ||
| 508 : | $ah=main::check_syntax($ah); | ||
| 509 : | if($ah->{error_flag}) { | ||
| 510 : | $ans_hash->{'ans_message'} = "Syntax error on the left side of your equation."; | ||
| 511 : | return $ans_hash; | ||
| 512 : | } | ||
| 513 : | $prevs[0] = $ah->{'preview_latex_string'}; | ||
| 514 : | $prevstxt[0] = $ah->{'preview_text_string'}; | ||
| 515 : | apizer | 1080 | |
| 516 : | |||
| 517 : | gage | 1064 | $ah->input($studsplit[1]); |
| 518 : | $ah=main::check_syntax($ah); | ||
| 519 : | if($ah->{error_flag}) { | ||
| 520 : | $ans_hash->{'ans_message'} = "Syntax error on the right side of your equation."; | ||
| 521 : | return $ans_hash; | ||
| 522 : | } | ||
| 523 : | $prevs[1] = $ah->{'preview_latex_string'}; | ||
| 524 : | $prevstxt[1] = $ah->{'preview_text_string'}; | ||
| 525 : | |||
| 526 : | $ans_hash->{'preview_latex_string'} = "$prevs[0] = $prevs[1]"; | ||
| 527 : | $ans_hash->{'preview_text_string'} = "$prevstxt[0] = $prevstxt[1]"; | ||
| 528 : | apizer | 1080 | |
| 529 : | |||
| 530 : | gage | 1064 | # Check for answer equivalent to 0=0 |
| 531 : | # Could be false positive below because of parameter | ||
| 532 : | my $ae = main::fun_cmp("0", %opts); | ||
| 533 : | my $res = $ae->evaluate("$studsplit[0]-($studsplit[1])"); | ||
| 534 : | if($res->{'score'}==1) { | ||
| 535 : | # Student is 0=0, is correct answer also like this? | ||
| 536 : | $res = $ae->evaluate("$right[0]-($right[1])"); | ||
| 537 : | if($res->{'score'}==1) { | ||
| 538 : | $ans_hash-> setKeys('score' => $res->{'score'}); | ||
| 539 : | } | ||
| 540 : | return $ans_hash; | ||
| 541 : | } | ||
| 542 : | |||
| 543 : | # Maybe answer really is 0=0, and student got it wrong, so check that | ||
| 544 : | $res = $ae->evaluate("$right[0]-($right[1])"); | ||
| 545 : | if($res->{'score'}==1) { | ||
| 546 : | return $ans_hash; | ||
| 547 : | } | ||
| 548 : | |||
| 549 : | # Finally, use fun_cmp to check the answers | ||
| 550 : | apizer | 1080 | |
| 551 : | gage | 1064 | $ae = main::fun_cmp("o*($right[0]-($right[1]))", vars=>$vars, params=>['o'], %opts); |
| 552 : | $res= $ae->evaluate("$studsplit[0]-($studsplit[1])"); | ||
| 553 : | $ans_hash-> setKeys('score' => $res->{'score'}); | ||
| 554 : | apizer | 1080 | |
| 555 : | gage | 1064 | return $ans_hash; |
| 556 : | }; | ||
| 557 : | |||
| 558 : | return $ans_eval; | ||
| 559 : | } | ||
| 560 : | } | ||
| 561 : | |||
| 562 : | =head3 interval_cmp () | ||
| 563 : | |||
| 564 : | Compares an interval or union of intervals. Typical invocations are | ||
| 565 : | |||
| 566 : | interval_cmp("(2, 3] U(7, 11)") | ||
| 567 : | |||
| 568 : | The U is used for union symbol. In fact, any garbage (or nothing at all) | ||
| 569 : | can go between intervals. It makes sure open/closed parts of intervals | ||
| 570 : | are correct, unless you don't like that. To have it ignore the difference | ||
| 571 : | between open and closed endpoints, use | ||
| 572 : | |||
| 573 : | interval_cmp("(2, 3] U(7, 11)", sloppy=>'yes') | ||
| 574 : | |||
| 575 : | interval_cmp uses num_cmp on the endpoints. You can pass optional | ||
| 576 : | arguments for num_cmp, so to change the tolerance, you can use | ||
| 577 : | |||
| 578 : | interval_cmp("(2, 3] U(3+4, 11)", relTol=>3) | ||
| 579 : | |||
| 580 : | The intervals can be listed in any order, unless you want to force a | ||
| 581 : | particular order, which is signaled as | ||
| 582 : | |||
| 583 : | interval_cmp("(2, 3] U(3+4, 11)", ordered=>'strict') | ||
| 584 : | |||
| 585 : | You can specify infinity as an endpoint. It will do a case-insensitive | ||
| 586 : | string match looking for I, Infinity, Infty, or Inf. You can prepend a + | ||
| 587 : | or -, as in | ||
| 588 : | |||
| 589 : | interval_cmp("(-inf, 3] U [e^10, infinity)") | ||
| 590 : | or | ||
| 591 : | interval_cmp("(-INF, 3] U [e^10, +I)") | ||
| 592 : | |||
| 593 : | If the question might have an empty set as the answer, you can use | ||
| 594 : | the strings option to allow for it. So | ||
| 595 : | |||
| 596 : | interval_cmp("$ans", strings=>['empty']) | ||
| 597 : | |||
| 598 : | will not generate an error message if the student enters the string | ||
| 599 : | empty. Better still, it will mark a student answer of "empty" as correct | ||
| 600 : | iff this matches $ans. | ||
| 601 : | |||
| 602 : | You can use interval_cmp for ordered pairs, or lists of ordered pairs. | ||
| 603 : | Internally, this is just a distinction of whether to put nice union symbols | ||
| 604 : | between intervals, or commas. To get commas, use | ||
| 605 : | |||
| 606 : | interval_cmp("(1,2), (2,3), (4,-1)", unions=>'no') | ||
| 607 : | |||
| 608 : | Note that interval_cmp makes no attempt at simplifying overlapping intervals. | ||
| 609 : | This becomes an important feature when you are really checking lists of | ||
| 610 : | ordered pairs. | ||
| 611 : | |||
| 612 : | =cut | ||
| 613 : | |||
| 614 : | jj | 3462 | sub interval_cmp2 { |
| 615 : | my $correct_ans = shift; | ||
| 616 : | |||
| 617 : | my %opts = @_; | ||
| 618 : | |||
| 619 : | my $mode = $num_params{mode} || 'std'; | ||
| 620 : | my %options = (debug => $opts{debug}); | ||
| 621 : | my $ans_type = ''; # set to List, Union, or Interval below | ||
| 622 : | |||
| 623 : | # | ||
| 624 : | # Get an apppropriate context based on the mode | ||
| 625 : | # | ||
| 626 : | my $oldContext = Context(); | ||
| 627 : | my ($context, $ans_eval); | ||
| 628 : | if(defined($opts{unions}) and $opts{unions} eq 'no' ) { | ||
| 629 : | # This is really a list of points | ||
| 630 : | $context = Context("Vector")->copy; | ||
| 631 : | $ans_type = 'List'; | ||
| 632 : | $options{showCoordinateHints} = 0; | ||
| 633 : | $options{showHints} = 0; | ||
| 634 : | $options{partialCredit}=0; | ||
| 635 : | $options{showLengthHints} = 0; | ||
| 636 : | } else { | ||
| 637 : | $context = Context("Numeric")->copy; | ||
| 638 : | $correct_ans =~ tr/u/U/; | ||
| 639 : | if($correct_ans =~ /U/) { | ||
| 640 : | $context->operators->add('u'=> {precedence => 0.5, associativity => 'left', | ||
| 641 : | type => 'bin', isUnion => 1, string => ' U ', TeX => '\cup ', | ||
| 642 : | class => 'Parser::BOP::union'}); | ||
| 643 : | # $context->operators->add('u'=> {alias => 'U'}); | ||
| 644 : | $ans_type = 'Union'; | ||
| 645 : | $options{showHints} = 0; | ||
| 646 : | $options{showLengthHints} = 0; | ||
| 647 : | $options{showEndpointHints}=0; | ||
| 648 : | $options{partialCredit}=0; | ||
| 649 : | } else { | ||
| 650 : | $ans_type = 'Interval'; | ||
| 651 : | $options{showEndpointHints}=0; | ||
| 652 : | } | ||
| 653 : | } | ||
| 654 : | $opts{tolType} = $opts{tolType} || 'relative'; | ||
| 655 : | $opts{tolerance} = $opts{tolerance} || $opts{tol} || | ||
| 656 : | $opts{reltol} || $opts{relTol} || $opts{abstol} || 1; | ||
| 657 : | $opts{zeroLevel} = $opts{zeroLevel} || $opts{zeroLevelTol} || | ||
| 658 : | $main::numZeroLevelTolDefault; | ||
| 659 : | if ($opts{tolType} eq 'absolute' or defined($opts{tol}) | ||
| 660 : | or defined($opts{abstol})) { | ||
| 661 : | $context->flags->set( | ||
| 662 : | tolerance => $opts{tolerance}, | ||
| 663 : | tolType => 'absolute', | ||
| 664 : | ); | ||
| 665 : | } else { | ||
| 666 : | $context->flags->set( | ||
| 667 : | tolerance => .01*$opts{tolerance}, | ||
| 668 : | tolType => 'relative', | ||
| 669 : | ); | ||
| 670 : | } | ||
| 671 : | $context->flags->set( | ||
| 672 : | zeroLevel => $opts{zeroLevel}, | ||
| 673 : | zeroLevelTol => $opts{zeroLevelTol}, | ||
| 674 : | ); | ||
| 675 : | $options{ordered} = 1 if(defined($opts{ordered}) and $opts{ordered}); | ||
| 676 : | if (defined($opts{'sloppy'}) && $opts{'sloppy'} eq 'yes') { | ||
| 677 : | $options{requireParenMatch} = 0; | ||
| 678 : | } | ||
| 679 : | Context($context); | ||
| 680 : | if($ans_type eq 'List') { | ||
| 681 : | $ans_eval = List($correct_ans)->cmp(%options); | ||
| 682 : | } elsif($ans_type eq 'Union') { | ||
| 683 : | $ans_eval = Union($correct_ans)->cmp(%options); | ||
| 684 : | warn "Union with options ".join(',', %options); | ||
| 685 : | } elsif($ans_type eq 'Interval') { | ||
| 686 : | $ans_eval = Interval($correct_ans)->cmp(%options); | ||
| 687 : | } else { | ||
| 688 : | warn "Bug -- should not be here"; | ||
| 689 : | } | ||
| 690 : | |||
| 691 : | Context($oldContext); | ||
| 692 : | return($ans_eval); | ||
| 693 : | |||
| 694 : | |||
| 695 : | # ToDo: tolerances | ||
| 696 : | # modes? | ||
| 697 : | # strings | ||
| 698 : | # infinities | ||
| 699 : | #@infinitywords = ("i", "inf", "infty", "infinity"); | ||
| 700 : | #$infinityre = join '|', @infinitywords; | ||
| 701 : | #$infinityre = "^([-+m]?)($infinityre)\$"; | ||
| 702 : | |||
| 703 : | |||
| 704 : | } | ||
| 705 : | |||
| 706 : | gage | 1064 | sub interval_cmp { |
| 707 : | Interval_evaluator::interval_cmp(@_); | ||
| 708 : | } | ||
| 709 : | |||
| 710 : | =head3 number_list_cmp () | ||
| 711 : | |||
| 712 : | Checks an answer which is a comma-separated list of numbers. The actual | ||
| 713 : | numbers are fed to num_cmp, so all of the flexibilty of num_cmp carries | ||
| 714 : | over (values can be expressions to be evaluated). For example, | ||
| 715 : | |||
| 716 : | number_list_cmp("1, -2") | ||
| 717 : | |||
| 718 : | will accept "1, -2", "-2, 1", or "-1-1,sqrt(1)". | ||
| 719 : | |||
| 720 : | number_list_cmp("1^2 + 1, 2^2 + 1, 3^2 + 1", ordered=>'strict') | ||
| 721 : | |||
| 722 : | will accept "2, 5, 10", but not "5, 2, 10". | ||
| 723 : | |||
| 724 : | If you want to allow complex number entries, complex=>'ok' will cause it | ||
| 725 : | to use cplx_cmp instead: | ||
| 726 : | |||
| 727 : | number_list_cmp("2, -2, 2i, -2i", complex=>'ok') | ||
| 728 : | |||
| 729 : | In cases where you set complex=>'ok', be sure the problem file loads | ||
| 730 : | PGcomplexmacros.pl. | ||
| 731 : | |||
| 732 : | Optional arguements for num_cmp (resp. cplx_cmp) can be used as well, | ||
| 733 : | such as | ||
| 734 : | |||
| 735 : | number_list_cmp("cos(3), sqrt(111)", relTol => 3) | ||
| 736 : | |||
| 737 : | The strings=>['hello'] argument is treated specially. It can be used to | ||
| 738 : | replace the entire answer. So | ||
| 739 : | |||
| 740 : | number_list_cmp("cos(3), sqrt(111)", strings=>['none']) | ||
| 741 : | |||
| 742 : | will mark "none" wrong, but not generate an error. On the other hand, | ||
| 743 : | |||
| 744 : | number_list_cmp("none", strings=>['none']) | ||
| 745 : | |||
| 746 : | jj | 3455 | will mark "none" as correct. |
| 747 : | gage | 1064 | |
| 748 : | =cut | ||
| 749 : | |||
| 750 : | sub number_list_cmp { | ||
| 751 : | jj | 3455 | my $list = shift; |
| 752 : | jj | 3462 | |
| 753 : | jj | 3455 | my %num_params = @_; |
| 754 : | jj | 3462 | |
| 755 : | my $mode = $num_params{mode} || 'std'; | ||
| 756 : | my %options = (debug => $num_params{debug}); | ||
| 757 : | |||
| 758 : | # | ||
| 759 : | # Get an apppropriate context based on the mode | ||
| 760 : | # | ||
| 761 : | jj | 3455 | my $oldContext = Context(); |
| 762 : | jj | 3462 | my $context; |
| 763 : | for ($mode) { | ||
| 764 : | /^strict$/i and do { | ||
| 765 : | $context = $Parser::Context::Default::context{LimitedNumeric}->copy; | ||
| 766 : | $context->operators->set(',' => {class=> 'Parser::BOP::comma'}); | ||
| 767 : | last; | ||
| 768 : | }; | ||
| 769 : | /^arith$/i and do { | ||
| 770 : | $context = $Parser::Context::Default::context{LegacyNumeric}->copy; | ||
| 771 : | $context->functions->disable('All'); | ||
| 772 : | last; | ||
| 773 : | }; | ||
| 774 : | /^frac$/i and do { | ||
| 775 : | $context = $Parser::Context::Default::context{'LimitedNumeric-Fraction'}->copy; | ||
| 776 : | $context->operators->set(',' => {class=> 'Parser::BOP::comma'}); | ||
| 777 : | last; | ||
| 778 : | }; | ||
| 779 : | if(defined($num_params{'complex'}) && | ||
| 780 : | ($num_params{'complex'} =~ /(yes|ok)/i)) { | ||
| 781 : | $context = $Parser::Context::Default::context{Complex}->copy; | ||
| 782 : | last; | ||
| 783 : | } | ||
| 784 : | |||
| 785 : | # default | ||
| 786 : | $context = $Parser::Context::Default::context{LegacyNumeric}->copy; | ||
| 787 : | jj | 3455 | } |
| 788 : | jj | 3462 | $context->{format}{number} = $num_params{'format'} || $main::numFormatDefault; |
| 789 : | $context->strings->clear; | ||
| 790 : | jj | 3455 | if (defined($num_params{strings}) && $num_params{strings}) { |
| 791 : | jj | 3462 | foreach my $string (@{$num_params{strings}}) { |
| 792 : | my %tex = ($string =~ m/(-?)inf(inity)?/i)? (TeX => "$1\\infty"): (); | ||
| 793 : | $context->strings->add(uc($string) => {%tex}); | ||
| 794 : | } | ||
| 795 : | } | ||
| 796 : | |||
| 797 : | jj | 3455 | $num_params{tolType} = $num_params{tolType} || 'relative'; |
| 798 : | jj | 3462 | $num_params{tolerance} = $num_params{tolerance} || $num_params{tol} || |
| 799 : | $num_params{reltol} || $num_params{relTol} || $num_params{abstol} || 1; | ||
| 800 : | $num_params{zeroLevel} = $num_params{zeroLevel} || $num_params{zeroLevelTol} || | ||
| 801 : | $main::numZeroLevelTolDefault; | ||
| 802 : | jj | 3455 | if ($num_params{tolType} eq 'absolute' or defined($num_params{tol}) |
| 803 : | or defined($num_params{abstol})) { | ||
| 804 : | jj | 3462 | $context->flags->set( |
| 805 : | tolerance => $num_params{tolerance}, | ||
| 806 : | tolType => 'absolute', | ||
| 807 : | ); | ||
| 808 : | } else { | ||
| 809 : | $context->flags->set( | ||
| 810 : | tolerance => .01*$num_params{tolerance}, | ||
| 811 : | tolType => 'relative', | ||
| 812 : | ); | ||
| 813 : | } | ||
| 814 : | $context->flags->set( | ||
| 815 : | zeroLevel => $num_params{zeroLevel}, | ||
| 816 : | zeroLevelTol => $num_params{zeroLevelTol}, | ||
| 817 : | ); | ||
| 818 : | $options{ordered} = 1 if(defined($num_params{ordered}) and $opts{ordered}); | ||
| 819 : | |||
| 820 : | jj | 3455 | Context($context); |
| 821 : | jj | 3462 | my $ans_eval = List($list)->cmp(%options); |
| 822 : | jj | 3455 | Context($oldContext); |
| 823 : | return($ans_eval); | ||
| 824 : | gage | 1064 | } |
| 825 : | |||
| 826 : | jj | 3455 | |
| 827 : | gage | 1064 | =head3 equation_cmp () |
| 828 : | |||
| 829 : | Compares an equation. This really piggy-backs off of fun_cmp. It looks | ||
| 830 : | at LHS-RHS of the equations to see if they agree up to constant multiple. | ||
| 831 : | It also guards against an answer of 0=0 (which technically gives a constant | ||
| 832 : | multiple of any equation). It is best suited to situations such as checking | ||
| 833 : | the equation of a line which might be vertical and you don't want to give | ||
| 834 : | that away, or checking equations of ellipses where the students answer should | ||
| 835 : | be quadratic. | ||
| 836 : | |||
| 837 : | Typical invocation would be: | ||
| 838 : | |||
| 839 : | equation_com("x^2+(y-1)^2 = 11", vars=>['x','y']) | ||
| 840 : | |||
| 841 : | =cut | ||
| 842 : | |||
| 843 : | sub equation_cmp { | ||
| 844 : | Equation_eval::equation_cmp(@_); | ||
| 845 : | } | ||
| 846 : |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |