[system] / trunk / pg / lib / Value / AnswerChecker.pm Repository:
ViewVC logotype

Annotation of /trunk/pg/lib/Value/AnswerChecker.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3469 - (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 : dpvc 3269 my $correct = protectHTML($self->{correct_ans});
30 :     $correct = $self->correct_ans unless defined($correct);
31 : dpvc 2593 $ans->ans_hash(
32 :     type => "Value (".$self->class.")",
33 : dpvc 3269 correct_ans => $correct,
34 : dpvc 2593 correct_value => $self,
35 : dpvc 3206 $self->cmp_defaults(@_),
36 : dpvc 2593 @_
37 :     );
38 : dpvc 2648 $ans->install_evaluator(sub {$ans = shift; $ans->{correct_value}->cmp_parse($ans)});
39 : dpvc 3269 $ans->install_pre_filter('erase') if $self->{ans_name}; # don't do blank check if answer_array
40 : dpvc 2648 $self->{context} = $$Value::context unless defined($self->{context});
41 : dpvc 2593 return $ans;
42 :     }
43 :    
44 : dpvc 3269 sub correct_ans {protectHTML(shift->string)}
45 :    
46 : dpvc 2593 #
47 :     # Parse the student answer and compute its value,
48 :     # produce the preview strings, and then compare the
49 :     # student and professor's answers for equality.
50 :     #
51 : dpvc 2648 sub cmp_parse {
52 : dpvc 2593 my $self = shift; my $ans = shift;
53 : dpvc 2599 #
54 : dpvc 2648 # Do some setup
55 : dpvc 2599 #
56 : dpvc 2688 my $current = $$Value::context; # save it for later
57 : dpvc 2692 my $context = $ans->{correct_value}{context} || $current;
58 : dpvc 2688 Parser::Context->current(undef,$context); # change to correct answser's context
59 : dpvc 2791 my $flags = contextSet($context, # save old context flags for the below
60 :     StringifyAsTeX => 0, # reset this, just in case.
61 :     no_parameters => 1, # don't let students enter parameters
62 :     showExtraParens => 1, # make student answer painfully unambiguous
63 :     reduceConstants => 0, # don't combine student constants
64 :     reduceConstantFunctions => 0, # don't reduce constant functions
65 :     );
66 : dpvc 2648 $ans->{isPreview} = $self->getPG('$inputs_ref->{previewAnswers}');
67 :     $ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class};
68 : dpvc 2916 $ans->{error_message} = $ans->{ans_message} = ''; # clear any old messages
69 :     $ans->{preview_latex_string} = $ans->{preview_text_string} = '';
70 : dpvc 2648
71 : dpvc 2599 #
72 :     # Parse and evaluate the student answer
73 :     #
74 : dpvc 2593 $ans->score(0); # assume failure
75 : dpvc 2621 $ans->{student_value} = $ans->{student_formula} = Parser::Formula($ans->{student_ans});
76 :     $ans->{student_value} = Parser::Evaluate($ans->{student_formula})
77 : dpvc 2624 if defined($ans->{student_formula}) && $ans->{student_formula}->isConstant;
78 : dpvc 2648
79 : dpvc 2599 #
80 :     # If it parsed OK, save the output forms and check if it is correct
81 :     # otherwise report an error
82 :     #
83 : dpvc 2593 if (defined $ans->{student_value}) {
84 :     $ans->{student_value} = Value::Formula->new($ans->{student_value})
85 :     unless Value::isValue($ans->{student_value});
86 :     $ans->{preview_latex_string} = $ans->{student_formula}->TeX;
87 : dpvc 2648 $ans->{preview_text_string} = protectHTML($ans->{student_formula}->string);
88 : dpvc 2634 $ans->{student_ans} = $ans->{preview_text_string};
89 : dpvc 3269 if ($self->cmp_collect($ans)) {
90 :     $self->cmp_equal($ans);
91 :     $self->cmp_postprocess($ans) if !$ans->{error_message};
92 :     }
93 : dpvc 2593 } else {
94 : dpvc 2648 $self->cmp_error($ans);
95 : dpvc 3269 $self->cmp_collect($ans);
96 : dpvc 2593 }
97 : dpvc 2791 contextSet($context,%{$flags}); # restore context values
98 : dpvc 2688 Parser::Context->current(undef,$current); # put back the old context
99 : dpvc 2593 return $ans;
100 :     }
101 :    
102 :     #
103 : dpvc 3269 # Check if the object has an answer array and collect the results
104 :     # Build the combined student answer and set the preview values
105 :     #
106 :     sub cmp_collect {
107 :     my $self = shift; my $ans = shift;
108 :     return 1 unless $self->{ans_name};
109 :     $ans->{preview_latex_string} = $ans->{preview_text_string} = "";
110 :     my $OK = $self->ans_collect($ans);
111 :     $ans->{student_ans} = $self->format_matrix($ans->{student_formula},@{$self->{format_options}},tth_delims=>1);
112 :     return 0 unless $OK;
113 :     my $array = $ans->{student_formula};
114 :     if ($self->{ColumnVector}) {
115 :     my @V = (); foreach my $x (@{$array}) {push(@V,$x->[0])}
116 :     $array = [@V];
117 :     } elsif (scalar(@{$array}) == 1) {$array = $array->[0]}
118 :     my $type = $self;
119 :     $type = "Value::".$self->{tree}->type if $self->class eq 'Formula';
120 :     $ans->{student_formula} = eval {$type->new($array)->with(ColumnVector=>$self->{ColumnVector})};
121 :     if (!defined($ans->{student_formula}) || $$Value::context->{error}{flag})
122 :     {Parser::reportEvalError($@); return 0}
123 :     $ans->{student_value} = $ans->{student_formula};
124 :     $ans->{preview_text_string} = $ans->{student_ans};
125 :     $ans->{preview_latex_string} = $ans->{student_formula}->TeX;
126 :     if (Value::isFormula($ans->{student_formula}) && $ans->{student_formula}->isConstant) {
127 :     $ans->{student_value} = Parser::Evaluate($ans->{student_formula});
128 :     return 0 unless $ans->{student_value};
129 :     }
130 :     return 1;
131 :     }
132 :    
133 :     #
134 : dpvc 2593 # Check if the parsed student answer equals the professor's answer
135 :     #
136 :     sub cmp_equal {
137 :     my $self = shift; my $ans = shift;
138 : dpvc 2627 my $correct = $ans->{correct_value};
139 :     my $student = $ans->{student_value};
140 :     if ($correct->typeMatch($student,$ans)) {
141 : dpvc 3206 my $equal = $correct->cmp_compare($student,$ans);
142 : dpvc 2594 if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return}
143 : dpvc 2648 $self->cmp_error($ans);
144 : dpvc 2593 } else {
145 : dpvc 2627 return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
146 : dpvc 2593 $ans->{ans_message} = $ans->{error_message} =
147 : dpvc 3336 "Your answer isn't ".lc($ans->{cmp_class})."\n".
148 : dpvc 3269 "(it looks like ".lc($student->showClass).")"
149 : dpvc 2593 if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message};
150 :     }
151 :     }
152 :    
153 :     #
154 : dpvc 3206 # Perform the comparison, either using the checker supplied
155 :     # by the answer evaluator, or the overloaded == operator.
156 :     #
157 :    
158 :     our $CMP_ERROR = 2; # a fatal error was detected
159 :    
160 :     sub cmp_compare {
161 :     my $self = shift; my $other = shift; my $ans = shift;
162 :     return eval {$self == $other} unless ref($ans->{checker}) eq 'CODE';
163 :     my $equal = eval {&{$ans->{checker}}($self,$other,$ans)};
164 : dpvc 3298 if (!defined($equal) && $@ ne '' && (!$$Value::context->{error}{flag} || $ans->{showAllErrors})) {
165 : dpvc 3370 $$Value::context->setError(["<I>An error occurred while checking your answer:</I>\n".
166 :     '<DIV STYLE="margin-left:1em">%s</DIV>',$@],'');
167 : dpvc 3206 $$Value::context->{error}{flag} = $CMP_ERROR;
168 :     warn "Please inform your instructor that an error occurred while checking your answer";
169 :     }
170 :     return $equal;
171 :     }
172 :    
173 :     sub cmp_list_compare {Value::List::cmp_list_compare(@_)}
174 :    
175 :     #
176 : dpvc 2593 # Check if types are compatible for equality check
177 :     #
178 :     sub typeMatch {
179 : dpvc 2600 my $self = shift; my $other = shift;
180 :     return 1 unless ref($other);
181 : dpvc 2621 $self->type eq $other->type && $other->class ne 'Formula';
182 : dpvc 2593 }
183 :    
184 :     #
185 : dpvc 2605 # Class name for cmp error messages
186 :     #
187 : dpvc 2609 sub cmp_class {
188 :     my $self = shift; my $ans = shift;
189 : dpvc 2624 my $class = $self->showClass; $class =~ s/Real //;
190 :     return $class if $class =~ m/Formula/;
191 : dpvc 3469 return "an Interval, Set or Union" if $class =~ m/Interval|Set|Union/i;
192 : dpvc 2609 return $class;
193 :     }
194 : dpvc 2605
195 :     #
196 : dpvc 2593 # Student answer evaluation failed.
197 :     # Report the error, with formatting, if possible.
198 :     #
199 :     sub cmp_error {
200 :     my $self = shift; my $ans = shift;
201 : dpvc 3206 my $error = $$Value::context->{error};
202 :     my $message = $error->{message};
203 :     if ($error->{pos}) {
204 :     my $string = $error->{string};
205 :     my ($s,$e) = @{$error->{pos}};
206 : dpvc 2593 $message =~ s/; see.*//; # remove the position from the message
207 :     $ans->{student_ans} =
208 :     protectHTML(substr($string,0,$s)) .
209 :     '<SPAN CLASS="parsehilight">' .
210 :     protectHTML(substr($string,$s,$e-$s)) .
211 :     '</SPAN>' .
212 :     protectHTML(substr($string,$e));
213 :     }
214 : dpvc 2601 $self->cmp_Error($ans,$message);
215 :     }
216 :    
217 :     #
218 :     # Set the error message
219 :     #
220 :     sub cmp_Error {
221 :     my $self = shift; my $ans = shift;
222 :     return unless scalar(@_) > 0;
223 : dpvc 2599 $ans->score(0);
224 : dpvc 2601 $ans->{ans_message} = $ans->{error_message} = join("\n",@_);
225 : dpvc 2593 }
226 :    
227 :     #
228 : dpvc 2601 # filled in by sub-classes
229 :     #
230 :     sub cmp_postprocess {}
231 :    
232 :     #
233 : dpvc 3269 # create answer rules of various types
234 :     #
235 :     sub ans_rule {shift; pgCall('ans_rule',@_)}
236 :     sub named_ans_rule {shift; pgCall('NAMED_ANS_RULE',@_)}
237 :     sub named_ans_rule_extension {shift; pgCall('NAMED_ANS_RULE_EXTENSION',@_)}
238 :     sub ans_array {shift->ans_rule(@_)};
239 :     sub named_ans_array {shift->named_ans_rule(@_)};
240 :     sub named_ans_array_extension {shift->named_ans_rule_extension(@_)};
241 :    
242 :     sub pgCall {my $call = shift; &{WeBWorK::PG::Translator::PG_restricted_eval('\&'.$call)}(@_)}
243 :     sub pgRef {WeBWorK::PG::Translator::PG_restricted_eval('\&'.shift)}
244 :    
245 :     our $answerPrefix = "MaTrIx";
246 :    
247 :     #
248 :     # Lay out a matrix of answer rules
249 :     #
250 :     sub ans_matrix {
251 :     my $self = shift;
252 :     my ($extend,$name,$rows,$cols,$size,$open,$close,$sep) = @_;
253 :     my $named_extension = pgRef('NAMED_ANS_RULE_EXTENSION');
254 :     my $new_name = pgRef('RECORD_FORM_LABEL');
255 :     my $HTML = ""; my $ename = $name;
256 :     if ($name eq '') {
257 :     my $n = pgCall('inc_ans_rule_count');
258 :     $name = pgCall('NEW_ANS_NAME',$n);
259 :     $ename = $answerPrefix.$n;
260 :     }
261 :     $self->{ans_name} = $ename;
262 :     $self->{ans_rows} = $rows;
263 :     $self->{ans_cols} = $cols;
264 :     my @array = ();
265 :     foreach my $i (0..$rows-1) {
266 :     my @row = ();
267 :     foreach my $j (0..$cols-1) {
268 :     if ($i == 0 && $j == 0) {
269 :     if ($extend) {push(@row,&$named_extension(&$new_name($name),$size))}
270 :     else {push(@row,pgCall('NAMED_ANS_RULE',$name,$size))}
271 :     } else {
272 :     push(@row,&$named_extension(&$new_name(ANS_NAME($ename,$i,$j)),$size));
273 :     }
274 :     }
275 :     push(@array,[@row]);
276 :     }
277 :     $self->format_matrix([@array],open=>$open,close=>$close,sep=>$sep);
278 :     }
279 :    
280 :     sub ANS_NAME {
281 :     my ($name,$i,$j) = @_;
282 :     $name.'_'.$i.'_'.$j;
283 :     }
284 :    
285 :    
286 :     #
287 :     # Lay out an arbitrary matrix
288 :     #
289 :     sub format_matrix {
290 :     my $self = shift;
291 :     my $displayMode = $self->getPG('$displayMode');
292 :     return $self->format_matrix_tex(@_) if ($displayMode eq 'TeX');
293 :     return $self->format_matrix_HTML(@_);
294 :     }
295 :    
296 :     sub format_matrix_tex {
297 :     my $self = shift; my $array = shift;
298 : dpvc 3273 my %options = (open=>'.',close=>'.',sep=>'',@_);
299 : dpvc 3269 $self->{format_options} = [%options] unless $self->{format_options};
300 :     my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
301 :     my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
302 :     my $tex = "";
303 : dpvc 3273 $open = '\\'.$open if $open =~ m/[{}]/; $close = '\\'.$close if $close =~ m/[{}]/;
304 :     $tex .= '\(\left'.$open;
305 :     $tex .= '\setlength{\arraycolsep}{2pt}', $sep = '\,'.$sep if $sep;
306 :     $tex .= '\begin{array}{'.('c'x$cols).'}';
307 :     foreach my $i (0..$rows-1) {$tex .= join($sep.'&',@{$array->[$i]}).'\cr'."\n"}
308 :     $tex .= '\end{array}\right'.$close.'\)';
309 : dpvc 3269 return $tex;
310 :     }
311 :    
312 :     sub format_matrix_HTML {
313 :     my $self = shift; my $array = shift;
314 :     my %options = (open=>'',close=>'',sep=>'',tth_delims=>0,@_);
315 :     $self->{format_options} = [%options] unless $self->{format_options};
316 :     my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
317 :     my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
318 :     my $HTML = "";
319 :     if ($sep) {$sep = '</TD><TD STYLE="padding: 0px 1px">'.$sep.'</TD><TD>'}
320 :     else {$sep = '</TD><TD WIDTH="8px"></TD><TD>'}
321 :     foreach my $i (0..$rows-1) {
322 :     $HTML .= '<TR><TD HEIGHT="6px"></TD></TR>' if $i;
323 :     $HTML .= '<TR ALIGN="MIDDLE"><TD>'.join($sep,@{$array->[$i]}).'</TD></TR>'."\n";
324 :     }
325 :     $open = $self->format_delimiter($open,$rows,$options{tth_delims});
326 :     $close = $self->format_delimiter($close,$rows,$options{tth_delims});
327 :     if ($open ne '' || $close ne '') {
328 :     $HTML = '<TR ALIGN="MIDDLE">'
329 :     . '<TD>'.$open.'</TD>'
330 :     . '<TD WIDTH="2"></TD>'
331 :     . '<TD><TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout">'
332 :     . $HTML
333 :     . '</TABLE></TD>'
334 :     . '<TD WIDTH="4"></TD>'
335 :     . '<TD>'.$close.'</TD>'
336 :     . '</TR>'."\n";
337 :     }
338 :     return '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout"'
339 :     . ' STYLE="display:inline;vertical-align:-'.(1.1*$rows-.6).'em">'
340 :     . $HTML
341 :     . '</TABLE>';
342 :     }
343 :    
344 : dpvc 3273 sub VERBATIM {
345 :     my $string = shift;
346 :     my $displayMode = Value->getPG('$displayMode');
347 :     $string = '\end{verbatim}'.$string.'\begin{verbatim}' if $displayMode eq 'TeX';
348 :     return $string;
349 :     }
350 :    
351 : dpvc 3269 #
352 :     # Create a tall delimiter to match the line height
353 :     #
354 :     sub format_delimiter {
355 :     my $self = shift; my $delim = shift; my $rows = shift; my $tth = shift;
356 :     return '' if $delim eq '' || $delim eq '.';
357 :     my $displayMode = $self->getPG('$displayMode');
358 :     return $self->format_delimiter_tth($delim,$rows,$tth)
359 :     if $tth || $displayMode eq 'HTML_tth' || $displayMode !~ m/^HTML_/;
360 :     my $rule = '\vrule width 0pt height '.(.8*$rows).'em depth 0pt';
361 :     $rule = '\rule 0pt '.(.8*$rows).'em 0pt' if $displayMode eq 'HTML_jsMath';
362 :     $delim = '\\'.$delim if $delim eq '{' || $delim eq '}';
363 :     return '\(\left'.$delim.$rule.'\right.\)';
364 :     }
365 :    
366 :     #
367 :     # Data for tth delimiters [top,mid,bot,rep]
368 :     #
369 :     my %tth_delim = (
370 :     '[' => ['&#xF8EE;','','&#xF8F0;','&#xF8EF;'],
371 :     ']' => ['&#xF8F9;','','&#xF8FB;','&#xF8FA;'],
372 :     '(' => ['&#xF8EB;','','&#xF8ED;','&#xF8EC;'],
373 :     ')' => ['&#xF8F6;','','&#xF8F8;','&#xF8F7;'],
374 :     '{' => ['&#xF8F1;','&#xF8F2;','&#xF8F3;','&#xF8F4;'],
375 :     '}' => ['&#xF8FC;','&#xF8FD;','&#xF8FE;','&#xF8F4;'],
376 :     '|' => ['|','','|','|'],
377 :     '<' => ['&lt;'],
378 :     '>' => ['&gt;'],
379 :     '\lgroup' => ['&#xF8F1;','','&#xF8F3;','&#xF8F4;'],
380 :     '\rgroup' => ['&#xF8FC;','','&#xF8FE;','&#xF8F4;'],
381 :     );
382 :    
383 :     #
384 :     # Make delimiters as stacks of characters
385 :     #
386 :     sub format_delimiter_tth {
387 :     my $self = shift;
388 :     my $delim = shift; my $rows = shift; my $tth = shift;
389 :     return '' if $delim eq '' || !defined($tth_delim{$delim});
390 :     my $c = $delim; $delim = $tth_delim{$delim};
391 :     $c = $delim->[0] if scalar(@{$delim}) == 1;
392 :     my $size = ($tth? "": "font-size:175%; ");
393 :     return '<SPAN STYLE="'.$size.'margin:0px 2px">'.$c.'</SPAN>'
394 :     if $rows == 1 || scalar(@{$delim}) == 1;
395 :     my $HTML = "";
396 :     if ($delim->[1] eq '') {
397 :     $HTML = join('<BR>',$delim->[0],($delim->[3])x(2*($rows-1)),$delim->[2]);
398 :     } else {
399 :     $HTML = join('<BR>',$delim->[0],($delim->[3])x($rows-1),
400 :     $delim->[1],($delim->[3])x($rows-1),
401 :     $delim->[2]);
402 :     }
403 :     return '<DIV STYLE="line-height:90%; margin: 0px 2px">'.$HTML.'</DIV>';
404 :     }
405 :    
406 :    
407 :     #
408 :     # Look up the values of the answer array entries, and check them
409 :     # for syntax and other errors. Build the student answer
410 :     # based on these, and keep track of error messages.
411 :     #
412 :    
413 :     my @ans_defaults = (showCoodinateHints => 0, checker => sub {0});
414 :    
415 :     sub ans_collect {
416 :     my $self = shift; my $ans = shift;
417 :     my $inputs = $self->getPG('$inputs_ref');
418 :     my $blank = ($self->getPG('$displayMode') eq 'TeX') ? '\_\_' : '__';
419 :     my ($rows,$cols) = ($self->{ans_rows},$self->{ans_cols});
420 :     my @array = (); my $data = [$self->value]; my $errors = []; my $OK = 1;
421 :     if ($self->{ColumnVector}) {foreach my $x (@{$data}) {$x = [$x]}}
422 :     $data = [$data] unless ref($data->[0]) eq 'ARRAY';
423 :     foreach my $i (0..$rows-1) {
424 :     my @row = ();
425 :     foreach my $j (0..$cols-1) {
426 :     if ($i || $j) {
427 :     my $entry = $inputs->{ANS_NAME($self->{ans_name},$i,$j)};
428 :     my $result = $data->[$i][$j]->cmp(@ans_cmp_defaults)->evaluate($entry);
429 :     $OK &= entryCheck($result,$blank);
430 :     push(@row,$result->{student_formula});
431 :     entryMessage($result->{ans_message},$errors,$i,$j,$rows);
432 :     } else {
433 :     $ans->{student_formula} = $ans->{student_value} = undef unless $ans->{student_ans} =~ m/\S/;
434 :     $OK &= entryCheck($ans,$blank);
435 :     push(@row,$ans->{student_formula});
436 :     entryMessage($ans->{ans_message},$errors,$i,$j,$rows);
437 :     }
438 :     }
439 :     push(@array,[@row]);
440 :     }
441 :     $ans->{student_formula} = [@array];
442 :     $ans->{ans_message} = $ans->{error_message} = join("<BR>",@{$errors});
443 :     return $OK && scalar(@{$errors}) == 0;
444 :     }
445 :    
446 :     sub entryMessage {
447 :     my $message = shift; return unless $message;
448 :     my ($errors,$i,$j,$rows) = @_; $i++; $j++;
449 :     if ($rows == 1) {$message = "Coordinate $j: $message"}
450 :     else {$message = "Entry ($i,$j): $message"}
451 :     push(@{$errors},$message);
452 :     }
453 :    
454 :     sub entryCheck {
455 :     my $ans = shift; my $blank = shift;
456 :     return 1 if defined($ans->{student_value});
457 :     if (!defined($ans->{student_formula})) {
458 :     $ans->{student_formula} = $ans->{student_ans};
459 :     $ans->{student_formula} = $blank unless $ans->{student_formula};
460 :     }
461 :     return 0
462 :     }
463 :    
464 :    
465 :     #
466 : dpvc 2791 # Get and Set values in context
467 :     #
468 :     sub contextSet {
469 :     my $context = shift; my %set = (@_);
470 :     my $flags = $context->{flags}; my $get = {};
471 :     foreach my $id (keys %set) {$get->{$id} = $flags->{$id}; $flags->{$id} = $set{$id}}
472 :     return $get;
473 :     }
474 :    
475 :     #
476 : dpvc 2593 # Quote HTML characters
477 :     #
478 :     sub protectHTML {
479 :     my $string = shift;
480 : dpvc 2661 return $string if eval ('$main::displayMode') eq 'TeX';
481 : dpvc 2593 $string =~ s/&/\&amp;/g;
482 :     $string =~ s/</\&lt;/g;
483 :     $string =~ s/>/\&gt;/g;
484 :     $string;
485 :     }
486 :    
487 : dpvc 2599 #
488 : dpvc 2601 # names for numbers
489 :     #
490 :     sub NameForNumber {
491 :     my $self = shift; my $n = shift;
492 :     my $name = ('zeroth','first','second','third','fourth','fifth',
493 :     'sixth','seventh','eighth','ninth','tenth')[$n];
494 :     $name = "$n-th" if ($n > 10);
495 :     return $name;
496 :     }
497 :    
498 :     #
499 : dpvc 2599 # Get a value from the safe compartment
500 :     #
501 :     sub getPG {
502 :     my $self = shift;
503 : dpvc 2664 # (WeBWorK::PG::Translator::PG_restricted_eval(shift))[0];
504 :     eval ('package main; '.shift); # faster
505 : dpvc 2599 }
506 :    
507 : dpvc 2593 #############################################################
508 :     #############################################################
509 :    
510 : dpvc 2596 package Value::Real;
511 :    
512 : dpvc 2609 sub cmp_defaults {(
513 : dpvc 3206 shift->SUPER::cmp_defaults(@_),
514 : dpvc 2605 ignoreInfinity => 1,
515 : dpvc 2621 )}
516 : dpvc 2597
517 : dpvc 2596 sub typeMatch {
518 :     my $self = shift; my $other = shift; my $ans = shift;
519 : dpvc 2600 return 1 unless ref($other);
520 : dpvc 2648 return 0 if Value::isFormula($other);
521 : dpvc 2605 return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity};
522 : dpvc 2596 $self->type eq $other->type;
523 :     }
524 :    
525 :     #############################################################
526 :    
527 : dpvc 2605 package Value::Infinity;
528 :    
529 : dpvc 2609 sub cmp_class {'a Number'};
530 : dpvc 2605
531 :     sub typeMatch {
532 :     my $self = shift; my $other = shift; my $ans = shift;
533 :     return 1 unless ref($other);
534 : dpvc 2648 return 0 if Value::isFormula($other);
535 : dpvc 2605 return 1 if $other->type eq 'Number';
536 :     $self->type eq $other->type;
537 :     }
538 :    
539 :     #############################################################
540 :    
541 : dpvc 2609 package Value::String;
542 :    
543 :     sub cmp_defaults {(
544 : dpvc 3206 Value::Real->cmp_defaults(@_),
545 : dpvc 2621 typeMatch => 'Value::Real',
546 :     )}
547 : dpvc 2609
548 :     sub cmp_class {
549 : dpvc 2621 my $self = shift; my $ans = shift; my $typeMatch = $ans->{typeMatch};
550 : dpvc 2612 return 'a Word' if !Value::isValue($typeMatch) || $typeMatch->class eq 'String';
551 : dpvc 2609 return $typeMatch->cmp_class;
552 :     };
553 :    
554 :     sub typeMatch {
555 :     my $self = shift; my $other = shift; my $ans = shift;
556 : dpvc 2648 return 0 if ref($other) && Value::isFormula($other);
557 : dpvc 2612 my $typeMatch = $ans->{typeMatch};
558 : dpvc 2621 return 1 if !Value::isValue($typeMatch) || $typeMatch->class eq 'String' ||
559 :     $self->type eq $other->type;
560 : dpvc 2612 return $typeMatch->typeMatch($other,$ans);
561 : dpvc 2609 }
562 :    
563 :     #############################################################
564 :    
565 : dpvc 2593 package Value::Point;
566 :    
567 : dpvc 2609 sub cmp_defaults {(
568 : dpvc 3206 shift->SUPER::cmp_defaults(@_),
569 : dpvc 2601 showDimensionHints => 1,
570 :     showCoordinateHints => 1,
571 : dpvc 2621 )}
572 : dpvc 2593
573 :     sub typeMatch {
574 :     my $self = shift; my $other = shift; my $ans = shift;
575 : dpvc 2621 return ref($other) && $other->type eq 'Point' && $other->class ne 'Formula';
576 : dpvc 2601 }
577 :    
578 :     #
579 :     # Check for dimension mismatch and incorrect coordinates
580 :     #
581 :     sub cmp_postprocess {
582 :     my $self = shift; my $ans = shift;
583 :     return unless $ans->{score} == 0 && !$ans->{isPreview};
584 : dpvc 3205 my $student = $ans->{student_value};
585 :     return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
586 :     if ($ans->{showDimensionHints} && $self->length != $student->length) {
587 : dpvc 3269 $self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
588 : dpvc 2593 }
589 : dpvc 2601 if ($ans->{showCoordinateHints}) {
590 :     my @errors;
591 :     foreach my $i (1..$self->length) {
592 :     push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
593 : dpvc 3205 if ($self->{data}[$i-1] != $student->{data}[$i-1]);
594 : dpvc 2601 }
595 :     $self->cmp_Error($ans,@errors); return;
596 :     }
597 : dpvc 2593 }
598 :    
599 : dpvc 3269 sub correct_ans {
600 :     my $self = shift;
601 :     return $self->SUPER::correct_ans unless $self->{ans_name};
602 : dpvc 3273 Value::VERBATIM($self->format_matrix([[@{$self->{data}}]],@{$self->{format_options}},tth_delims=>1));
603 : dpvc 3269 }
604 :    
605 :     sub ANS_MATRIX {
606 :     my $self = shift;
607 :     my $extend = shift; my $name = shift;
608 :     my $size = shift || 5;
609 :     my $def = ($self->{context} || $$Value::context)->lists->get('Point');
610 :     my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
611 :     $self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,',');
612 :     }
613 :    
614 :     sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
615 :     sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
616 :     sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
617 :    
618 : dpvc 2593 #############################################################
619 :    
620 :     package Value::Vector;
621 :    
622 : dpvc 2609 sub cmp_defaults {(
623 : dpvc 3206 shift->SUPER::cmp_defaults(@_),
624 : dpvc 2601 showDimensionHints => 1,
625 :     showCoordinateHints => 1,
626 : dpvc 2594 promotePoints => 0,
627 : dpvc 2597 parallel => 0,
628 :     sameDirection => 0,
629 : dpvc 2621 )}
630 : dpvc 2593
631 :     sub typeMatch {
632 :     my $self = shift; my $other = shift; my $ans = shift;
633 : dpvc 2621 return 0 unless ref($other) && $other->class ne 'Formula';
634 : dpvc 2627 return $other->type eq 'Vector' ||
635 :     ($ans->{promotePoints} && $other->type eq 'Point');
636 : dpvc 2593 }
637 :    
638 : dpvc 2597 #
639 : dpvc 2601 # check for dimension mismatch
640 :     # for parallel vectors, and
641 :     # for incorrect coordinates
642 : dpvc 2597 #
643 :     sub cmp_postprocess {
644 :     my $self = shift; my $ans = shift;
645 : dpvc 2601 return unless $ans->{score} == 0;
646 : dpvc 3205 my $student = $ans->{student_value};
647 :     return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
648 : dpvc 2601 if (!$ans->{isPreview} && $ans->{showDimensionHints} &&
649 : dpvc 3205 $self->length != $student->length) {
650 : dpvc 3269 $self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
651 : dpvc 2601 }
652 : dpvc 2900 if ($ans->{parallel} &&
653 : dpvc 3205 $self->isParallel($student,$ans->{sameDirection})) {
654 : dpvc 2900 $ans->score(1); return;
655 :     }
656 :     if (!$ans->{isPreview} && $ans->{showCoordinateHints} && !$ans->{parallel}) {
657 : dpvc 2601 my @errors;
658 :     foreach my $i (1..$self->length) {
659 :     push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
660 : dpvc 3205 if ($self->{data}[$i-1] != $student->{data}[$i-1]);
661 : dpvc 2601 }
662 :     $self->cmp_Error($ans,@errors); return;
663 :     }
664 : dpvc 2597 }
665 :    
666 : dpvc 3269 sub correct_ans {
667 :     my $self = shift;
668 :     return $self->SUPER::correct_ans unless $self->{ans_name};
669 : dpvc 3273 return Value::VERBATIM($self->format_matrix([[$self->value]],@{$self->{format_options}},tth_delims=>1))
670 : dpvc 3269 unless $self->{ColumnVector};
671 :     my @array = (); foreach my $x ($self->value) {push(@array,[$x])}
672 : dpvc 3273 return Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
673 : dpvc 3269 }
674 : dpvc 2597
675 : dpvc 3269 sub ANS_MATRIX {
676 :     my $self = shift;
677 :     my $extend = shift; my $name = shift;
678 :     my $size = shift || 5; my ($def,$open,$close);
679 :     $def = ($self->{context} || $$Value::context)->lists->get('Matrix');
680 :     $open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close};
681 :     return $self->ans_matrix($extend,$name,$self->length,1,$size,$open,$close)
682 :     if ($self->{ColumnVector});
683 :     $def = ($self->{context} || $$Value::context)->lists->get('Vector');
684 :     $open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close};
685 :     $self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,',');
686 :     }
687 : dpvc 2597
688 : dpvc 3269 sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
689 :     sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
690 :     sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
691 :    
692 :    
693 : dpvc 2593 #############################################################
694 :    
695 :     package Value::Matrix;
696 :    
697 : dpvc 2609 sub cmp_defaults {(
698 : dpvc 3206 shift->SUPER::cmp_defaults(@_),
699 : dpvc 2601 showDimensionHints => 1,
700 :     showEqualErrors => 0,
701 : dpvc 2621 )}
702 : dpvc 2593
703 :     sub typeMatch {
704 :     my $self = shift; my $other = shift; my $ans = shift;
705 : dpvc 2621 return 0 unless ref($other) && $other->class ne 'Formula';
706 : dpvc 2627 return $other->type eq 'Matrix' ||
707 :     ($other->type =~ m/^(Point|list)$/ &&
708 :     $other->{open}.$other->{close} eq $self->{open}.$self->{close});
709 : dpvc 2601 }
710 :    
711 :     sub cmp_postprocess {
712 :     my $self = shift; my $ans = shift;
713 :     return unless $ans->{score} == 0 &&
714 :     !$ans->{isPreview} && $ans->{showDimensionHints};
715 : dpvc 3205 my $student = $ans->{student_value};
716 :     return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
717 :     my @d1 = $self->dimensions; my @d2 = $student->dimensions;
718 : dpvc 2593 if (scalar(@d1) != scalar(@d2)) {
719 : dpvc 2601 $self->cmp_Error($ans,"Matrix dimension is not correct");
720 :     return;
721 : dpvc 2593 } else {
722 :     foreach my $i (0..scalar(@d1)-1) {
723 :     if ($d1[$i] != $d2[$i]) {
724 : dpvc 2601 $self->cmp_Error($ans,"Matrix dimension is not correct");
725 :     return;
726 : dpvc 2593 }
727 :     }
728 :     }
729 :     }
730 :    
731 : dpvc 3269 sub correct_ans {
732 :     my $self = shift;
733 :     return $self->SUPER::correct_ans unless $self->{ans_name};
734 :     my @array = $self->value; @array = ([@array]) if $self->isRow;
735 : dpvc 3273 Value::VERBATIM($self->format_matrix([$self->value],@{$self->{format_options}},tth_delims=>1));
736 : dpvc 3269 }
737 :    
738 :     sub ANS_MATRIX {
739 :     my $self = shift;
740 :     my $extend = shift; my $name = shift;
741 :     my $size = shift || 5;
742 :     my $def = ($self->{context} || $$Value::context)->lists->get('Matrix');
743 :     my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
744 :     my @d = $self->dimensions;
745 : dpvc 3370 Value::Error("Can't create ans_array for %d-dimensional matrix",scalar(@d))
746 : dpvc 3269 if (scalar(@d) > 2);
747 :     @d = (1,@d) if (scalar(@d) == 1);
748 :     $self->ans_matrix($extend,$name,@d,$size,$open,$close,'');
749 :     }
750 :    
751 :     sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
752 :     sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
753 :     sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
754 :    
755 : dpvc 2593 #############################################################
756 :    
757 :     package Value::Interval;
758 :    
759 : dpvc 2609 sub cmp_defaults {(
760 : dpvc 3206 shift->SUPER::cmp_defaults(@_),
761 : dpvc 2601 showEndpointHints => 1,
762 :     showEndTypeHints => 1,
763 : dpvc 3460 requireParenMatch => 1,
764 : dpvc 2621 )}
765 : dpvc 2594
766 : dpvc 2593 sub typeMatch {
767 :     my $self = shift; my $other = shift;
768 : dpvc 2621 return 0 unless ref($other) && $other->class ne 'Formula';
769 : dpvc 2594 return $other->length == 2 &&
770 :     ($other->{open} eq '(' || $other->{open} eq '[') &&
771 :     ($other->{close} eq ')' || $other->{close} eq ']')
772 :     if $other->type =~ m/^(Point|List)$/;
773 : dpvc 3469 $other->type =~ m/^(Interval|Union|Set)$/;
774 : dpvc 2593 }
775 :    
776 : dpvc 3460 sub cmp_compare {
777 :     my $self = shift; my $other = shift; my $ans = shift;
778 :     my $oldignore = $self->{requireParenMatch};
779 :     $self->{ignoreEndpointTypes} = !$ans->{requireParenMatch};
780 :     my $equal = $self->SUPER::cmp_compare($other,$ans);
781 :     $self->{ignoreEndpointTypes} = $oldignore;
782 :     return $equal;
783 :     }
784 :    
785 : dpvc 2601 #
786 :     # Check for wrong enpoints and wrong type of endpoints
787 :     #
788 :     sub cmp_postprocess {
789 :     my $self = shift; my $ans = shift;
790 :     return unless $ans->{score} == 0 && !$ans->{isPreview};
791 :     my $other = $ans->{student_value};
792 : dpvc 3205 return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String');
793 : dpvc 2604 return unless $other->class eq 'Interval';
794 : dpvc 2601 my @errors;
795 :     if ($ans->{showEndpointHints}) {
796 :     push(@errors,"Your left endpoint is incorrect")
797 :     if ($self->{data}[0] != $other->{data}[0]);
798 :     push(@errors,"Your right endpoint is incorrect")
799 :     if ($self->{data}[1] != $other->{data}[1]);
800 :     }
801 : dpvc 3460 if (scalar(@errors) == 0 && $ans->{showEndTypeHints} && $ans->{requireParenMatch}) {
802 : dpvc 2601 push(@errors,"The type of interval is incorrect")
803 :     if ($self->{open}.$self->{close} ne $other->{open}.$other->{close});
804 :     }
805 :     $self->cmp_Error($ans,@errors);
806 :     }
807 :    
808 : dpvc 2593 #############################################################
809 :    
810 : dpvc 3469 package Value::Set;
811 :    
812 :     sub typeMatch {
813 :     my $self = shift; my $other = shift;
814 :     return 0 unless ref($other) && $other->class ne 'Formula';
815 :     return $other->length == 2 &&
816 :     ($other->{open} eq '(' || $other->{open} eq '[') &&
817 :     ($other->{close} eq ')' || $other->{close} eq ']')
818 :     if $other->type =~ m/^(Point|List)$/;
819 :     $other->type =~ m/^(Interval|Union|Set)/;
820 :     }
821 :    
822 :     #
823 :     # Use the List checker for sets, in order to get
824 :     # partial credit. Set the various types for error
825 :     # messages.
826 :     #
827 :     sub cmp_defaults {(
828 :     Value::List::cmp_defaults(@_),
829 :     typeMatch => 'Value::Real',
830 :     list_type => 'a set',
831 :     entry_type => 'a number',
832 :     removeParens => 0,
833 :     showParenHints => 1,
834 :     )}
835 :    
836 :     #
837 :     # Use the list checker if the student answer is a set
838 :     # otherwise use the standard compare (to get better
839 :     # error messages
840 :     #
841 :     sub cmp_equal {
842 :     my ($self,$ans) = @_;
843 :     Value::List::cmp_equal(@_)
844 :     if $ans->{student_value}->type eq 'Set';
845 :     Value::cmp_equal(@_);
846 :     }
847 :    
848 :     #############################################################
849 :    
850 : dpvc 2593 package Value::Union;
851 :    
852 :     sub typeMatch {
853 :     my $self = shift; my $other = shift;
854 : dpvc 2621 return 0 unless ref($other) && $other->class ne 'Formula';
855 : dpvc 2597 return $other->length == 2 &&
856 :     ($other->{open} eq '(' || $other->{open} eq '[') &&
857 :     ($other->{close} eq ')' || $other->{close} eq ']')
858 :     if $other->type =~ m/^(Point|List)$/;
859 : dpvc 3469 $other->type =~ m/^(Interval|Union|Set)/;
860 : dpvc 2593 }
861 :    
862 : dpvc 2617 #
863 :     # Use the List checker for unions, in order to get
864 :     # partial credit. Set the various types for error
865 :     # messages.
866 :     #
867 :     sub cmp_defaults {(
868 : dpvc 2621 Value::List::cmp_defaults(@_),
869 :     typeMatch => 'Value::Interval',
870 : dpvc 3469 list_type => 'an interval, set or union',
871 :     short_type => 'a union',
872 :     entry_type => 'an interval or set',
873 : dpvc 2617 )}
874 :    
875 :     sub cmp_equal {Value::List::cmp_equal(@_)}
876 :    
877 : dpvc 2593 #############################################################
878 :    
879 : dpvc 2599 package Value::List;
880 :    
881 : dpvc 2621 sub cmp_defaults {
882 :     my $self = shift;
883 : dpvc 3206 my %options = (@_);
884 : dpvc 3207 my $element = Value::makeValue($self->{data}[0]);
885 :     $element = Value::Formula->new($element) unless Value::isValue($element);
886 : dpvc 2621 return (
887 : dpvc 3206 Value::Real->cmp_defaults(@_),
888 : dpvc 2621 showHints => undef,
889 :     showLengthHints => undef,
890 : dpvc 2661 showParenHints => undef,
891 : dpvc 2757 partialCredit => undef,
892 : dpvc 2621 ordered => 0,
893 : dpvc 3206 showEqualErrors => $options{ordered},
894 : dpvc 2621 entry_type => undef,
895 : dpvc 2629 list_type => undef,
896 : dpvc 3207 typeMatch => $element,
897 :     extra => $element,
898 : dpvc 2661 requireParenMatch => 1,
899 :     removeParens => 1,
900 : dpvc 2621 );
901 :     }
902 : dpvc 2599
903 : dpvc 2621 #
904 :     # Match anything but formulas
905 :     #
906 :     sub typeMatch {return !ref($other) || $other->class ne 'Formula'}
907 : dpvc 2599
908 : dpvc 2604 #
909 :     # Handle removal of outermost parens in correct answer.
910 :     #
911 :     sub cmp {
912 :     my $self = shift;
913 :     my $cmp = $self->SUPER::cmp(@_);
914 : dpvc 2661 if ($cmp->{rh_ans}{removeParens}) {
915 : dpvc 2604 $self->{open} = $self->{close} = '';
916 : dpvc 3172 $cmp->ans_hash(correct_ans => $self->stringify)
917 :     unless defined($self->{correct_ans});
918 : dpvc 2604 }
919 :     return $cmp;
920 :     }
921 :    
922 : dpvc 2599 sub cmp_equal {
923 :     my $self = shift; my $ans = shift;
924 : dpvc 2621 $ans->{showPartialCorrectAnswers} = $self->getPG('$showPartialCorrectAnswers');
925 :    
926 :     #
927 :     # get the paramaters
928 :     #
929 : dpvc 3206 my $showHints = getOption($ans,'showHints');
930 :     my $showLengthHints = getOption($ans,'showLengthHints');
931 : dpvc 3469 my $showParenHints = getOption($ans,'showParenHints');
932 : dpvc 3206 my $partialCredit = getOption($ans,'partialCredit');
933 : dpvc 2661 my $requireParenMatch = $ans->{requireParenMatch};
934 : dpvc 3206 my $typeMatch = $ans->{typeMatch};
935 :     my $value = $ans->{entry_type};
936 :     my $ltype = $ans->{list_type} || lc($self->type);
937 : dpvc 3469 my $stype = $ans->{short_type} || $ltype;
938 : dpvc 2621
939 :     $value = (Value::isValue($typeMatch)? lc($typeMatch->cmp_class): 'value')
940 :     unless defined($value);
941 : dpvc 2624 $value =~ s/(real|complex) //; $ans->{cmp_class} = $value;
942 :     $value =~ s/^an? //; $value = 'formula' if $value =~ m/formula/;
943 : dpvc 3469 $ltype =~ s/^an? //; $stype =~ s/^an? //;
944 : dpvc 3206 $showHints = $showLengthHints = 0 if $ans->{isPreview};
945 : dpvc 2599
946 : dpvc 2621 #
947 :     # Get the lists of correct and student answers
948 : dpvc 2624 # (split formulas that return lists or unions)
949 : dpvc 2621 #
950 : dpvc 2661 my @correct = (); my ($cOpen,$cClose);
951 :     if ($self->class ne 'Formula') {
952 :     @correct = $self->value;
953 :     $cOpen = $ans->{correct_value}{open}; $cClose = $ans->{correct_value}{close};
954 :     } else {
955 :     @correct = Value::List->splitFormula($self,$ans);
956 :     $cOpen = $self->{tree}{open}; $cClose = $self->{tree}{close};
957 :     }
958 :     my $student = $ans->{student_value}; my @student = ($student);
959 :     my ($sOpen,$sClose) = ('','');
960 : dpvc 2648 if (Value::isFormula($student) && $student->type eq $self->type) {
961 : dpvc 2624 @student = Value::List->splitFormula($student,$ans);
962 : dpvc 2661 $sOpen = $student->{tree}{open}; $sClose = $student->{tree}{close};
963 :     } elsif ($student->class ne 'Formula' && $student->class eq $self->type) {
964 : dpvc 2621 @student = @{$student->{data}};
965 : dpvc 2661 $sOpen = $student->{open}; $sClose = $student->{close};
966 : dpvc 2621 }
967 : dpvc 2624 return if $ans->{split_error};
968 : dpvc 2661 #
969 :     # Check for parenthesis match
970 :     #
971 :     if ($requireParenMatch && ($sOpen ne $cOpen || $sClose ne $cClose)) {
972 :     if ($showParenHints && !($ans->{ignoreStrings} && $student->type eq 'String')) {
973 :     my $message = "The parentheses for your $ltype ";
974 :     if (($cOpen || $cClose) && ($sOpen || $sClose))
975 :     {$message .= "are of the wrong type"}
976 :     elsif ($sOpen || $sClose) {$message .= "should be removed"}
977 : dpvc 3469 else {$message .= "seem to be missing"}
978 : dpvc 2664 $self->cmp_Error($ans,$message) unless $ans->{isPreview};
979 : dpvc 2661 }
980 :     return;
981 :     }
982 : dpvc 2599
983 : dpvc 2621 #
984 : dpvc 3206 # Determine the maximum score
985 : dpvc 2621 #
986 : dpvc 2624 my $M = scalar(@correct);
987 : dpvc 2599 my $m = scalar(@student);
988 : dpvc 2624 my $maxscore = ($m > $M)? $m : $M;
989 : dpvc 3206
990 :     #
991 :     # Compare the two lists
992 :     # (Handle errors in user-supplied functions)
993 :     #
994 :     my ($score,@errors);
995 :     if (ref($ans->{list_checker}) eq 'CODE') {
996 :     eval {($score,@errors) = &{$ans->{list_checker}}([@correct],[@student],$ans,$value)};
997 :     if (!defined($score)) {
998 :     die $@ if $@ ne '' && $self->{context}{error}{flag} == 0;
999 :     $self->cmp_error($ans) if $self->{context}{error}{flag};
1000 :     }
1001 :     } else {
1002 :     ($score,@errors) = $self->cmp_list_compare([@correct],[@student],$ans,$value);
1003 :     }
1004 :     return unless defined($score);
1005 :    
1006 :     #
1007 :     # Give hints about extra or missing answers
1008 :     #
1009 :     if ($showLengthHints) {
1010 :     $value =~ s/ or /s or /; # fix "interval or union"
1011 : dpvc 3469 push(@errors,"There should be more ${value}s in your $stype")
1012 : dpvc 3206 if ($score < $maxscore && $score == $m);
1013 : dpvc 3469 push(@errors,"There should be fewer ${value}s in your $stype")
1014 : dpvc 3206 if ($score < $maxscore && $score == $M && !$showHints);
1015 :     }
1016 :    
1017 :     #
1018 :     # Finalize the score
1019 :     #
1020 :     $score = 0 if ($score != $maxscore && !$partialCredit);
1021 :     $ans->score($score/$maxscore);
1022 :     push(@errors,"Score = $ans->{score}") if $ans->{debug};
1023 : dpvc 3207 my $error = join("\n",@errors); $error =~ s!</DIV>\n!</DIV>!g;
1024 :     $ans->{error_message} = $ans->{ans_message} = $error;
1025 : dpvc 3206 }
1026 :    
1027 :     #
1028 :     # Compare the contents of the list to see of they are equal
1029 :     #
1030 :     sub cmp_list_compare {
1031 :     my $self = shift;
1032 :     my $correct = shift; my $student = shift; my $ans = shift; my $value = shift;
1033 :     my @correct = @{$correct}; my @student = @{$student}; my $m = scalar(@student);
1034 :     my $ordered = $ans->{ordered};
1035 :     my $showTypeWarnings = $ans->{showTypeWarnings} && !$ans->{isPreview};
1036 :     my $typeMatch = $ans->{typeMatch};
1037 : dpvc 3207 my $extra = $ans->{extra};
1038 : dpvc 3206 my $showHints = getOption($ans,'showHints') && !$ans->{isPreview};
1039 :     my $error = $$Value::context->{error};
1040 : dpvc 2599 my $score = 0; my @errors; my $i = 0;
1041 :    
1042 : dpvc 2621 #
1043 : dpvc 3206 # Check for empty lists
1044 :     #
1045 :     if (scalar(@correct) == 0) {$ans->score($m == 0); return}
1046 :    
1047 :     #
1048 : dpvc 2621 # Loop through student answers looking for correct ones
1049 :     #
1050 : dpvc 2599 ENTRY: foreach my $entry (@student) {
1051 : dpvc 3206 $i++; $$Value::context->clearError;
1052 : dpvc 2605 $entry = Value::makeValue($entry);
1053 : dpvc 2600 $entry = Value::Formula->new($entry) if !Value::isValue($entry);
1054 : dpvc 2599 if ($ordered) {
1055 : dpvc 3207 if (scalar(@correct)) {
1056 :     if (shift(@correct)->cmp_compare($entry,$ans)) {$score++; next ENTRY}
1057 :     } else {
1058 :     $extra->cmp_compare($entry,$ans); # do syntax check
1059 :     }
1060 : dpvc 3206 if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
1061 : dpvc 2599 } else {
1062 :     foreach my $k (0..$#correct) {
1063 : dpvc 3206 if ($correct[$k]->cmp_compare($entry,$ans)) {
1064 : dpvc 2599 splice(@correct,$k,1);
1065 :     $score++; next ENTRY;
1066 :     }
1067 : dpvc 3206 if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
1068 : dpvc 2599 }
1069 :     }
1070 : dpvc 2621 #
1071 :     # Give messages about incorrect answers
1072 :     #
1073 : dpvc 2629 my $nth = ''; my $answer = 'answer';
1074 :     my $class = $ans->{list_type} || $self->cmp_class;
1075 : dpvc 3206 if ($m > 1) {
1076 : dpvc 2622 $nth = ' '.$self->NameForNumber($i);
1077 :     $class = $ans->{cmp_class};
1078 : dpvc 2624 $answer = 'value';
1079 : dpvc 2622 }
1080 : dpvc 3206 if ($error->{flag} && $ans->{showEqualErrors}) {
1081 : dpvc 3207 my $message = $error->{message}; $message =~ s/\s+$//;
1082 :     push(@errors,"<SMALL>There is a problem with your$nth $value:</SMALL>",
1083 :     '<DIV STYLE="margin-left:1em">'.$message.'</DIV>');
1084 : dpvc 3206 } elsif ($showTypeWarnings && !$typeMatch->typeMatch($entry,$ans) &&
1085 :     !($ans->{ignoreStrings} && $entry->class eq 'String')) {
1086 : dpvc 2624 push(@errors,"Your$nth $answer isn't ".lc($class).
1087 :     " (it looks like ".lc($entry->showClass).")");
1088 : dpvc 2621 } elsif ($showHints && $m > 1) {
1089 :     push(@errors,"Your$nth $value is incorrect");
1090 : dpvc 2599 }
1091 :     }
1092 :    
1093 : dpvc 2621 #
1094 : dpvc 3206 # Return the score and errors
1095 : dpvc 2621 #
1096 : dpvc 3206 return ($score,@errors);
1097 : dpvc 2599 }
1098 :    
1099 :     #
1100 : dpvc 2624 # Split a formula that is a list or union into a
1101 :     # list of formulas (or Value objects).
1102 :     #
1103 :     sub splitFormula {
1104 :     my $self = shift; my $formula = shift; my $ans = shift;
1105 :     my @formula; my @entries;
1106 : dpvc 3469 if ($formula->type eq 'Union') {@entries = $formula->{tree}->makeUnion}
1107 :     else {@entries = @{$formula->{tree}{coords}}}
1108 : dpvc 2624 foreach my $entry (@entries) {
1109 :     my $v = Parser::Formula($entry);
1110 :     $v = Parser::Evaluate($v) if (defined($v) && $v->isConstant);
1111 :     push(@formula,$v);
1112 :     #
1113 :     # There shouldn't be an error evaluating the formula,
1114 :     # but you never know...
1115 :     #
1116 : dpvc 2648 if (!defined($v)) {$ans->{split_error} = 1; $self->cmp_error; return}
1117 : dpvc 2624 }
1118 :     return @formula;
1119 :     }
1120 :    
1121 :     #
1122 : dpvc 2621 # Return the value if it is defined, otherwise use a default
1123 : dpvc 2599 #
1124 :     sub getOption {
1125 : dpvc 2621 my $ans = shift; my $name = shift;
1126 :     my $value = $ans->{$name};
1127 : dpvc 2599 return $value if defined($value);
1128 : dpvc 2621 return $ans->{showPartialCorrectAnswers};
1129 : dpvc 2599 }
1130 :    
1131 :     #############################################################
1132 :    
1133 : dpvc 2593 package Value::Formula;
1134 :    
1135 : dpvc 2624 sub cmp_defaults {
1136 :     my $self = shift;
1137 : dpvc 2626
1138 : dpvc 2624 return (
1139 :     Value::Union::cmp_defaults($self,@_),
1140 :     typeMatch => Value::Formula->new("(1,2]"),
1141 : dpvc 3257 showDomainErrors => 1,
1142 : dpvc 2624 ) if $self->type eq 'Union';
1143 : dpvc 2622
1144 : dpvc 2667 my $type = $self->type;
1145 :     $type = ($self->isComplex)? 'Complex': 'Real' if $type eq 'Number';
1146 :     $type = 'Value::'.$type.'::';
1147 : dpvc 2624
1148 : dpvc 3257 return (
1149 :     &{$type.'cmp_defaults'}($self,@_),
1150 :     upToConstant => 0,
1151 :     showDomainErrors => 1,
1152 :     ) if defined(%$type) && $self->type ne 'List';
1153 : dpvc 2667
1154 : dpvc 2624 return (
1155 :     Value::List::cmp_defaults($self,@_),
1156 : dpvc 2661 removeParens => $self->{autoFormula},
1157 : dpvc 2624 typeMatch => Value::Formula->new(($self->createRandomPoints(1))[1]->[0]{data}[0]),
1158 : dpvc 3257 showDomainErrors => 1,
1159 : dpvc 2624 );
1160 :     }
1161 :    
1162 :     #
1163 :     # Get the types from the values of the formulas
1164 :     # and compare those.
1165 :     #
1166 :     sub typeMatch {
1167 :     my $self = shift; my $other = shift; my $ans = shift;
1168 :     return 1 if $self->type eq $other->type;
1169 :     my $typeMatch = ($self->createRandomPoints(1))[1]->[0];
1170 : dpvc 2648 $other = eval {($other->createRandomPoints(1))[1]->[0]} if Value::isFormula($other);
1171 : dpvc 2624 return 1 unless defined($other); # can't really tell, so don't report type mismatch
1172 :     $typeMatch->typeMatch($other,$ans);
1173 :     }
1174 :    
1175 : dpvc 2629 #
1176 :     # Handle removal of outermost parens in a list.
1177 :     #
1178 :     sub cmp {
1179 :     my $self = shift;
1180 :     my $cmp = $self->SUPER::cmp(@_);
1181 : dpvc 2661 if ($cmp->{rh_ans}{removeParens} && $self->type eq 'List') {
1182 : dpvc 2629 $self->{tree}{open} = $self->{tree}{close} = '';
1183 : dpvc 3172 $cmp->ans_hash(correct_ans => $self->stringify)
1184 :     unless defined($self->{correct_ans});
1185 : dpvc 2629 }
1186 : dpvc 2799 if ($cmp->{rh_ans}{eval} && $self->isConstant) {
1187 :     $cmp->ans_hash(correct_value => $self->eval);
1188 :     return $cmp;
1189 :     }
1190 : dpvc 2688 if ($cmp->{rh_ans}{upToConstant}) {
1191 :     my $current = Parser::Context->current();
1192 :     my $context = $self->{context} = $self->{context}->copy;
1193 :     Parser::Context->current(undef,$context);
1194 :     $context->{_variables}->{pattern} = $context->{_variables}->{namePattern} =
1195 :     'C0|' . $context->{_variables}->{pattern};
1196 :     $context->update; $context->variables->add('C0' => 'Parameter');
1197 : dpvc 3217 my $f = Value::Formula->new('C0')+$self;
1198 : dpvc 3257 for ('limits','test_points','test_values','num_points','granularity','resolution',
1199 :     'checkUndefinedPoints','max_undefined')
1200 : dpvc 3217 {$f->{$_} = $self->{$_} if defined($self->{$_})}
1201 :     $cmp->ans_hash(correct_value => $f);
1202 : dpvc 2688 Parser::Context->current(undef,$current);
1203 :     }
1204 : dpvc 2629 return $cmp;
1205 :     }
1206 :    
1207 : dpvc 2622 sub cmp_equal {
1208 : dpvc 2624 my $self = shift; my $ans = shift;
1209 :     #
1210 :     # Get the problem's seed
1211 :     #
1212 : dpvc 2622 $self->{context}->flags->set(
1213 :     random_seed => $self->getPG('$PG_original_problemSeed')
1214 :     );
1215 : dpvc 2624
1216 :     #
1217 :     # Use the list checker if the formula is a list or union
1218 :     # Otherwise use the normal checker
1219 :     #
1220 :     if ($self->type =~ m/^(List|Union)$/) {
1221 :     Value::List::cmp_equal($self,$ans);
1222 :     } else {
1223 :     $self->SUPER::cmp_equal($ans);
1224 :     }
1225 : dpvc 2622 }
1226 :    
1227 : dpvc 2667 sub cmp_postprocess {
1228 :     my $self = shift; my $ans = shift;
1229 :     return unless $ans->{score} == 0 && !$ans->{isPreview};
1230 : dpvc 3257 return if $ans->{ans_message};
1231 :     if ($self->{domainMismatch} && $ans->{showDomainErrors}) {
1232 :     $self->cmp_Error($ans,"The domain of your function doesn't match that of the correct answer");
1233 :     return;
1234 :     }
1235 :     return if !$ans->{showDimensionHints};
1236 : dpvc 2667 my $other = $ans->{student_value};
1237 : dpvc 3205 return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String');
1238 : dpvc 2667 return unless $other->type =~ m/^(Point|Vector|Matrix)$/;
1239 :     return unless $self->type =~ m/^(Point|Vector|Matrix)$/;
1240 :     return if Parser::Item::typeMatch($self->typeRef,$other->typeRef);
1241 : dpvc 2671 $self->cmp_Error($ans,"The dimension of your result is incorrect");
1242 : dpvc 2593 }
1243 :    
1244 : dpvc 3269 #
1245 :     # If an answer array was used, get the data from the
1246 :     # Matrix, Vector or Point, and format the array of
1247 :     # data using the original parameter
1248 :     #
1249 :     sub correct_ans {
1250 :     my $self = shift;
1251 :     return $self->SUPER::correct_ans unless $self->{ans_name};
1252 :     my @array = ();
1253 :     if ($self->{tree}->type eq 'Matrix') {
1254 :     foreach my $row (@{$self->{tree}{coords}}) {
1255 :     my @row = ();
1256 :     foreach my $x (@{$row->coords}) {push(@row,$x->string)}
1257 :     push(@array,[@row]);
1258 :     }
1259 :     } else {
1260 :     foreach my $x (@{$self->{tree}{coords}}) {push(@array,$x->string)}
1261 :     if ($self->{tree}{ColumnVector}) {foreach my $x (@array) {$x = [$x]}}
1262 :     else {@array = [@array]}
1263 :     }
1264 : dpvc 3273 Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
1265 : dpvc 3269 }
1266 :    
1267 :     #
1268 :     # Get the size of the array and create the appropriate answer array
1269 :     #
1270 :     sub ANS_MATRIX {
1271 :     my $self = shift;
1272 :     my $extend = shift; my $name = shift;
1273 :     my $size = shift || 5; my $type = $self->type;
1274 :     my $cols = $self->length; my $rows = 1; my $sep = ',';
1275 :     if ($type eq 'Matrix') {
1276 :     $sep = ''; $rows = $cols; $cols = $self->{tree}->typeRef->{entryType}{length};
1277 :     }
1278 :     if ($self->{tree}{ColumnVector}) {
1279 :     $sep = ""; $type = "Matrix";
1280 :     my $tmp = $rows; $rows = $cols; $cols = $tmp;
1281 :     $self->{ColumnVector} = 1;
1282 :     }
1283 :     my $def = ($self->{context} || $$Value::context)->lists->get($type);
1284 :     my $open = $self->{open} || $self->{tree}{open} || $def->{open};
1285 :     my $close = $self->{close} || $self->{tree}{close} || $def->{close};
1286 :     $self->ans_matrix($extend,$name,$rows,$cols,$size,$open,$close,$sep);
1287 :     }
1288 :    
1289 :     sub ans_array {
1290 :     my $self = shift;
1291 :     return $self->SUPER::ans_array(@_) unless $self->array_OK;
1292 :     $self->ANS_MATRIX(0,'',@_);
1293 :     }
1294 :     sub named_ans_array {
1295 :     my $self = shift;
1296 :     return $self->SUPER::named_ans_array(@_) unless $self->array_OK;
1297 :     $self->ANS_MATRIX(0,@_);
1298 :     }
1299 :     sub named_ans_array_extension {
1300 :     my $self = shift;
1301 :     return $self->SUPER::named_ans_array_extension(@_) unless $self->array_OK;
1302 :     $self->ANS_MATRIX(1,@_);
1303 :     }
1304 :    
1305 :     sub array_OK {
1306 :     my $self = shift; my $tree = $self->{tree};
1307 :     return $tree->type =~ m/^(Point|Vector|Matrix)$/ && $tree->class eq 'List';
1308 :     }
1309 :    
1310 :     #
1311 :     # Get an array of values from a Matrix, Vector or Point
1312 :     #
1313 :     sub value {
1314 :     my $self = shift;
1315 :     my @array = ();
1316 :     if ($self->{tree}->type eq 'Matrix') {
1317 :     foreach my $row (@{$self->{tree}->coords}) {
1318 :     my @row = ();
1319 :     foreach my $x (@{$row->coords}) {push(@row,Value::Formula->new($x))}
1320 :     push(@array,[@row]);
1321 :     }
1322 :     } else {
1323 :     foreach my $x (@{$self->{tree}->coords}) {
1324 :     push(@array,Value::Formula->new($x));
1325 :     }
1326 :     }
1327 :     return @array;
1328 :     }
1329 :    
1330 : dpvc 2593 #############################################################
1331 :    
1332 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9