Parent Directory
| 
Revision Log
Revision 2648 - (view) (download) (as text)
| 1 : | dpvc | 2593 | ############################################################# |
| 2 : | # | ||
| 3 : | # Implements the ->cmp method for Value objects. This produces | ||
| 4 : | # an answer checker appropriate for the type of object. | ||
| 5 : | # Additional options can be passed to the checker to | ||
| 6 : | # modify its action. | ||
| 7 : | # | ||
| 8 : | # The individual Value packages are modified below to add the | ||
| 9 : | # needed methods. | ||
| 10 : | # | ||
| 11 : | |||
| 12 : | ############################################################# | ||
| 13 : | |||
| 14 : | package Value; | ||
| 15 : | |||
| 16 : | # | ||
| 17 : | # Create an answer checker for the given type of object | ||
| 18 : | # | ||
| 19 : | |||
| 20 : | dpvc | 2609 | sub cmp_defaults {( |
| 21 : | dpvc | 2593 | showTypeWarnings => 1, |
| 22 : | dpvc | 2627 | showEqualErrors => 1, |
| 23 : | ignoreStrings => 1, | ||
| 24 : | dpvc | 2621 | )} |
| 25 : | dpvc | 2593 | |
| 26 : | sub cmp { | ||
| 27 : | my $self = shift; | ||
| 28 : | my $ans = new AnswerEvaluator; | ||
| 29 : | $ans->ans_hash( | ||
| 30 : | type => "Value (".$self->class.")", | ||
| 31 : | correct_ans => $self->string, | ||
| 32 : | correct_value => $self, | ||
| 33 : | dpvc | 2609 | $self->cmp_defaults, |
| 34 : | dpvc | 2593 | @_ |
| 35 : | ); | ||
| 36 : | dpvc | 2648 | $ans->install_evaluator(sub {$ans = shift; $ans->{correct_value}->cmp_parse($ans)}); |
| 37 : | $self->{context} = $$Value::context unless defined($self->{context}); | ||
| 38 : | dpvc | 2593 | return $ans; |
| 39 : | } | ||
| 40 : | |||
| 41 : | # | ||
| 42 : | # Parse the student answer and compute its value, | ||
| 43 : | # produce the preview strings, and then compare the | ||
| 44 : | # student and professor's answers for equality. | ||
| 45 : | # | ||
| 46 : | dpvc | 2648 | sub cmp_parse { |
| 47 : | dpvc | 2593 | my $self = shift; my $ans = shift; |
| 48 : | dpvc | 2599 | # |
| 49 : | dpvc | 2648 | # Do some setup |
| 50 : | dpvc | 2599 | # |
| 51 : | dpvc | 2648 | my $context = $$Value::context; # save it for later |
| 52 : | Parser::Context->current(undef,$self->{context}); # change to object's context | ||
| 53 : | $context->flags->set(StringifyAsTeX => 0); # reset this, just in case. | ||
| 54 : | $ans->{isPreview} = $self->getPG('$inputs_ref->{previewAnswers}'); | ||
| 55 : | $ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class}; | ||
| 56 : | |||
| 57 : | dpvc | 2599 | # |
| 58 : | # Parse and evaluate the student answer | ||
| 59 : | # | ||
| 60 : | dpvc | 2593 | $ans->score(0); # assume failure |
| 61 : | dpvc | 2621 | $ans->{student_value} = $ans->{student_formula} = Parser::Formula($ans->{student_ans}); |
| 62 : | $ans->{student_value} = Parser::Evaluate($ans->{student_formula}) | ||
| 63 : | dpvc | 2624 | if defined($ans->{student_formula}) && $ans->{student_formula}->isConstant; |
| 64 : | dpvc | 2648 | |
| 65 : | dpvc | 2599 | # |
| 66 : | # If it parsed OK, save the output forms and check if it is correct | ||
| 67 : | # otherwise report an error | ||
| 68 : | # | ||
| 69 : | dpvc | 2593 | if (defined $ans->{student_value}) { |
| 70 : | $ans->{student_value} = Value::Formula->new($ans->{student_value}) | ||
| 71 : | unless Value::isValue($ans->{student_value}); | ||
| 72 : | $ans->{preview_latex_string} = $ans->{student_formula}->TeX; | ||
| 73 : | dpvc | 2648 | $ans->{preview_text_string} = protectHTML($ans->{student_formula}->string); |
| 74 : | dpvc | 2634 | $ans->{student_ans} = $ans->{preview_text_string}; |
| 75 : | dpvc | 2648 | $self->cmp_equal($ans); |
| 76 : | $self->cmp_postprocess($ans) if !$ans->{error_message}; | ||
| 77 : | dpvc | 2593 | } else { |
| 78 : | dpvc | 2648 | $self->cmp_error($ans); |
| 79 : | dpvc | 2593 | } |
| 80 : | dpvc | 2648 | Parser::Context->current(undef,$context); # put back the old context |
| 81 : | dpvc | 2593 | return $ans; |
| 82 : | } | ||
| 83 : | |||
| 84 : | # | ||
| 85 : | # Check if the parsed student answer equals the professor's answer | ||
| 86 : | # | ||
| 87 : | sub cmp_equal { | ||
| 88 : | my $self = shift; my $ans = shift; | ||
| 89 : | dpvc | 2627 | my $correct = $ans->{correct_value}; |
| 90 : | my $student = $ans->{student_value}; | ||
| 91 : | if ($correct->typeMatch($student,$ans)) { | ||
| 92 : | my $equal = eval {$correct == $student}; | ||
| 93 : | dpvc | 2594 | if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return} |
| 94 : | dpvc | 2648 | $self->cmp_error($ans); |
| 95 : | dpvc | 2593 | } else { |
| 96 : | dpvc | 2627 | return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String'); |
| 97 : | dpvc | 2593 | $ans->{ans_message} = $ans->{error_message} = |
| 98 : | dpvc | 2609 | "Your answer isn't ".lc($ans->{cmp_class}). |
| 99 : | dpvc | 2627 | " (it looks like ".lc($student->showClass).")" |
| 100 : | dpvc | 2593 | if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message}; |
| 101 : | } | ||
| 102 : | } | ||
| 103 : | |||
| 104 : | # | ||
| 105 : | # Check if types are compatible for equality check | ||
| 106 : | # | ||
| 107 : | sub typeMatch { | ||
| 108 : | dpvc | 2600 | my $self = shift; my $other = shift; |
| 109 : | return 1 unless ref($other); | ||
| 110 : | dpvc | 2621 | $self->type eq $other->type && $other->class ne 'Formula'; |
| 111 : | dpvc | 2593 | } |
| 112 : | |||
| 113 : | # | ||
| 114 : | dpvc | 2605 | # Class name for cmp error messages |
| 115 : | # | ||
| 116 : | dpvc | 2609 | sub cmp_class { |
| 117 : | my $self = shift; my $ans = shift; | ||
| 118 : | dpvc | 2624 | my $class = $self->showClass; $class =~ s/Real //; |
| 119 : | return $class if $class =~ m/Formula/; | ||
| 120 : | dpvc | 2609 | return "an Interval or Union" if $class =~ m/Interval/i; |
| 121 : | return $class; | ||
| 122 : | } | ||
| 123 : | dpvc | 2605 | |
| 124 : | # | ||
| 125 : | dpvc | 2593 | # Student answer evaluation failed. |
| 126 : | # Report the error, with formatting, if possible. | ||
| 127 : | # | ||
| 128 : | sub cmp_error { | ||
| 129 : | my $self = shift; my $ans = shift; | ||
| 130 : | my $context = $$Value::context; | ||
| 131 : | my $message = $context->{error}{message}; | ||
| 132 : | if ($context->{error}{pos}) { | ||
| 133 : | my $string = $context->{error}{string}; | ||
| 134 : | my ($s,$e) = @{$context->{error}{pos}}; | ||
| 135 : | $message =~ s/; see.*//; # remove the position from the message | ||
| 136 : | $ans->{student_ans} = | ||
| 137 : | protectHTML(substr($string,0,$s)) . | ||
| 138 : | '<SPAN CLASS="parsehilight">' . | ||
| 139 : | protectHTML(substr($string,$s,$e-$s)) . | ||
| 140 : | '</SPAN>' . | ||
| 141 : | protectHTML(substr($string,$e)); | ||
| 142 : | } | ||
| 143 : | dpvc | 2601 | $self->cmp_Error($ans,$message); |
| 144 : | } | ||
| 145 : | |||
| 146 : | # | ||
| 147 : | # Set the error message | ||
| 148 : | # | ||
| 149 : | sub cmp_Error { | ||
| 150 : | my $self = shift; my $ans = shift; | ||
| 151 : | return unless scalar(@_) > 0; | ||
| 152 : | dpvc | 2599 | $ans->score(0); |
| 153 : | dpvc | 2601 | $ans->{ans_message} = $ans->{error_message} = join("\n",@_); |
| 154 : | dpvc | 2593 | } |
| 155 : | |||
| 156 : | # | ||
| 157 : | dpvc | 2601 | # filled in by sub-classes |
| 158 : | # | ||
| 159 : | sub cmp_postprocess {} | ||
| 160 : | |||
| 161 : | # | ||
| 162 : | dpvc | 2593 | # Quote HTML characters |
| 163 : | # | ||
| 164 : | sub protectHTML { | ||
| 165 : | my $string = shift; | ||
| 166 : | $string =~ s/&/\&/g; | ||
| 167 : | $string =~ s/</\</g; | ||
| 168 : | $string =~ s/>/\>/g; | ||
| 169 : | $string; | ||
| 170 : | } | ||
| 171 : | |||
| 172 : | dpvc | 2599 | # |
| 173 : | dpvc | 2601 | # names for numbers |
| 174 : | # | ||
| 175 : | sub NameForNumber { | ||
| 176 : | my $self = shift; my $n = shift; | ||
| 177 : | my $name = ('zeroth','first','second','third','fourth','fifth', | ||
| 178 : | 'sixth','seventh','eighth','ninth','tenth')[$n]; | ||
| 179 : | $name = "$n-th" if ($n > 10); | ||
| 180 : | return $name; | ||
| 181 : | } | ||
| 182 : | |||
| 183 : | # | ||
| 184 : | dpvc | 2599 | # Get a value from the safe compartment |
| 185 : | # | ||
| 186 : | sub getPG { | ||
| 187 : | my $self = shift; | ||
| 188 : | (WeBWorK::PG::Translator::PG_restricted_eval(shift))[0]; | ||
| 189 : | } | ||
| 190 : | |||
| 191 : | dpvc | 2593 | ############################################################# |
| 192 : | ############################################################# | ||
| 193 : | |||
| 194 : | dpvc | 2596 | package Value::Real; |
| 195 : | |||
| 196 : | dpvc | 2609 | sub cmp_defaults {( |
| 197 : | shift->SUPER::cmp_defaults, | ||
| 198 : | dpvc | 2605 | ignoreInfinity => 1, |
| 199 : | dpvc | 2621 | )} |
| 200 : | dpvc | 2597 | |
| 201 : | dpvc | 2596 | sub typeMatch { |
| 202 : | my $self = shift; my $other = shift; my $ans = shift; | ||
| 203 : | dpvc | 2600 | return 1 unless ref($other); |
| 204 : | dpvc | 2648 | return 0 if Value::isFormula($other); |
| 205 : | dpvc | 2605 | return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity}; |
| 206 : | dpvc | 2596 | $self->type eq $other->type; |
| 207 : | } | ||
| 208 : | |||
| 209 : | ############################################################# | ||
| 210 : | |||
| 211 : | dpvc | 2605 | package Value::Infinity; |
| 212 : | |||
| 213 : | dpvc | 2609 | sub cmp_class {'a Number'}; |
| 214 : | dpvc | 2605 | |
| 215 : | sub typeMatch { | ||
| 216 : | my $self = shift; my $other = shift; my $ans = shift; | ||
| 217 : | return 1 unless ref($other); | ||
| 218 : | dpvc | 2648 | return 0 if Value::isFormula($other); |
| 219 : | dpvc | 2605 | return 1 if $other->type eq 'Number'; |
| 220 : | $self->type eq $other->type; | ||
| 221 : | } | ||
| 222 : | |||
| 223 : | ############################################################# | ||
| 224 : | |||
| 225 : | dpvc | 2609 | package Value::String; |
| 226 : | |||
| 227 : | sub cmp_defaults {( | ||
| 228 : | Value::Real->cmp_defaults, | ||
| 229 : | dpvc | 2621 | typeMatch => 'Value::Real', |
| 230 : | )} | ||
| 231 : | dpvc | 2609 | |
| 232 : | sub cmp_class { | ||
| 233 : | dpvc | 2621 | my $self = shift; my $ans = shift; my $typeMatch = $ans->{typeMatch}; |
| 234 : | dpvc | 2612 | return 'a Word' if !Value::isValue($typeMatch) || $typeMatch->class eq 'String'; |
| 235 : | dpvc | 2609 | return $typeMatch->cmp_class; |
| 236 : | }; | ||
| 237 : | |||
| 238 : | sub typeMatch { | ||
| 239 : | my $self = shift; my $other = shift; my $ans = shift; | ||
| 240 : | dpvc | 2648 | return 0 if ref($other) && Value::isFormula($other); |
| 241 : | dpvc | 2612 | my $typeMatch = $ans->{typeMatch}; |
| 242 : | dpvc | 2621 | return 1 if !Value::isValue($typeMatch) || $typeMatch->class eq 'String' || |
| 243 : | $self->type eq $other->type; | ||
| 244 : | dpvc | 2612 | return $typeMatch->typeMatch($other,$ans); |
| 245 : | dpvc | 2609 | } |
| 246 : | |||
| 247 : | ############################################################# | ||
| 248 : | |||
| 249 : | dpvc | 2593 | package Value::Point; |
| 250 : | |||
| 251 : | dpvc | 2609 | sub cmp_defaults {( |
| 252 : | shift->SUPER::cmp_defaults, | ||
| 253 : | dpvc | 2601 | showDimensionHints => 1, |
| 254 : | showCoordinateHints => 1, | ||
| 255 : | dpvc | 2621 | )} |
| 256 : | dpvc | 2593 | |
| 257 : | sub typeMatch { | ||
| 258 : | my $self = shift; my $other = shift; my $ans = shift; | ||
| 259 : | dpvc | 2621 | return ref($other) && $other->type eq 'Point' && $other->class ne 'Formula'; |
| 260 : | dpvc | 2601 | } |
| 261 : | |||
| 262 : | # | ||
| 263 : | # Check for dimension mismatch and incorrect coordinates | ||
| 264 : | # | ||
| 265 : | sub cmp_postprocess { | ||
| 266 : | my $self = shift; my $ans = shift; | ||
| 267 : | return unless $ans->{score} == 0 && !$ans->{isPreview}; | ||
| 268 : | if ($ans->{showDimensionHints} && | ||
| 269 : | $self->length != $ans->{student_value}->length) { | ||
| 270 : | $self->cmp_Error($ans,"The dimension is incorrect"); return; | ||
| 271 : | dpvc | 2593 | } |
| 272 : | dpvc | 2601 | if ($ans->{showCoordinateHints}) { |
| 273 : | my @errors; | ||
| 274 : | foreach my $i (1..$self->length) { | ||
| 275 : | push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect") | ||
| 276 : | if ($self->{data}[$i-1] != $ans->{student_value}{data}[$i-1]); | ||
| 277 : | } | ||
| 278 : | $self->cmp_Error($ans,@errors); return; | ||
| 279 : | } | ||
| 280 : | dpvc | 2593 | } |
| 281 : | |||
| 282 : | ############################################################# | ||
| 283 : | |||
| 284 : | package Value::Vector; | ||
| 285 : | |||
| 286 : | dpvc | 2609 | sub cmp_defaults {( |
| 287 : | dpvc | 2611 | shift->SUPER::cmp_defaults, |
| 288 : | dpvc | 2601 | showDimensionHints => 1, |
| 289 : | showCoordinateHints => 1, | ||
| 290 : | dpvc | 2594 | promotePoints => 0, |
| 291 : | dpvc | 2597 | parallel => 0, |
| 292 : | sameDirection => 0, | ||
| 293 : | dpvc | 2621 | )} |
| 294 : | dpvc | 2593 | |
| 295 : | sub typeMatch { | ||
| 296 : | my $self = shift; my $other = shift; my $ans = shift; | ||
| 297 : | dpvc | 2621 | return 0 unless ref($other) && $other->class ne 'Formula'; |
| 298 : | dpvc | 2627 | return $other->type eq 'Vector' || |
| 299 : | ($ans->{promotePoints} && $other->type eq 'Point'); | ||
| 300 : | dpvc | 2593 | } |
| 301 : | |||
| 302 : | dpvc | 2597 | # |
| 303 : | dpvc | 2601 | # check for dimension mismatch |
| 304 : | # for parallel vectors, and | ||
| 305 : | # for incorrect coordinates | ||
| 306 : | dpvc | 2597 | # |
| 307 : | sub cmp_postprocess { | ||
| 308 : | my $self = shift; my $ans = shift; | ||
| 309 : | dpvc | 2601 | return unless $ans->{score} == 0; |
| 310 : | if (!$ans->{isPreview} && $ans->{showDimensionHints} && | ||
| 311 : | $self->length != $ans->{student_value}->length) { | ||
| 312 : | $self->cmp_Error($ans,"The dimension is incorrect"); return; | ||
| 313 : | } | ||
| 314 : | if ($ans->{parallel} && | ||
| 315 : | $self->isParallel($ans->{student_value},$ans->{sameDirection})) { | ||
| 316 : | $ans->score(1); return; | ||
| 317 : | } | ||
| 318 : | if (!$ans->{isPreview} && $ans->{showCoordinateHints}) { | ||
| 319 : | my @errors; | ||
| 320 : | foreach my $i (1..$self->length) { | ||
| 321 : | push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect") | ||
| 322 : | if ($self->{data}[$i-1] != $ans->{student_value}{data}[$i-1]); | ||
| 323 : | } | ||
| 324 : | $self->cmp_Error($ans,@errors); return; | ||
| 325 : | } | ||
| 326 : | dpvc | 2597 | } |
| 327 : | |||
| 328 : | |||
| 329 : | |||
| 330 : | dpvc | 2593 | ############################################################# |
| 331 : | |||
| 332 : | package Value::Matrix; | ||
| 333 : | |||
| 334 : | dpvc | 2609 | sub cmp_defaults {( |
| 335 : | shiftf->SUPER::cmp_defaults, | ||
| 336 : | dpvc | 2601 | showDimensionHints => 1, |
| 337 : | showEqualErrors => 0, | ||
| 338 : | dpvc | 2621 | )} |
| 339 : | dpvc | 2593 | |
| 340 : | sub typeMatch { | ||
| 341 : | my $self = shift; my $other = shift; my $ans = shift; | ||
| 342 : | dpvc | 2621 | return 0 unless ref($other) && $other->class ne 'Formula'; |
| 343 : | dpvc | 2627 | return $other->type eq 'Matrix' || |
| 344 : | ($other->type =~ m/^(Point|list)$/ && | ||
| 345 : | $other->{open}.$other->{close} eq $self->{open}.$self->{close}); | ||
| 346 : | dpvc | 2601 | } |
| 347 : | |||
| 348 : | sub cmp_postprocess { | ||
| 349 : | my $self = shift; my $ans = shift; | ||
| 350 : | return unless $ans->{score} == 0 && | ||
| 351 : | !$ans->{isPreview} && $ans->{showDimensionHints}; | ||
| 352 : | my @d1 = $self->dimensions; my @d2 = $ans->{student_value}->dimensions; | ||
| 353 : | dpvc | 2593 | if (scalar(@d1) != scalar(@d2)) { |
| 354 : | dpvc | 2601 | $self->cmp_Error($ans,"Matrix dimension is not correct"); |
| 355 : | return; | ||
| 356 : | dpvc | 2593 | } else { |
| 357 : | foreach my $i (0..scalar(@d1)-1) { | ||
| 358 : | if ($d1[$i] != $d2[$i]) { | ||
| 359 : | dpvc | 2601 | $self->cmp_Error($ans,"Matrix dimension is not correct"); |
| 360 : | return; | ||
| 361 : | dpvc | 2593 | } |
| 362 : | } | ||
| 363 : | } | ||
| 364 : | } | ||
| 365 : | |||
| 366 : | ############################################################# | ||
| 367 : | |||
| 368 : | package Value::Interval; | ||
| 369 : | |||
| 370 : | dpvc | 2609 | sub cmp_defaults {( |
| 371 : | shift->SUPER::cmp_defaults, | ||
| 372 : | dpvc | 2601 | showEndpointHints => 1, |
| 373 : | showEndTypeHints => 1, | ||
| 374 : | dpvc | 2621 | )} |
| 375 : | dpvc | 2594 | |
| 376 : | dpvc | 2593 | sub typeMatch { |
| 377 : | my $self = shift; my $other = shift; | ||
| 378 : | dpvc | 2621 | return 0 unless ref($other) && $other->class ne 'Formula'; |
| 379 : | dpvc | 2594 | return $other->length == 2 && |
| 380 : | ($other->{open} eq '(' || $other->{open} eq '[') && | ||
| 381 : | ($other->{close} eq ')' || $other->{close} eq ']') | ||
| 382 : | if $other->type =~ m/^(Point|List)$/; | ||
| 383 : | $other->type =~ m/^(Interval|Union)$/; | ||
| 384 : | dpvc | 2593 | } |
| 385 : | |||
| 386 : | dpvc | 2601 | # |
| 387 : | # Check for wrong enpoints and wrong type of endpoints | ||
| 388 : | # | ||
| 389 : | sub cmp_postprocess { | ||
| 390 : | my $self = shift; my $ans = shift; | ||
| 391 : | return unless $ans->{score} == 0 && !$ans->{isPreview}; | ||
| 392 : | my $other = $ans->{student_value}; | ||
| 393 : | dpvc | 2604 | return unless $other->class eq 'Interval'; |
| 394 : | dpvc | 2601 | my @errors; |
| 395 : | if ($ans->{showEndpointHints}) { | ||
| 396 : | push(@errors,"Your left endpoint is incorrect") | ||
| 397 : | if ($self->{data}[0] != $other->{data}[0]); | ||
| 398 : | push(@errors,"Your right endpoint is incorrect") | ||
| 399 : | if ($self->{data}[1] != $other->{data}[1]); | ||
| 400 : | } | ||
| 401 : | if (scalar(@errors) == 0 && $ans->{showEndTypeHints}) { | ||
| 402 : | push(@errors,"The type of interval is incorrect") | ||
| 403 : | if ($self->{open}.$self->{close} ne $other->{open}.$other->{close}); | ||
| 404 : | } | ||
| 405 : | $self->cmp_Error($ans,@errors); | ||
| 406 : | } | ||
| 407 : | |||
| 408 : | dpvc | 2593 | ############################################################# |
| 409 : | |||
| 410 : | package Value::Union; | ||
| 411 : | |||
| 412 : | sub typeMatch { | ||
| 413 : | my $self = shift; my $other = shift; | ||
| 414 : | dpvc | 2621 | return 0 unless ref($other) && $other->class ne 'Formula'; |
| 415 : | dpvc | 2597 | return $other->length == 2 && |
| 416 : | ($other->{open} eq '(' || $other->{open} eq '[') && | ||
| 417 : | ($other->{close} eq ')' || $other->{close} eq ']') | ||
| 418 : | if $other->type =~ m/^(Point|List)$/; | ||
| 419 : | dpvc | 2593 | $other->type =~ m/^(Interval|Union)/; |
| 420 : | } | ||
| 421 : | |||
| 422 : | dpvc | 2617 | # |
| 423 : | # Use the List checker for unions, in order to get | ||
| 424 : | # partial credit. Set the various types for error | ||
| 425 : | # messages. | ||
| 426 : | # | ||
| 427 : | sub cmp_defaults {( | ||
| 428 : | dpvc | 2621 | Value::List::cmp_defaults(@_), |
| 429 : | typeMatch => 'Value::Interval', | ||
| 430 : | dpvc | 2634 | list_type => 'an interval or union', |
| 431 : | dpvc | 2617 | entry_type => 'an interval', |
| 432 : | )} | ||
| 433 : | |||
| 434 : | sub cmp_equal {Value::List::cmp_equal(@_)} | ||
| 435 : | |||
| 436 : | dpvc | 2593 | ############################################################# |
| 437 : | |||
| 438 : | dpvc | 2599 | package Value::List; |
| 439 : | |||
| 440 : | dpvc | 2621 | sub cmp_defaults { |
| 441 : | my $self = shift; | ||
| 442 : | return ( | ||
| 443 : | Value::Real->cmp_defaults, | ||
| 444 : | showHints => undef, | ||
| 445 : | showLengthHints => undef, | ||
| 446 : | # partialCredit => undef, | ||
| 447 : | partialCredit => 0, # only allow this once WW can deal with partial credit | ||
| 448 : | ordered => 0, | ||
| 449 : | entry_type => undef, | ||
| 450 : | dpvc | 2629 | list_type => undef, |
| 451 : | dpvc | 2621 | typeMatch => Value::makeValue($self->{data}[0]), |
| 452 : | allowParens => 0, | ||
| 453 : | showParens => 0, | ||
| 454 : | ); | ||
| 455 : | } | ||
| 456 : | dpvc | 2599 | |
| 457 : | dpvc | 2621 | # |
| 458 : | # Match anything but formulas | ||
| 459 : | # | ||
| 460 : | sub typeMatch {return !ref($other) || $other->class ne 'Formula'} | ||
| 461 : | dpvc | 2599 | |
| 462 : | dpvc | 2604 | # |
| 463 : | # Handle removal of outermost parens in correct answer. | ||
| 464 : | # | ||
| 465 : | sub cmp { | ||
| 466 : | my $self = shift; | ||
| 467 : | my $cmp = $self->SUPER::cmp(@_); | ||
| 468 : | if (!$cmp->{rh_ans}{showParens}) { | ||
| 469 : | $self->{open} = $self->{close} = ''; | ||
| 470 : | $cmp->ans_hash(correct_ans => $self->stringify); | ||
| 471 : | } | ||
| 472 : | return $cmp; | ||
| 473 : | } | ||
| 474 : | |||
| 475 : | dpvc | 2599 | sub cmp_equal { |
| 476 : | my $self = shift; my $ans = shift; | ||
| 477 : | dpvc | 2621 | $ans->{showPartialCorrectAnswers} = $self->getPG('$showPartialCorrectAnswers'); |
| 478 : | |||
| 479 : | # | ||
| 480 : | # get the paramaters | ||
| 481 : | # | ||
| 482 : | dpvc | 2599 | my $showTypeWarnings = $ans->{showTypeWarnings}; |
| 483 : | dpvc | 2621 | my $showHints = getOption($ans,'showHints'); |
| 484 : | my $showLengthHints = getOption($ans,'showLengthHints'); | ||
| 485 : | my $partialCredit = getOption($ans,'partialCredit'); | ||
| 486 : | dpvc | 2599 | my $ordered = $ans->{ordered}; my $allowParens = $ans->{allowParens}; |
| 487 : | dpvc | 2621 | my $typeMatch = $ans->{typeMatch}; |
| 488 : | my $value = $ans->{entry_type}; | ||
| 489 : | dpvc | 2629 | my $ltype = $ans->{list_type} || lc($self->type); |
| 490 : | dpvc | 2621 | |
| 491 : | $value = (Value::isValue($typeMatch)? lc($typeMatch->cmp_class): 'value') | ||
| 492 : | unless defined($value); | ||
| 493 : | dpvc | 2624 | $value =~ s/(real|complex) //; $ans->{cmp_class} = $value; |
| 494 : | $value =~ s/^an? //; $value = 'formula' if $value =~ m/formula/; | ||
| 495 : | dpvc | 2629 | $ltype =~ s/^an? //; |
| 496 : | dpvc | 2599 | $showTypeWarnings = $showHints = $showLengthHints = 0 if $ans->{isPreview}; |
| 497 : | |||
| 498 : | dpvc | 2621 | # |
| 499 : | # Get the lists of correct and student answers | ||
| 500 : | dpvc | 2624 | # (split formulas that return lists or unions) |
| 501 : | dpvc | 2621 | # |
| 502 : | dpvc | 2624 | my @correct = (); |
| 503 : | if ($self->class ne 'Formula') {@correct = $self->value} | ||
| 504 : | else {@correct = Value::List->splitFormula($self,$ans)} | ||
| 505 : | dpvc | 2599 | my $student = $ans->{student_value}; |
| 506 : | dpvc | 2621 | my @student = ($student); |
| 507 : | dpvc | 2648 | if (Value::isFormula($student) && $student->type eq $self->type) { |
| 508 : | dpvc | 2624 | @student = Value::List->splitFormula($student,$ans); |
| 509 : | dpvc | 2629 | } elsif ($student->class ne 'Formula' && $student->class eq $self->type && |
| 510 : | dpvc | 2621 | ($allowParens || (!$student->{open} && !$student->{close}))) { |
| 511 : | @student = @{$student->{data}}; | ||
| 512 : | } | ||
| 513 : | dpvc | 2624 | return if $ans->{split_error}; |
| 514 : | if (scalar(@correct) == 0 && scalar(@student) == 0) {$ans->score(1); return} | ||
| 515 : | dpvc | 2599 | |
| 516 : | dpvc | 2621 | # |
| 517 : | # Initialize the score | ||
| 518 : | # | ||
| 519 : | dpvc | 2624 | my $M = scalar(@correct); |
| 520 : | dpvc | 2599 | my $m = scalar(@student); |
| 521 : | dpvc | 2624 | my $maxscore = ($m > $M)? $m : $M; |
| 522 : | dpvc | 2599 | my $score = 0; my @errors; my $i = 0; |
| 523 : | |||
| 524 : | dpvc | 2621 | # |
| 525 : | # Loop through student answers looking for correct ones | ||
| 526 : | # | ||
| 527 : | dpvc | 2599 | ENTRY: foreach my $entry (@student) { |
| 528 : | $i++; | ||
| 529 : | dpvc | 2605 | $entry = Value::makeValue($entry); |
| 530 : | dpvc | 2600 | $entry = Value::Formula->new($entry) if !Value::isValue($entry); |
| 531 : | dpvc | 2599 | if ($ordered) { |
| 532 : | if (eval {shift(@correct) == $entry}) {$score++; next ENTRY} | ||
| 533 : | } else { | ||
| 534 : | foreach my $k (0..$#correct) { | ||
| 535 : | if (eval {$correct[$k] == $entry}) { | ||
| 536 : | splice(@correct,$k,1); | ||
| 537 : | $score++; next ENTRY; | ||
| 538 : | } | ||
| 539 : | } | ||
| 540 : | } | ||
| 541 : | dpvc | 2621 | # |
| 542 : | # Give messages about incorrect answers | ||
| 543 : | # | ||
| 544 : | dpvc | 2629 | my $nth = ''; my $answer = 'answer'; |
| 545 : | my $class = $ans->{list_type} || $self->cmp_class; | ||
| 546 : | dpvc | 2622 | if (scalar(@student) > 1) { |
| 547 : | $nth = ' '.$self->NameForNumber($i); | ||
| 548 : | $class = $ans->{cmp_class}; | ||
| 549 : | dpvc | 2624 | $answer = 'value'; |
| 550 : | dpvc | 2622 | } |
| 551 : | if ($showTypeWarnings && !$typeMatch->typeMatch($entry,$ans) && | ||
| 552 : | !($ans->{ignoreStrings} && $entry->class eq 'String')) { | ||
| 553 : | dpvc | 2624 | push(@errors,"Your$nth $answer isn't ".lc($class). |
| 554 : | " (it looks like ".lc($entry->showClass).")"); | ||
| 555 : | dpvc | 2621 | } elsif ($showHints && $m > 1) { |
| 556 : | push(@errors,"Your$nth $value is incorrect"); | ||
| 557 : | dpvc | 2599 | } |
| 558 : | } | ||
| 559 : | |||
| 560 : | dpvc | 2621 | # |
| 561 : | # Give hints about extra or missing answsers | ||
| 562 : | # | ||
| 563 : | dpvc | 2599 | if ($showLengthHints) { |
| 564 : | $value =~ s/ or /s or /; # fix "interval or union" | ||
| 565 : | push(@errors,"There should be more ${value}s in your $ltype") | ||
| 566 : | if ($score == $m && scalar(@correct) > 0); | ||
| 567 : | push(@errors,"There should be fewer ${value}s in your $ltype") | ||
| 568 : | dpvc | 2624 | if ($score < $maxscore && $score == $M); |
| 569 : | dpvc | 2599 | } |
| 570 : | |||
| 571 : | dpvc | 2621 | # |
| 572 : | # Finalize the score | ||
| 573 : | # | ||
| 574 : | dpvc | 2599 | $score = 0 if ($score != $maxscore && !$partialCredit); |
| 575 : | $ans->score($score/$maxscore); | ||
| 576 : | push(@errors,"Score = $ans->{score}") if $ans->{debug}; | ||
| 577 : | $ans->{error_message} = $ans->{ans_message} = join("\n",@errors); | ||
| 578 : | } | ||
| 579 : | |||
| 580 : | # | ||
| 581 : | dpvc | 2624 | # Split a formula that is a list or union into a |
| 582 : | # list of formulas (or Value objects). | ||
| 583 : | # | ||
| 584 : | sub splitFormula { | ||
| 585 : | my $self = shift; my $formula = shift; my $ans = shift; | ||
| 586 : | my @formula; my @entries; | ||
| 587 : | if ($formula->type eq 'List') {@entries = @{$formula->{tree}{coords}}} | ||
| 588 : | else {@entries = $formula->{tree}->makeUnion} | ||
| 589 : | foreach my $entry (@entries) { | ||
| 590 : | my $v = Parser::Formula($entry); | ||
| 591 : | $v = Parser::Evaluate($v) if (defined($v) && $v->isConstant); | ||
| 592 : | push(@formula,$v); | ||
| 593 : | # | ||
| 594 : | # There shouldn't be an error evaluating the formula, | ||
| 595 : | # but you never know... | ||
| 596 : | # | ||
| 597 : | dpvc | 2648 | if (!defined($v)) {$ans->{split_error} = 1; $self->cmp_error; return} |
| 598 : | dpvc | 2624 | } |
| 599 : | return @formula; | ||
| 600 : | } | ||
| 601 : | |||
| 602 : | # | ||
| 603 : | dpvc | 2621 | # Return the value if it is defined, otherwise use a default |
| 604 : | dpvc | 2599 | # |
| 605 : | sub getOption { | ||
| 606 : | dpvc | 2621 | my $ans = shift; my $name = shift; |
| 607 : | my $value = $ans->{$name}; | ||
| 608 : | dpvc | 2599 | return $value if defined($value); |
| 609 : | dpvc | 2621 | return $ans->{showPartialCorrectAnswers}; |
| 610 : | dpvc | 2599 | } |
| 611 : | |||
| 612 : | ############################################################# | ||
| 613 : | |||
| 614 : | dpvc | 2593 | package Value::Formula; |
| 615 : | |||
| 616 : | dpvc | 2624 | sub cmp_defaults { |
| 617 : | my $self = shift; | ||
| 618 : | dpvc | 2626 | |
| 619 : | dpvc | 2624 | return ( |
| 620 : | Value::Union::cmp_defaults($self,@_), | ||
| 621 : | typeMatch => Value::Formula->new("(1,2]"), | ||
| 622 : | ) if $self->type eq 'Union'; | ||
| 623 : | dpvc | 2622 | |
| 624 : | dpvc | 2624 | return Value::Real::cmp_defaults($self,@_) unless $self->type eq 'List'; |
| 625 : | |||
| 626 : | return ( | ||
| 627 : | Value::List::cmp_defaults($self,@_), | ||
| 628 : | typeMatch => Value::Formula->new(($self->createRandomPoints(1))[1]->[0]{data}[0]), | ||
| 629 : | ); | ||
| 630 : | } | ||
| 631 : | |||
| 632 : | # | ||
| 633 : | # Get the types from the values of the formulas | ||
| 634 : | # and compare those. | ||
| 635 : | # | ||
| 636 : | sub typeMatch { | ||
| 637 : | my $self = shift; my $other = shift; my $ans = shift; | ||
| 638 : | return 1 if $self->type eq $other->type; | ||
| 639 : | my $typeMatch = ($self->createRandomPoints(1))[1]->[0]; | ||
| 640 : | dpvc | 2648 | $other = eval {($other->createRandomPoints(1))[1]->[0]} if Value::isFormula($other); |
| 641 : | dpvc | 2624 | return 1 unless defined($other); # can't really tell, so don't report type mismatch |
| 642 : | $typeMatch->typeMatch($other,$ans); | ||
| 643 : | } | ||
| 644 : | |||
| 645 : | dpvc | 2629 | # |
| 646 : | # Handle removal of outermost parens in a list. | ||
| 647 : | # | ||
| 648 : | sub cmp { | ||
| 649 : | my $self = shift; | ||
| 650 : | my $cmp = $self->SUPER::cmp(@_); | ||
| 651 : | if (!$cmp->{rh_ans}{showParens} && $self->type eq 'List') { | ||
| 652 : | $self->{tree}{open} = $self->{tree}{close} = ''; | ||
| 653 : | $cmp->ans_hash(correct_ans => $self->stringify); | ||
| 654 : | } | ||
| 655 : | return $cmp; | ||
| 656 : | } | ||
| 657 : | |||
| 658 : | dpvc | 2622 | sub cmp_equal { |
| 659 : | dpvc | 2624 | my $self = shift; my $ans = shift; |
| 660 : | # | ||
| 661 : | # Get the problem's seed | ||
| 662 : | # | ||
| 663 : | dpvc | 2622 | $self->{context}->flags->set( |
| 664 : | random_seed => $self->getPG('$PG_original_problemSeed') | ||
| 665 : | ); | ||
| 666 : | dpvc | 2624 | |
| 667 : | # | ||
| 668 : | # Use the list checker if the formula is a list or union | ||
| 669 : | # Otherwise use the normal checker | ||
| 670 : | # | ||
| 671 : | if ($self->type =~ m/^(List|Union)$/) { | ||
| 672 : | Value::List::cmp_equal($self,$ans); | ||
| 673 : | } else { | ||
| 674 : | $self->SUPER::cmp_equal($ans); | ||
| 675 : | } | ||
| 676 : | dpvc | 2622 | } |
| 677 : | |||
| 678 : | dpvc | 2593 | # |
| 679 : | dpvc | 2622 | # Replace the ones in Value::Formula |
| 680 : | dpvc | 2593 | # |
| 681 : | dpvc | 2622 | sub PGseedRandom { |
| 682 : | my $self = shift; | ||
| 683 : | return if $self->{PGrandom}; | ||
| 684 : | $self->{PGrandom} = new PGrandom($self->{context}->flag('random_seed')); | ||
| 685 : | dpvc | 2593 | } |
| 686 : | dpvc | 2632 | sub PGgetRandom {shift->{PGrandom}->random(@_)} |
| 687 : | dpvc | 2593 | |
| 688 : | ############################################################# | ||
| 689 : | |||
| 690 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |