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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 2600 Revision 4093
… …
12############################################################# 12#############################################################
13 13
14package Value; 14package Value;
15 15
16# 16#
17# Context can add default values to the answer checkers by class;
18#
19$Value::defaultContext->{cmpDefaults} = {};
20
21
22#
23# Default flags for the answer checkers
24#
25sub cmp_defaults {(
26 showTypeWarnings => 1,
27 showEqualErrors => 1,
28 ignoreStrings => 1,
29 studentsMustReduceUnions => 1,
30 showUnionReduceWarnings => 1,
31)}
32
33#
34# Special Context flags to be set for the student answer
35#
36sub cmp_contextFlags {
37 my $self = shift; my $ans = shift;
38 return (
39 StringifyAsTeX => 0, # reset this, just in case.
40 no_parameters => 1, # don't let students enter parameters
41 showExtraParens => 1, # make student answer painfully unambiguous
42 reduceConstants => 0, # don't combine student constants
43 reduceConstantFunctions => 0, # don't reduce constant functions
44 ($ans->{studentsMustReduceUnions} ?
45 (reduceUnions => 0, reduceSets => 0,
46 reduceUnionsForComparison => $ans->{showUnionReduceWarnings},
47 reduceSetsForComparison => $ans->{showUnionReduceWarnings}) :
48 (reduceUnions => 1, reduceSets => 1,
49 reduceUnionsForComparison => 1, reduceSetsForComparison => 1)),
50 ($ans->{requireParenMatch}? (): ignoreEndpointTypes => 1), # for Intervals
51 );
52}
53
54
55#
17# Create an answer checker for the given type of object 56# Create an answer checker for the given type of object
18# 57#
19
20our $cmp_defaults = {
21 showTypeWarnings => 1,
22 showEqualErrors => 1,
23};
24
25sub cmp { 58sub cmp {
26 my $self = shift; 59 my $self = shift;
27 my $ans = new AnswerEvaluator; 60 my $ans = new AnswerEvaluator;
28 my $defaults = ref($self)."::cmp_defaults"; 61 my $correct = protectHTML($self->{correct_ans});
62 $correct = $self->correct_ans unless defined($correct);
63 $self->{context} = $$Value::context unless defined($self->{context});
29 $ans->ans_hash( 64 $ans->ans_hash(
30 type => "Value (".$self->class.")", 65 type => "Value (".$self->class.")",
31 correct_ans => $self->string, 66 correct_ans => $correct,
32 correct_value => $self, 67 correct_value => $self,
33 %{$$defaults || $cmp_defaults}, 68 $self->cmp_defaults(@_),
69 %{$self->{context}{cmpDefaults}{$self->class} || {}}, # context-specified defaults
34 @_ 70 @_
35 ); 71 );
36 $ans->install_evaluator( 72 $ans->{debug} = $ans->{rh_ans}{debug};
37 sub { 73 $ans->install_evaluator(sub {$ans = shift; $ans->{correct_value}->cmp_parse($ans)});
38 my $ans = shift; 74 $ans->install_pre_filter('erase') if $self->{ans_name}; # don't do blank check if answer_array
39 # can't seem to get $inputs_ref any other way 75 $self->cmp_diagnostics($ans);
40 $ans->{isPreview} = $self->getPG('$inputs_ref->{previewAnswers}');
41 my $self = $ans->{correct_value};
42 my $method = $ans->{cmp_check} || 'cmp_check';
43 $self->$method($ans);
44 }
45 );
46 return $ans; 76 return $ans;
47} 77}
78
79sub correct_ans {protectHTML(shift->string)}
80sub cmp_diagnostics {}
48 81
49# 82#
50# Parse the student answer and compute its value, 83# Parse the student answer and compute its value,
51# produce the preview strings, and then compare the 84# produce the preview strings, and then compare the
52# student and professor's answers for equality. 85# student and professor's answers for equality.
53# 86#
54sub cmp_check { 87sub cmp_parse {
55 my $self = shift; my $ans = shift; 88 my $self = shift; my $ans = shift;
56 # 89 #
57 # Methods to call 90 # Do some setup
58 # 91 #
59 my $cmp_equal = $ans->{cmp_equal} || 'cmp_equal'; 92 my $current = $$Value::context; # save it for later
60 my $cmp_error = $ans->{cmp_error} || 'cmp_error'; 93 my $context = $ans->{correct_value}{context} || $current;
61 my $cmp_postprocess = $ans->{cmp_postprocess}; 94 Parser::Context->current(undef,$context); # change to correct answser's context
95 my $flags = contextSet($context,$self->cmp_contextFlags($ans)); # save old context flags
96 my $inputs = $self->getPG('$inputs_ref',{action=>""});
97 $ans->{isPreview} = $inputs->{previewAnswers} || ($inputs->{action} =~ m/^Preview/);
98 $ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class};
99 $ans->{error_message} = $ans->{ans_message} = ''; # clear any old messages
100 $ans->{preview_latex_string} = $ans->{preview_text_string} = '';
101
62 # 102 #
63 # Parse and evaluate the student answer 103 # Parse and evaluate the student answer
64 # 104 #
65 $ans->score(0); # assume failure 105 $ans->score(0); # assume failure
66 my $vars = $$Value::context->{variables};
67 $$Value::context->{variables} = {}; # pretend there are no variables
68 $ans->{student_formula} = Parser::Formula($ans->{student_ans}); 106 $ans->{student_value} = $ans->{student_formula} = Parser::Formula($ans->{student_ans});
69 $ans->{student_value} = Parser::Evaluate($ans->{student_formula}); 107 $ans->{student_value} = Parser::Evaluate($ans->{student_formula})
70 $$Value::context->{variables} = $vars; 108 if defined($ans->{student_formula}) && $ans->{student_formula}->isConstant;
109
71 # 110 #
72 # If it parsed OK, save the output forms and check if it is correct 111 # If it parsed OK, save the output forms and check if it is correct
73 # otherwise report an error 112 # otherwise report an error
74 # 113 #
75 if (defined $ans->{student_value}) { 114 if (defined $ans->{student_value}) {
76 $ans->{student_value} = Value::Formula->new($ans->{student_value}) 115 $ans->{student_value} = Value::Formula->new($ans->{student_value})
77 unless Value::isValue($ans->{student_value}); 116 unless Value::isValue($ans->{student_value});
78 $ans->{preview_latex_string} = $ans->{student_formula}->TeX; 117 $ans->{preview_latex_string} = $ans->{student_formula}->TeX;
79 $ans->{preview_text_string} = $ans->{student_formula}->string; 118 $ans->{preview_text_string} = protectHTML($ans->{student_formula}->string);
80 $ans->{student_ans} = $ans->{student_value}->stringify; 119 #
120 # Get the string for the student answer
121 #
122 for ($ans->{formatStudentAnswer} || $context->flag('formatStudentAnswer')) {
123 /evaluated/i and do {$ans->{student_ans} = protectHTML($ans->{student_value}->string); last};
124 /parsed/i and do {$ans->{student_ans} = $ans->{preview_text_string}; last};
125 /reduced/i and do {
126 my $oldFlags = contextSet($context,reduceConstants=>1,reduceConstantFunctions=>0);
127 $ans->{student_ans} = protectHTML($ans->{student_formula}->substitute()->string);
128 contextSet($context,%{$oldFags}); last;
129 };
130 warn "Unkown student answer format |$ans->{formatStudentAnswer}|";
131 }
132 if ($self->cmp_collect($ans)) {
81 $self->$cmp_equal($ans); 133 $self->cmp_equal($ans);
82 $self->$cmp_postprocess($ans) if $cmp_postprocess && !$ans->{error_message}; 134 $self->cmp_postprocess($ans) if !$ans->{error_message} && !$ans->{typeError};
135 $self->cmp_diagnostics($ans);
136 }
83 } else { 137 } else {
138 $self->cmp_collect($ans);
84 $self->$cmp_error($ans); 139 $self->cmp_error($ans);
85 } 140 }
141 contextSet($context,%{$flags}); # restore context values
142 Parser::Context->current(undef,$current); # put back the old context
86 return $ans; 143 return $ans;
144}
145
146#
147# Check if the object has an answer array and collect the results
148# Build the combined student answer and set the preview values
149#
150sub cmp_collect {
151 my $self = shift; my $ans = shift;
152 return 1 unless $self->{ans_name};
153 $ans->{preview_latex_string} = $ans->{preview_text_string} = "";
154 my $OK = $self->ans_collect($ans);
155 $ans->{student_ans} = $self->format_matrix($ans->{student_formula},@{$self->{format_options}},tth_delims=>1);
156 return 0 unless $OK;
157 my $array = $ans->{student_formula};
158 if ($self->{ColumnVector}) {
159 my @V = (); foreach my $x (@{$array}) {push(@V,$x->[0])}
160 $array = [@V];
161 } elsif (scalar(@{$array}) == 1) {$array = $array->[0]}
162 my $type = $self;
163 $type = "Value::".$self->{tree}->type if $self->class eq 'Formula';
164 $ans->{student_formula} = eval {$type->new($array)->with(ColumnVector=>$self->{ColumnVector})};
165 if (!defined($ans->{student_formula}) || $$Value::context->{error}{flag})
166 {Parser::reportEvalError($@); $self->cmp_error($ans); return 0}
167 $ans->{student_value} = $ans->{student_formula};
168 $ans->{preview_text_string} = $ans->{student_ans};
169 $ans->{preview_latex_string} = $ans->{student_formula}->TeX;
170 if (Value::isFormula($ans->{student_formula}) && $ans->{student_formula}->isConstant) {
171 $ans->{student_value} = Parser::Evaluate($ans->{student_formula});
172 return 0 unless $ans->{student_value};
173 }
174 return 1;
87} 175}
88 176
89# 177#
90# Check if the parsed student answer equals the professor's answer 178# Check if the parsed student answer equals the professor's answer
91# 179#
92sub cmp_equal { 180sub cmp_equal {
93 my $self = shift; my $ans = shift; 181 my $self = shift; my $ans = shift;
182 my $correct = $ans->{correct_value};
183 my $student = $ans->{student_value};
94 if ($ans->{correct_value}->typeMatch($ans->{student_value},$ans)) { 184 if ($correct->typeMatch($student,$ans)) {
95 my $equal = eval {$ans->{correct_value} == $ans->{student_value}}; 185 my $equal = $correct->cmp_compare($student,$ans);
96 if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return} 186 if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return}
97 my $cmp_error = $ans->{cmp_error} || 'cmp_error';
98 $self->$cmp_error($ans); 187 $self->cmp_error($ans);
99 } else { 188 } else {
189 return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
190 $ans->{typeError} = 1;
100 $ans->{ans_message} = $ans->{error_message} = 191 $ans->{ans_message} = $ans->{error_message} =
101 "Your answer isn't ".lc($ans->{correct_value}->showClass). 192 "Your answer isn't ".lc($ans->{cmp_class})."\n".
102 " (it looks like ".lc($ans->{student_value}->showClass).")" 193 "(it looks like ".lc($student->showClass).")"
103 if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message}; 194 if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message};
104 } 195 }
105} 196}
197
198#
199# Perform the comparison, either using the checker supplied
200# by the answer evaluator, or the overloaded == operator.
201#
202
203our $CMP_ERROR = 2; # a fatal error was detected
204our $CMP_WARNING = 3; # a warning was produced
205
206sub cmp_compare {
207 my $self = shift; my $other = shift; my $ans = shift; my $nth = shift || '';
208 return eval {$self == $other} unless ref($ans->{checker}) eq 'CODE';
209 my $equal = eval {&{$ans->{checker}}($self,$other,$ans,$nth,@_)};
210 if (!defined($equal) && $@ ne '' && (!$$Value::context->{error}{flag} || $ans->{showAllErrors})) {
211 $$Value::context->setError(["<I>An error occurred while checking your$nth answer:</I>\n".
212 '<DIV STYLE="margin-left:1em">%s</DIV>',$@],'',undef,undef,$CMP_ERROR);
213 warn "Please inform your instructor that an error occurred while checking your answer";
214 }
215 return $equal;
216}
217
218sub cmp_list_compare {Value::List::cmp_list_compare(@_)}
106 219
107# 220#
108# Check if types are compatible for equality check 221# Check if types are compatible for equality check
109# 222#
110sub typeMatch { 223sub typeMatch {
111 my $self = shift; my $other = shift; 224 my $self = shift; my $other = shift;
112 return 1 unless ref($other); 225 return 1 unless ref($other);
113 $self->type eq $other->type; 226 $self->type eq $other->type && $other->class ne 'Formula';
227}
228
229#
230# Class name for cmp error messages
231#
232sub cmp_class {
233 my $self = shift; my $ans = shift;
234 my $class = $self->showClass; $class =~ s/Real //;
235 return $class if $class =~ m/Formula/;
236 return "an Interval, Set or Union" if $self->isSetOfReals;
237 return $class;
114} 238}
115 239
116# 240#
117# Student answer evaluation failed. 241# Student answer evaluation failed.
118# Report the error, with formatting, if possible. 242# Report the error, with formatting, if possible.
119# 243#
120sub cmp_error { 244sub cmp_error {
121 my $self = shift; my $ans = shift; 245 my $self = shift; my $ans = shift;
122 my $context = $$Value::context; 246 my $error = $$Value::context->{error};
123 my $message = $context->{error}{message}; 247 my $message = $error->{message};
124 if ($context->{error}{pos}) { 248 if ($error->{pos}) {
125 my $string = $context->{error}{string}; 249 my $string = $error->{string};
126 my ($s,$e) = @{$context->{error}{pos}}; 250 my ($s,$e) = @{$error->{pos}};
127 $message =~ s/; see.*//; # remove the position from the message 251 $message =~ s/; see.*//; # remove the position from the message
128 $ans->{student_ans} = 252 $ans->{student_ans} =
129 protectHTML(substr($string,0,$s)) . 253 protectHTML(substr($string,0,$s)) .
130 '<SPAN CLASS="parsehilight">' . 254 '<SPAN CLASS="parsehilight">' .
131 protectHTML(substr($string,$s,$e-$s)) . 255 protectHTML(substr($string,$s,$e-$s)) .
132 '</SPAN>' . 256 '</SPAN>' .
133 protectHTML(substr($string,$e)); 257 protectHTML(substr($string,$e));
134 } 258 }
259 $self->cmp_Error($ans,$message);
260}
261
262#
263# Set the error message
264#
265sub cmp_Error {
266 my $self = shift; my $ans = shift;
267 return unless scalar(@_) > 0;
135 $ans->score(0); 268 $ans->score(0);
269 $ans->{ans_message} = $ans->{error_message} = join("\n",@_);
270}
271
272#
273# filled in by sub-classes
274#
275sub cmp_postprocess {}
276
277#
278# Check for unreduced reduced Unions and Sets
279#
280sub cmp_checkUnionReduce {
281 my $self = shift; my $student = shift; my $ans = shift; my $nth = shift || '';
282 return unless $ans->{studentsMustReduceUnions} &&
283 $ans->{showUnionReduceWarnings} &&
284 !$ans->{isPreview} && !Value::isFormula($student);
285 if ($student->type eq 'Union' && $student->length >= 2) {
286 my $reduced = $student->reduce;
287 return "Your$nth union can be written without overlaps"
288 unless $reduced->type eq 'Union' && $reduced->length == $student->length;
289 my @R = $reduced->sort->value;
290 my @S = $student->sort->value;
291 foreach my $i (0..$#R) {
292 return "Your$nth union can be written without overlaps"
293 unless $R[$i] == $S[$i] && $R[$i]->length == $S[$i]->length;
294 }
295 } elsif ($student->type eq 'Set' && $student->length >= 2) {
296 return "Your$nth set should have no repeated elements"
297 unless $student->reduce->length == $student->length;
298 }
299 return;
300}
301
302#
303# create answer rules of various types
304#
305sub ans_rule {shift; pgCall('ans_rule',@_)}
306sub named_ans_rule {shift; pgCall('NAMED_ANS_RULE',@_)}
307sub named_ans_rule_extension {shift; pgCall('NAMED_ANS_RULE_EXTENSION',@_)}
308sub ans_array {shift->ans_rule(@_)};
309sub named_ans_array {shift->named_ans_rule(@_)};
310sub named_ans_array_extension {shift->named_ans_rule_extension(@_)};
311
312sub pgCall {my $call = shift; &{WeBWorK::PG::Translator::PG_restricted_eval('\&'.$call)}(@_)}
313sub pgRef {WeBWorK::PG::Translator::PG_restricted_eval('\&'.shift)}
314
315our $answerPrefix = "MaTrIx";
316
317#
318# Lay out a matrix of answer rules
319#
320sub ans_matrix {
321 my $self = shift;
322 my ($extend,$name,$rows,$cols,$size,$open,$close,$sep) = @_;
323 my $named_extension = pgRef('NAMED_ANS_RULE_EXTENSION');
324 my $new_name = pgRef('RECORD_FORM_LABEL');
325 my $HTML = ""; my $ename = $name;
326 if ($name eq '') {
327 my $n = pgCall('inc_ans_rule_count');
328 $name = pgCall('NEW_ANS_NAME',$n);
329 $ename = $answerPrefix.$n;
330 }
331 $self->{ans_name} = $ename;
332 $self->{ans_rows} = $rows;
333 $self->{ans_cols} = $cols;
334 my @array = ();
335 foreach my $i (0..$rows-1) {
336 my @row = ();
337 foreach my $j (0..$cols-1) {
338 if ($i == 0 && $j == 0) {
339 if ($extend) {push(@row,&$named_extension(&$new_name($name),$size))}
340 else {push(@row,pgCall('NAMED_ANS_RULE',$name,$size))}
341 } else {
342 push(@row,&$named_extension(&$new_name(ANS_NAME($ename,$i,$j)),$size));
343 }
344 }
345 push(@array,[@row]);
346 }
347 $self->format_matrix([@array],open=>$open,close=>$close,sep=>$sep);
348}
349
350sub ANS_NAME {
351 my ($name,$i,$j) = @_;
352 $name.'_'.$i.'_'.$j;
353}
354
355
356#
357# Lay out an arbitrary matrix
358#
359sub format_matrix {
360 my $self = shift;
361 my $displayMode = $self->getPG('$displayMode');
362 return $self->format_matrix_tex(@_) if ($displayMode eq 'TeX');
363 return $self->format_matrix_HTML(@_);
364}
365
366sub format_matrix_tex {
367 my $self = shift; my $array = shift;
368 my %options = (open=>'.',close=>'.',sep=>'',@_);
369 $self->{format_options} = [%options] unless $self->{format_options};
370 my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
371 my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
372 my $tex = "";
373 $open = '\\'.$open if $open =~ m/[{}]/; $close = '\\'.$close if $close =~ m/[{}]/;
374 $tex .= '\(\left'.$open;
375 $tex .= '\setlength{\arraycolsep}{2pt}', $sep = '\,'.$sep if $sep;
376 $tex .= '\begin{array}{'.('c'x$cols).'}';
377 foreach my $i (0..$rows-1) {$tex .= join($sep.'&',@{$array->[$i]}).'\cr'."\n"}
378 $tex .= '\end{array}\right'.$close.'\)';
379 return $tex;
380}
381
382sub format_matrix_HTML {
383 my $self = shift; my $array = shift;
384 my %options = (open=>'',close=>'',sep=>'',tth_delims=>0,@_);
385 $self->{format_options} = [%options] unless $self->{format_options};
386 my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
387 my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
388 my $HTML = "";
389 if ($sep) {$sep = '</TD><TD STYLE="padding: 0px 1px">'.$sep.'</TD><TD>'}
390 else {$sep = '</TD><TD WIDTH="8px"></TD><TD>'}
391 foreach my $i (0..$rows-1) {
392 $HTML .= '<TR><TD HEIGHT="6px"></TD></TR>' if $i;
393 $HTML .= '<TR ALIGN="MIDDLE"><TD>'.join($sep,EVALUATE(@{$array->[$i]})).'</TD></TR>'."\n";
394 }
395 $open = $self->format_delimiter($open,$rows,$options{tth_delims});
396 $close = $self->format_delimiter($close,$rows,$options{tth_delims});
397 if ($open ne '' || $close ne '') {
398 $HTML = '<TR ALIGN="MIDDLE">'
399 . '<TD>'.$open.'</TD>'
400 . '<TD WIDTH="2"></TD>'
401 . '<TD><TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout">'
402 . $HTML
403 . '</TABLE></TD>'
404 . '<TD WIDTH="4"></TD>'
405 . '<TD>'.$close.'</TD>'
406 . '</TR>'."\n";
407 }
408 return '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout"'
409 . ' STYLE="display:inline;vertical-align:-'.(1.1*$rows-.6).'em">'
410 . $HTML
411 . '</TABLE>';
412}
413
414sub EVALUATE {map {(Value::isFormula($_) && $_->isConstant? $_->eval: $_)} @_}
415
416sub VERBATIM {
417 my $string = shift;
418 my $displayMode = Value->getPG('$displayMode');
419 $string = '\end{verbatim}'.$string.'\begin{verbatim}' if $displayMode eq 'TeX';
420 return $string;
421}
422
423#
424# Create a tall delimiter to match the line height
425#
426sub format_delimiter {
427 my $self = shift; my $delim = shift; my $rows = shift; my $tth = shift;
428 return '' if $delim eq '' || $delim eq '.';
429 my $displayMode = $self->getPG('$displayMode');
430 return $self->format_delimiter_tth($delim,$rows,$tth)
431 if $tth || $displayMode eq 'HTML_tth' || $displayMode !~ m/^HTML_/;
432 my $rule = '\vrule width 0pt height '.(.8*$rows).'em depth 0pt';
433 $rule = '\rule 0pt '.(.8*$rows).'em 0pt' if $displayMode eq 'HTML_jsMath';
434 $delim = '\\'.$delim if $delim eq '{' || $delim eq '}';
435 return '\(\left'.$delim.$rule.'\right.\)';
436}
437
438#
439# Data for tth delimiters [top,mid,bot,rep]
440#
441my %tth_delim = (
442 '[' => ['&#xF8EE;','','&#xF8F0;','&#xF8EF;'],
443 ']' => ['&#xF8F9;','','&#xF8FB;','&#xF8FA;'],
444 '(' => ['&#xF8EB;','','&#xF8ED;','&#xF8EC;'],
445 ')' => ['&#xF8F6;','','&#xF8F8;','&#xF8F7;'],
446 '{' => ['&#xF8F1;','&#xF8F2;','&#xF8F3;','&#xF8F4;'],
447 '}' => ['&#xF8FC;','&#xF8FD;','&#xF8FE;','&#xF8F4;'],
448 '|' => ['|','','|','|'],
449 '<' => ['&lt;'],
450 '>' => ['&gt;'],
451 '\lgroup' => ['&#xF8F1;','','&#xF8F3;','&#xF8F4;'],
452 '\rgroup' => ['&#xF8FC;','','&#xF8FE;','&#xF8F4;'],
453);
454
455#
456# Make delimiters as stacks of characters
457#
458sub format_delimiter_tth {
459 my $self = shift;
460 my $delim = shift; my $rows = shift; my $tth = shift;
461 return '' if $delim eq '' || !defined($tth_delim{$delim});
462 my $c = $delim; $delim = $tth_delim{$delim};
463 $c = $delim->[0] if scalar(@{$delim}) == 1;
464 my $size = ($tth? "": "font-size:175%; ");
465 return '<SPAN STYLE="'.$size.'margin:0px 2px">'.$c.'</SPAN>'
466 if $rows == 1 || scalar(@{$delim}) == 1;
467 my $HTML = "";
468 if ($delim->[1] eq '') {
469 $HTML = join('<BR>',$delim->[0],($delim->[3])x(2*($rows-1)),$delim->[2]);
470 } else {
471 $HTML = join('<BR>',$delim->[0],($delim->[3])x($rows-1),
472 $delim->[1],($delim->[3])x($rows-1),
473 $delim->[2]);
474 }
475 return '<DIV STYLE="line-height:90%; margin: 0px 2px">'.$HTML.'</DIV>';
476}
477
478
479#
480# Look up the values of the answer array entries, and check them
481# for syntax and other errors. Build the student answer
482# based on these, and keep track of error messages.
483#
484
485my @ans_cmp_defaults = (showCoodinateHints => 0, checker => sub {0});
486
487sub ans_collect {
488 my $self = shift; my $ans = shift;
489 my $inputs = $self->getPG('$inputs_ref');
490 my $blank = ($self->getPG('$displayMode') eq 'TeX') ? '\_\_' : '__';
491 my ($rows,$cols) = ($self->{ans_rows},$self->{ans_cols});
492 my @array = (); my $data = [$self->value]; my $errors = []; my $OK = 1;
493 if ($self->{ColumnVector}) {foreach my $x (@{$data}) {$x = [$x]}}
494 $data = [$data] unless ref($data->[0]) eq 'ARRAY';
495 foreach my $i (0..$rows-1) {
496 my @row = (); my $entry;
497 foreach my $j (0..$cols-1) {
498 if ($i || $j) {
499 $entry = $inputs->{ANS_NAME($self->{ans_name},$i,$j)};
500 } else {
501 $entry = $ans->{original_student_ans};
502 $ans->{student_formula} = $ans->{student_value} = undef unless $entry =~ m/\S/;
503 }
504 my $result = $data->[$i][$j]->cmp(@ans_cmp_defaults)->evaluate($entry);
505 $OK &= entryCheck($result,$blank);
506 push(@row,$result->{student_formula});
507 entryMessage($result->{ans_message},$errors,$i,$j,$rows,$cols);
508 }
509 push(@array,[@row]);
510 }
511 $ans->{student_formula} = [@array];
136 $ans->{ans_message} = $ans->{error_message} = $message; 512 $ans->{ans_message} = $ans->{error_message} = "";
513 if (scalar(@{$errors})) {
514 $ans->{ans_message} = $ans->{error_message} =
515 '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout">'.
516 join('<TR><TD HEIGHT="4"></TD></TR>',@{$errors}).
517 '</TABLE>';
518 $OK = 0;
519 }
520 return $OK;
521}
522
523sub entryMessage {
524 my $message = shift; return unless $message;
525 my ($errors,$i,$j,$rows,$cols) = @_; $i++; $j++;
526 my $title;
527 if ($rows == 1) {$title = "In entry $j"}
528 elsif ($cols == 1) {$title = "In entry $i"}
529 else {$title = "In entry ($i,$j)"}
530 push(@{$errors},"<TR VALIGN=\"TOP\"><TD NOWRAP STYLE=\"text-align:right; border:0px\"><I>$title</I>:&nbsp;</TD>".
531 "<TD STYLE=\"text-align:left; border:0px\">$message</TD></TR>");
532}
533
534sub entryCheck {
535 my $ans = shift; my $blank = shift;
536 return 1 if defined($ans->{student_value});
537 if (!defined($ans->{student_formula})) {
538 $ans->{student_formula} = $ans->{student_ans};
539 $ans->{student_formula} = $blank unless $ans->{student_formula};
540 }
541 return 0
542}
543
544
545#
546# Get and Set values in context
547#
548sub contextSet {
549 my $context = shift; my %set = (@_);
550 my $flags = $context->{flags}; my $get = {};
551 foreach my $id (keys %set) {$get->{$id} = $flags->{$id}; $flags->{$id} = $set{$id}}
552 return $get;
137} 553}
138 554
139# 555#
140# Quote HTML characters 556# Quote HTML characters
141# 557#
142sub protectHTML { 558sub protectHTML {
143 my $string = shift; 559 my $string = shift;
560 return unless defined($string);
561 return $string if eval ('$main::displayMode') eq 'TeX';
144 $string =~ s/&/\&amp;/g; 562 $string =~ s/&/\&amp;/g;
145 $string =~ s/</\&lt;/g; 563 $string =~ s/</\&lt;/g;
146 $string =~ s/>/\&gt;/g; 564 $string =~ s/>/\&gt;/g;
147 $string; 565 $string;
148} 566}
149 567
150# 568#
569# names for numbers
570#
571sub NameForNumber {
572 my $self = shift; my $n = shift;
573 my $name = ('zeroth','first','second','third','fourth','fifth',
574 'sixth','seventh','eighth','ninth','tenth')[$n];
575 $name = "$n-th" if ($n > 10);
576 return $name;
577}
578
579#
151# Get a value from the safe compartment 580# Get a value from the safe compartment
152# 581#
153sub getPG { 582sub getPG {
154 my $self = shift; 583 my $self = shift;
155 (WeBWorK::PG::Translator::PG_restricted_eval(shift))[0]; 584# (WeBWorK::PG::Translator::PG_restricted_eval(shift))[0];
585 eval ('package main; '.shift); # faster
156} 586}
157 587
158############################################################# 588#############################################################
159############################################################# 589#############################################################
160 590
161package Value::Real; 591package Value::Real;
162 592
163our $cmp_defaults = { 593sub cmp_defaults {(
164 %{$Value::cmp_defaults}, 594 shift->SUPER::cmp_defaults(@_),
165 ignoreStrings => 1, 595 ignoreInfinity => 1,
166}; 596)}
167 597
168sub typeMatch { 598sub typeMatch {
169 my $self = shift; my $other = shift; my $ans = shift; 599 my $self = shift; my $other = shift; my $ans = shift;
170 return 1 unless ref($other); 600 return 1 unless ref($other);
171 if ($other->type eq 'String' && $ans->{ignoreStrings}) { 601 return 0 if Value::isFormula($other);
172 $ans->{showEqualErrors} = 0; 602 return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity};
173 return 1;
174 }
175 $self->type eq $other->type; 603 $self->type eq $other->type;
176} 604}
177 605
178############################################################# 606#############################################################
179 607
180package Value::Point; 608package Value::Infinity;
181 609
182our $cmp_defaults = { 610sub cmp_class {'a Number'};
183 %{$Value::cmp_defaults},
184 showDimensionWarnings => 1,
185};
186 611
187sub typeMatch { 612sub typeMatch {
188 my $self = shift; my $other = shift; my $ans = shift; 613 my $self = shift; my $other = shift; my $ans = shift;
189 return 0 unless ref($other); 614 return 1 unless ref($other);
190 return 0 unless $other->type eq 'Point'; 615 return 0 if Value::isFormula($other);
191 if (!$ans->{isPreview} && $ans->{showDimensionWarnings} && 616 return 1 if $other->type eq 'Number';
192 $self->length != $other->length) { 617 $self->type eq $other->type;
193 $ans->{ans_message} = $ans->{error_message} = "The dimension is incorrect";
194 return 0;
195 }
196 return 1;
197} 618}
198 619
199############################################################# 620#############################################################
200 621
622package Value::String;
623
624sub cmp_defaults {(
625 Value::Real->cmp_defaults(@_),
626 typeMatch => 'Value::Real',
627)}
628
629sub cmp_class {
630 my $self = shift; my $ans = shift; my $typeMatch = $ans->{typeMatch};
631 return 'a Word' if !Value::isValue($typeMatch) || $typeMatch->class eq 'String';
632 return $typeMatch->cmp_class;
633};
634
635sub typeMatch {
636 my $self = shift; my $other = shift; my $ans = shift;
637# return 0 if ref($other) && Value::isFormula($other);
638 my $typeMatch = $ans->{typeMatch};
639 return &$typeMatch($other,$ans) if ref($typeMatch) eq 'CODE';
640 return 1 if !Value::isValue($typeMatch) || $typeMatch->class eq 'String' ||
641 $self->type eq $other->type;
642 return $typeMatch->typeMatch($other,$ans);
643}
644
645#
646# Remove the blank-check prefilter when the string is empty,
647# and add a filter that removes leading and trailing whitespace.
648#
649sub cmp {
650 my $self = shift;
651 my $cmp = $self->SUPER::cmp(@_);
652 if ($self->value =~ m/^\s*$/) {
653 $cmp->install_pre_filter('erase');
654 $cmp->install_pre_filter(sub {
655 my $ans = shift;
656 $ans->{student_ans} =~ s/^\s+//g;
657 $ans->{student_ans} =~ s/\s+$//g;
658 return $ans;
659 });
660 }
661 return $cmp;
662}
663
664#############################################################
665
666package Value::Point;
667
668sub cmp_defaults {(
669 shift->SUPER::cmp_defaults(@_),
670 showDimensionHints => 1,
671 showCoordinateHints => 1,
672)}
673
674sub typeMatch {
675 my $self = shift; my $other = shift; my $ans = shift;
676 return ref($other) && $other->type eq 'Point' && $other->class ne 'Formula';
677}
678
679#
680# Check for dimension mismatch and incorrect coordinates
681#
682sub cmp_postprocess {
683 my $self = shift; my $ans = shift;
684 return unless $ans->{score} == 0 && !$ans->{isPreview};
685 my $student = $ans->{student_value};
686 return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
687 if ($ans->{showDimensionHints} && $self->length != $student->length) {
688 $self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
689 }
690 if ($ans->{showCoordinateHints}) {
691 my @errors;
692 foreach my $i (1..$self->length) {
693 push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
694 if ($self->{data}[$i-1] != $student->{data}[$i-1]);
695 }
696 $self->cmp_Error($ans,@errors); return;
697 }
698}
699
700sub correct_ans {
701 my $self = shift;
702 return $self->SUPER::correct_ans unless $self->{ans_name};
703 Value::VERBATIM($self->format_matrix([[@{$self->{data}}]],@{$self->{format_options}},tth_delims=>1));
704}
705
706sub ANS_MATRIX {
707 my $self = shift;
708 my $extend = shift; my $name = shift;
709 my $size = shift || 5;
710 my $def = ($self->{context} || $$Value::context)->lists->get('Point');
711 my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
712 $self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,',');
713}
714
715sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
716sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
717sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
718
719#############################################################
720
201package Value::Vector; 721package Value::Vector;
202 722
203our $cmp_defaults = { 723sub cmp_defaults {(
204 %{$Value::cmp_defaults}, 724 shift->SUPER::cmp_defaults(@_),
205 showDimensionWarnings => 1, 725 showDimensionHints => 1,
726 showCoordinateHints => 1,
206 promotePoints => 0, 727 promotePoints => 0,
207 parallel => 0, 728 parallel => 0,
208 sameDirection => 0, 729 sameDirection => 0,
209 cmp_postprocess => 'cmp_postprocess', 730)}
210};
211 731
212sub typeMatch { 732sub typeMatch {
213 my $self = shift; my $other = shift; my $ans = shift; 733 my $self = shift; my $other = shift; my $ans = shift;
214 return 0 unless ref($other); 734 return 0 unless ref($other) && $other->class ne 'Formula';
215 return 0 unless $other->type eq 'Vector' || 735 return $other->type eq 'Vector' ||
216 ($ans->{promotePoints} && $other->type eq 'Point'); 736 ($ans->{promotePoints} && $other->type eq 'Point');
217 if (!$ans->{isPreview} && $ans->{showDimensionWarnings} &&
218 $self->length != $other->length) {
219 $ans->{ans_message} = $ans->{error_message} = "The dimension is incorrect";
220 return 0;
221 }
222 return 1;
223} 737}
224 738
225# 739#
226# Handle check for parallel vectors 740# check for dimension mismatch
741# for parallel vectors, and
742# for incorrect coordinates
227# 743#
228sub cmp_postprocess { 744sub cmp_postprocess {
229 my $self = shift; my $ans = shift; 745 my $self = shift; my $ans = shift;
230 return unless $ans->{parallel} && $ans->{score} == 0; 746 return unless $ans->{score} == 0 && !$ans->{isPreview};
231 $ans->score(1) if $self->isParallel($ans->{student_value},$ans->{sameDirection}); 747 my $student = $ans->{student_value};
748 return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
749 if ($ans->{showDimensionHints} && $self->length != $student->length) {
750 $self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
751 }
752 if ($ans->{parallel} && $student->class ne 'String' &&
753 $self->isParallel($student,$ans->{sameDirection})) {
754 $ans->score(1); return;
755 }
756 if ($ans->{showCoordinateHints} && !$ans->{parallel}) {
757 my @errors;
758 foreach my $i (1..$self->length) {
759 push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
760 if ($self->{data}[$i-1] != $student->{data}[$i-1]);
761 }
762 $self->cmp_Error($ans,@errors); return;
763 }
232} 764}
233 765
766sub correct_ans {
767 my $self = shift;
768 return $self->SUPER::correct_ans unless $self->{ans_name};
769 return Value::VERBATIM($self->format_matrix([[$self->value]],@{$self->{format_options}},tth_delims=>1))
770 unless $self->{ColumnVector};
771 my @array = (); foreach my $x ($self->value) {push(@array,[$x])}
772 return Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
773}
774
775sub ANS_MATRIX {
776 my $self = shift;
777 my $extend = shift; my $name = shift;
778 my $size = shift || 5; my ($def,$open,$close);
779 $def = ($self->{context} || $$Value::context)->lists->get('Matrix');
780 $open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close};
781 return $self->ans_matrix($extend,$name,$self->length,1,$size,$open,$close)
782 if ($self->{ColumnVector});
783 $def = ($self->{context} || $$Value::context)->lists->get('Vector');
784 $open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close};
785 $self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,',');
786}
787
788sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
789sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
790sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
234 791
235 792
236############################################################# 793#############################################################
237 794
238package Value::Matrix; 795package Value::Matrix;
239 796
240our $cmp_defaults = { 797sub cmp_defaults {(
241 %{$Value::cmp_defaults}, 798 shift->SUPER::cmp_defaults(@_),
242 showDimensionWarnings => 1, 799 showDimensionHints => 1,
243}; 800 showEqualErrors => 0,
801)}
244 802
245sub typeMatch { 803sub typeMatch {
246 my $self = shift; my $other = shift; my $ans = shift; 804 my $self = shift; my $other = shift; my $ans = shift;
247 return 0 unless ref($other); 805 return 0 unless ref($other) && $other->class ne 'Formula';
248 $other = $self->make($other->{data}) if $other->class eq 'Point';
249 return 0 unless $other->type eq 'Matrix'; 806 return $other->type eq 'Matrix' ||
250 return 1 unless $ans->{showDimensionWarnings}; 807 ($other->type =~ m/^(Point|list)$/ &&
808 $other->{open}.$other->{close} eq $self->{open}.$self->{close});
809}
810
811sub cmp_postprocess {
812 my $self = shift; my $ans = shift;
813 return unless $ans->{score} == 0 &&
814 !$ans->{isPreview} && $ans->{showDimensionHints};
815 my $student = $ans->{student_value};
816 return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
251 my @d1 = $self->dimensions; my @d2 = $other->dimensions; 817 my @d1 = $self->dimensions; my @d2 = $student->dimensions;
252 if (scalar(@d1) != scalar(@d2)) { 818 if (scalar(@d1) != scalar(@d2)) {
253 $ans->{ans_message} = $ans->{error_message} =
254 "Matrix dimension is not correct"; 819 $self->cmp_Error($ans,"Matrix dimension is not correct");
255 return 0; 820 return;
256 } else { 821 } else {
257 foreach my $i (0..scalar(@d1)-1) { 822 foreach my $i (0..scalar(@d1)-1) {
258 if ($d1[$i] != $d2[$i]) { 823 if ($d1[$i] != $d2[$i]) {
259 $ans->{ans_message} = $ans->{error_message} = 824 $self->cmp_Error($ans,"Matrix dimension is not correct");
260 "Matrix dimension is not correct";
261 return 0; 825 return;
262 } 826 }
263 } 827 }
264 } 828 }
265 return 1;
266} 829}
830
831sub correct_ans {
832 my $self = shift;
833 return $self->SUPER::correct_ans unless $self->{ans_name};
834 my @array = $self->value; @array = ([@array]) if $self->isRow;
835 Value::VERBATIM($self->format_matrix([$self->value],@{$self->{format_options}},tth_delims=>1));
836}
837
838sub ANS_MATRIX {
839 my $self = shift;
840 my $extend = shift; my $name = shift;
841 my $size = shift || 5;
842 my $def = ($self->{context} || $$Value::context)->lists->get('Matrix');
843 my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
844 my @d = $self->dimensions;
845 Value::Error("Can't create ans_array for %d-dimensional matrix",scalar(@d))
846 if (scalar(@d) > 2);
847 @d = (1,@d) if (scalar(@d) == 1);
848 $self->ans_matrix($extend,$name,@d,$size,$open,$close,'');
849}
850
851sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
852sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
853sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
267 854
268############################################################# 855#############################################################
269 856
270package Value::Interval; 857package Value::Interval;
271 858
272## @@@ report interval-type mismatch? @@@ 859sub cmp_defaults {(
860 shift->SUPER::cmp_defaults(@_),
861 showEndpointHints => 1,
862 showEndTypeHints => 1,
863 requireParenMatch => 1,
864)}
273 865
274sub typeMatch { 866sub typeMatch {
275 my $self = shift; my $other = shift; 867 my $self = shift; my $other = shift;
276 return 0 unless ref($other); 868 return 0 if !Value::isValue($other) || $other->isFormula;
869 return $other->canBeInUnion;
870}
871
872#
873# Check for unreduced sets and unions
874#
875sub cmp_compare {
876 my $self = shift; my $student = shift; my $ans = shift;
877 my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
878 if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return}
879 $self->SUPER::cmp_compare($student,$ans,@_);
880}
881
882#
883# Check for wrong enpoints and wrong type of endpoints
884#
885sub cmp_postprocess {
886 my $self = shift; my $ans = shift;
887 return unless $ans->{score} == 0 && !$ans->{isPreview};
888 my $other = $ans->{student_value};
889 return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String');
890 return unless $other->class eq 'Interval';
891 my @errors;
892 if ($ans->{showEndpointHints}) {
893 push(@errors,"Your left endpoint is incorrect")
894 if ($self->{data}[0] != $other->{data}[0]);
895 push(@errors,"Your right endpoint is incorrect")
896 if ($self->{data}[1] != $other->{data}[1]);
897 }
898 if (scalar(@errors) == 0 && $ans->{showEndTypeHints} && $ans->{requireParenMatch}) {
899 push(@errors,"The type of interval is incorrect")
900 if ($self->{open}.$self->{close} ne $other->{open}.$other->{close});
901 }
902 $self->cmp_Error($ans,@errors);
903}
904
905#############################################################
906
907package Value::Set;
908
909sub typeMatch {
910 my $self = shift; my $other = shift;
911 return 0 if !Value::isValue($other) || $other->isFormula;
912 return $other->canBeInUnion;
913}
914
915#
916# Use the List checker for sets, in order to get
917# partial credit. Set the various types for error
918# messages.
919#
920sub cmp_defaults {(
921 Value::List::cmp_defaults(@_),
922 typeMatch => 'Value::Real',
923 list_type => 'a set',
924 entry_type => 'a number',
925 removeParens => 0,
926 showParenHints => 1,
927)}
928
929#
930# Use the list checker if the student answer is a set
931# otherwise use the standard compare (to get better
932# error messages).
933#
934sub cmp_equal {
935 my ($self,$ans) = @_;
936 return Value::List::cmp_equal(@_) if $ans->{student_value}->type eq 'Set';
937 $self->SUPER::cmp_equal($ans);
938}
939
940#
941# Check for unreduced sets and unions
942#
943sub cmp_compare {
944 my $self = shift; my $student = shift; my $ans = shift;
945 my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
946 if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return}
947 $self->SUPER::cmp_compare($student,$ans,@_);
948}
949
950#############################################################
951
952package Value::Union;
953
954sub typeMatch {
955 my $self = shift; my $other = shift;
956 return 0 unless ref($other) && $other->class ne 'Formula';
277 return $other->length == 2 && 957 return $other->length == 2 &&
278 ($other->{open} eq '(' || $other->{open} eq '[') && 958 ($other->{open} eq '(' || $other->{open} eq '[') &&
279 ($other->{close} eq ')' || $other->{close} eq ']') 959 ($other->{close} eq ')' || $other->{close} eq ']')
280 if $other->type =~ m/^(Point|List)$/; 960 if $other->type =~ m/^(Point|List)$/;
281 $other->type =~ m/^(Interval|Union)$/; 961 $other->isSetOfReals;
282} 962}
283 963
284############################################################# 964#
285 965# Use the List checker for unions, in order to get
286package Value::Union; 966# partial credit. Set the various types for error
287 967# messages.
288sub typeMatch { 968#
289 my $self = shift; my $other = shift;
290 return 0 unless ref($other);
291 return $other->length == 2 &&
292 ($other->{open} eq '(' || $other->{open} eq '[') &&
293 ($other->{close} eq ')' || $other->{close} eq ']')
294 if $other->type =~ m/^(Point|List)$/;
295 $other->type =~ m/^(Interval|Union)/;
296}
297
298#############################################################
299
300package Value::List;
301
302our $cmp_defaults = { 969sub cmp_defaults {(
303 %{$Value::cmp_defaults}, 970 Value::List::cmp_defaults(@_),
304 showHints => undef, 971 typeMatch => 'Value::Interval',
305 showLengthHints => undef, 972 list_type => 'an interval, set or union',
306# partialCredit => undef, 973 short_type => 'a union',
307 partialCredit => 0, # only allow this once WW can deal with partial credit 974 entry_type => 'an interval or set',
308 ordered => 0, 975)}
309 entry_type => undef,
310 list_type => undef,
311 typeMatch => undef,
312 allowParens => 0,
313};
314
315sub typeMatch {1}
316 976
317sub cmp_equal { 977sub cmp_equal {
318 my $self = shift; my $ans = shift; 978 my $self = shift; my $ans = shift;
979 my $error = $self->cmp_checkUnionReduce($ans->{student_value},$ans);
980 if ($error) {$self->cmp_Error($ans,$error); return}
981 Value::List::cmp_equal($self,$ans);
982}
983
984#
985# Check for unreduced sets and unions
986#
987sub cmp_compare {
988 my $self = shift; my $student = shift; my $ans = shift;
989 my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
990 if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return}
991 $self->SUPER::cmp_compare($student,$ans,@_);
992}
993
994#############################################################
995
996package Value::List;
997
998sub cmp_defaults {
999 my $self = shift;
1000 my %options = (@_);
1001 my $element = Value::makeValue($self->{data}[0]);
1002 $element = Value::Formula->new($element) unless Value::isValue($element);
1003 return (
1004 Value::Real->cmp_defaults(@_),
1005 showHints => undef,
1006 showLengthHints => undef,
1007 showParenHints => undef,
1008 partialCredit => undef,
1009 ordered => 0,
1010 entry_type => undef,
1011 list_type => undef,
1012 typeMatch => $element,
1013 firstElement => $element,
1014 extra => undef,
1015 requireParenMatch => 1,
1016 removeParens => 1,
1017 implicitList => 1,
1018 );
1019}
1020
1021#
1022# Match anything but formulas
1023#
1024sub typeMatch {return !ref($other) || $other->class ne 'Formula'}
1025
1026#
1027# Handle removal of outermost parens in correct answer.
1028#
1029sub cmp {
1030 my $self = shift;
1031 my %params = @_;
1032 my $cmp = $self->SUPER::cmp(@_);
1033 if ($cmp->{rh_ans}{removeParens}) {
1034 $self->{open} = $self->{close} = '';
1035 $cmp->ans_hash(correct_ans => $self->stringify)
1036 unless defined($self->{correct_ans}) || defined($params{correct_ans});
1037 }
1038 return $cmp;
1039}
1040
1041sub cmp_equal {
1042 my $self = shift; my $ans = shift;
319 my $showPartialCorrectAnswers = $self->getPG('$showPartialCorrectAnswers'); 1043 $ans->{showPartialCorrectAnswers} = $self->getPG('$showPartialCorrectAnswers');
320 my $showTypeWarnings = $ans->{showTypeWarnings}; 1044
321 my $showHints = getOption($ans->{showHints},$showPartialCorrectAnswers); 1045 #
1046 # get the paramaters
1047 #
1048 my $showHints = getOption($ans,'showHints');
322 my $showLengthHints = getOption($ans->{showLengthHints},$showPartialCorrectAnswers); 1049 my $showLengthHints = getOption($ans,'showLengthHints');
323 my $partialCredit = getOption($ans->{partialCredit},$showPartialCorrectAnswers); 1050 my $showParenHints = getOption($ans,'showParenHints');
324 my $ordered = $ans->{ordered}; my $allowParens = $ans->{allowParens}; 1051 my $partialCredit = getOption($ans,'partialCredit');
325 my $typeMatch = $ans->{typeMatch} || $self->{data}[0]; 1052 my $requireParenMatch = $ans->{requireParenMatch};
326 $typeMatch = Value::Real->make($typeMatch) 1053 my $implicitList = $ans->{implicitList};
327 if !ref($typeMatch) && Value::matchNumber($typeMatch); 1054 my $typeMatch = $ans->{typeMatch};
328 my $value = getOption($ans->{entry_type}, 1055 my $value = $ans->{entry_type};
1056 my $ltype = $ans->{list_type} || lc($self->type);
1057 my $stype = $ans->{short_type} || $ltype;
1058
329 Value::isValue($typeMatch)? lc($typeMatch->showClass): 'value'); 1059 $value = (Value::isValue($typeMatch)? lc($typeMatch->cmp_class): 'a value')
330 $value =~ s/^an? //; $value =~ s/(real|complex) //; 1060 unless defined($value);
331 my $ltype = getOption($ans->{list_type},lc($self->type)); 1061 $value =~ s/(real|complex) //; $ans->{cmp_class} = $value;
1062 $value =~ s/^an? //; $value = 'formula' if $value =~ m/formula/;
1063 $ltype =~ s/^an? //; $stype =~ s/^an? //;
332 $showTypeWarnings = $showHints = $showLengthHints = 0 if $ans->{isPreview}; 1064 $showHints = $showLengthHints = 0 if $ans->{isPreview};
333 1065
334 my $student = $ans->{student_value}; 1066 #
1067 # Get the lists of correct and student answers
1068 # (split formulas that return lists or unions)
1069 #
1070 my @correct = (); my ($cOpen,$cClose);
1071 if ($self->class ne 'Formula') {
335 my @correct = $self->value; 1072 @correct = $self->value;
336 my @student = 1073 $cOpen = $ans->{correct_value}{open}; $cClose = $ans->{correct_value}{close};
337 $student->class eq 'List' && 1074 } else {
338 ($allowParens || (!$student->{open} && !$student->{close})) ? 1075 @correct = Value::List->splitFormula($self,$ans);
339 @{$student->{data}} : ($student); 1076 $cOpen = $self->{tree}{open}; $cClose = $self->{tree}{close};
1077 }
1078 my $student = $ans->{student_value}; my @student = ($student);
1079 my ($sOpen,$sClose) = ('','');
1080 if (Value::isFormula($student) && $student->type eq $self->type) {
1081 if ($implicitList && $student->{tree}{open} ne '') {
1082 @student = ($student);
1083 } else {
1084 @student = Value::List->splitFormula($student,$ans);
1085 $sOpen = $student->{tree}{open}; $sClose = $student->{tree}{close};
1086 }
1087 } elsif ($student->class ne 'Formula' && $student->class eq $self->type) {
1088 if ($implicitList && $student->{open} ne '') {
1089 @student = ($student);
1090 } else {
1091 @student = @{$student->{data}};
1092 $sOpen = $student->{open}; $sClose = $student->{close};
1093 }
1094 }
1095 return if $ans->{split_error};
1096 #
1097 # Check for parenthesis match
1098 #
1099 if ($requireParenMatch && ($sOpen ne $cOpen || $sClose ne $cClose)) {
1100 if ($showParenHints && !($ans->{ignoreStrings} && $student->type eq 'String')) {
1101 my $message = "The parentheses for your $ltype ";
1102 if (($cOpen || $cClose) && ($sOpen || $sClose))
1103 {$message .= "are of the wrong type"}
1104 elsif ($sOpen || $sClose) {$message .= "should be removed"}
1105 else {$message .= "seem to be missing"}
1106 $self->cmp_Error($ans,$message) unless $ans->{isPreview};
1107 }
1108 return;
1109 }
340 1110
1111 #
1112 # Determine the maximum score
1113 #
341 my $maxscore = scalar(@correct); 1114 my $M = scalar(@correct);
342 my $m = scalar(@student); 1115 my $m = scalar(@student);
343 $maxscore = $m if ($m > $maxscore); 1116 my $maxscore = ($m > $M)? $m : $M;
1117
1118 #
1119 # Compare the two lists
1120 # (Handle errors in user-supplied functions)
1121 #
1122 my ($score,@errors);
1123 if (ref($ans->{list_checker}) eq 'CODE') {
1124 eval {($score,@errors) = &{$ans->{list_checker}}([@correct],[@student],$ans,$value)};
1125 if (!defined($score)) {
1126 die $@ if $@ ne '' && $self->{context}{error}{flag} == 0;
1127 $self->cmp_error($ans) if $self->{context}{error}{flag};
1128 }
1129 } else {
1130 ($score,@errors) = $self->cmp_list_compare([@correct],[@student],$ans,$value);
1131 }
1132 return unless defined($score);
1133
1134 #
1135 # Give hints about extra or missing answers
1136 #
1137 if ($showLengthHints) {
1138 $value =~ s/( or|,) /s$1 /g; # fix "interval or union"
1139 push(@errors,"There should be more ${value}s in your $stype")
1140 if ($score < $maxscore && $score == $m);
1141 push(@errors,"There should be fewer ${value}s in your $stype")
1142 if ($score < $maxscore && $score == $M && !$showHints);
1143 }
1144
1145 #
1146 # If all the entries are in error, don't give individual messages
1147 #
1148 if ($score == 0) {
1149 my $i = 0;
1150 while ($i <= $#errors) {
1151 if ($errors[$i++] =~ m/^Your .* is incorrect$/)
1152 {splice(@errors,--$i,1)}
1153 }
1154 }
1155
1156 #
1157 # Finalize the score
1158 #
1159 $score = 0 if ($score != $maxscore && !$partialCredit);
1160 $ans->score($score/$maxscore);
1161 push(@errors,"Score = $ans->{score}") if $ans->{debug};
1162 my $error = join("\n",@errors); $error =~ s!</DIV>\n!</DIV>!g;
1163 $ans->{error_message} = $ans->{ans_message} = $error;
1164}
1165
1166#
1167# Compare the contents of the list to see of they are equal
1168#
1169sub cmp_list_compare {
1170 my $self = shift;
1171 my $correct = shift; my $student = shift; my $ans = shift; my $value = shift;
1172 my @correct = @{$correct}; my @student = @{$student}; my $m = scalar(@student);
1173 my $ordered = $ans->{ordered};
1174 my $showTypeWarnings = $ans->{showTypeWarnings} && !$ans->{isPreview};
1175 my $typeMatch = $ans->{typeMatch};
1176 my $extra = $ans->{extra} ||
1177 (Value::isValue($typeMatch) ? $typeMatch: $ans->{firstElement}) ||
1178 "Value::List";
1179 my $showHints = getOption($ans,'showHints') && !$ans->{isPreview};
1180 my $error = $$Value::context->{error};
344 my $score = 0; my @errors; my $i = 0; 1181 my $score = 0; my @errors; my $i = 0;
345 1182
1183 #
1184 # Check for empty lists
1185 #
1186 if (scalar(@correct) == 0) {$ans->score($m == 0); return}
1187
1188 #
1189 # Loop through student answers looking for correct ones
1190 #
346 ENTRY: foreach my $entry (@student) { 1191 ENTRY: foreach my $entry (@student) {
347 $i++; 1192 $i++; $$Value::context->clearError;
348 $entry = Value::Real->make($entry) if !ref($entry) && Value::matchNumber($entry); 1193 $entry = Value::makeValue($entry);
349 $entry = Value::Formula->new($entry) if !Value::isValue($entry); 1194 $entry = Value::Formula->new($entry) if !Value::isValue($entry);
1195
1196 #
1197 # Some words differ if ther eis only one entry in the student's list
1198 #
1199 my $nth = ''; my $answer = 'answer';
1200 my $class = $ans->{list_type} || $ans->{cmp_class};
1201 if ($m > 1) {
1202 $nth = ' '.$self->NameForNumber($i);
1203 $class = $ans->{cmp_class};
1204 $answer = 'value';
1205 }
1206
1207 #
1208 # See if the entry matches the correct answer
1209 # and perform syntax checking if not
1210 #
350 if ($ordered) { 1211 if ($ordered) {
351 if (eval {shift(@correct) == $entry}) {$score++; next ENTRY} 1212 if (scalar(@correct)) {
1213 if (shift(@correct)->cmp_compare($entry,$ans,$nth,$value)) {$score++; next ENTRY}
1214 } else {
1215 # do syntax check
1216 if (ref($extra) eq 'CODE') {&$extra($entry,$ans,$nth,$value)}
1217 else {$extra->cmp_compare($entry,$ans,$nth,$value)}
1218 }
1219 if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
352 } else { 1220 } else {
353 foreach my $k (0..$#correct) { 1221 foreach my $k (0..$#correct) {
354 if (eval {$correct[$k] == $entry}) { 1222 if ($correct[$k]->cmp_compare($entry,$ans,$nth,$value)) {
355 splice(@correct,$k,1); 1223 splice(@correct,$k,1);
356 $score++; next ENTRY; 1224 $score++; next ENTRY;
357 } 1225 }
1226 if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
358 } 1227 }
1228 $$Value::context->clearError;
1229 # do syntax check
1230 if (ref($extra) eq 'CODE') {&$extra($entry,$ans,$nth,$value)}
1231 else {$extra->cmp_compare($entry,$ans,$nth,$value)}
1232 }
359 } 1233 #
1234 # Give messages about incorrect answers
1235 #
1236 my $match = (ref($typeMatch) eq 'CODE')? &$typeMatch($entry,$ans) :
1237 $typeMatch->typeMatch($entry,$ans);
360 if ($showTypeWarnings && defined($typeMatch) && 1238 if ($showTypeWarnings && !$match &&
361 !$typeMatch->typeMatch($entry,$ans)) { 1239 !($ans->{ignoreStrings} && $entry->class eq 'String')) {
362 push(@errors, 1240 push(@errors,"Your$nth $answer isn't ".lc($class).
363 "Your ".NameForNumber($i)." value isn't ".lc($typeMatch->showClass).
364 " (it looks like ".lc($entry->showClass).")"); 1241 " (it looks like ".lc($entry->showClass).")");
365 next ENTRY; 1242 } elsif ($error->{flag} && $ans->{showEqualErrors}) {
366 } 1243 my $message = $error->{message}; $message =~ s/\s+$//;
367 push(@errors,"Your ".NameForNumber($i)." $value is incorrect") 1244 if ($m > 1 && $error->{flag} != $CMP_WARNING) {
1245 push(@errors,"<SMALL>There is a problem with your$nth $value:</SMALL>",
1246 '<DIV STYLE="margin-left:1em">'.$message.'</DIV>');
1247 } else {push(@errors,$message)}
368 if $showHints && $m > 1; 1248 } elsif ($showHints && $m > 1) {
1249 push(@errors,"Your$nth $value is incorrect");
369 } 1250 }
370
371 if ($showLengthHints) {
372 $value =~ s/ or /s or /; # fix "interval or union"
373 push(@errors,"There should be more ${value}s in your $ltype")
374 if ($score == $m && scalar(@correct) > 0);
375 push(@errors,"There should be fewer ${value}s in your $ltype")
376 if ($score < $maxscore && $score == scalar($self->value));
377 } 1251 }
378 1252
379 $score = 0 if ($score != $maxscore && !$partialCredit); 1253 #
380 $ans->score($score/$maxscore); 1254 # Return the score and errors
381 push(@errors,"Score = $ans->{score}") if $ans->{debug}; 1255 #
382 $ans->{error_message} = $ans->{ans_message} = join("\n",@errors); 1256 return ($score,@errors);
383} 1257}
384 1258
385# 1259#
1260# Split a formula that is a list or union into a
1261# list of formulas (or Value objects).
1262#
1263sub splitFormula {
1264 my $self = shift; my $formula = shift; my $ans = shift;
1265 my @formula; my @entries;
1266 if ($formula->type eq 'Union') {@entries = $formula->{tree}->makeUnion}
1267 else {@entries = @{$formula->{tree}{coords}}}
1268 foreach my $entry (@entries) {
1269 my $v = Parser::Formula($entry);
1270 $v = Parser::Evaluate($v) if (defined($v) && $v->isConstant);
1271 push(@formula,$v);
1272 #
1273 # There shouldn't be an error evaluating the formula,
1274 # but you never know...
1275 #
1276 if (!defined($v)) {$ans->{split_error} = 1; $self->cmp_error; return}
1277 }
1278 return @formula;
1279}
1280
1281#
386# Return the value if it is defined, otherwise a default 1282# Return the value if it is defined, otherwise use a default
387# 1283#
388sub getOption { 1284sub getOption {
389 my $value = shift; my $default = shift; 1285 my $ans = shift; my $name = shift;
1286 my $value = $ans->{$name};
390 return $value if defined($value); 1287 return $value if defined($value);
391 return $default; 1288 return $ans->{showPartialCorrectAnswers};
392}
393
394#
395# names for numbers
396#
397sub NameForNumber {
398 my $n = shift;
399 my $name = ('zeroth','first','second','third','fourth','fifth',
400 'sixth','seventh','eighth','ninth','tenth')[$n];
401 $name = "$n-th" if ($n > 10);
402 return $name;
403} 1289}
404 1290
405############################################################# 1291#############################################################
406 1292
407package Value::Formula; 1293package Value::Formula;
408 1294
1295sub cmp_defaults {
1296 my $self = shift;
1297
1298 return (
1299 Value::Union::cmp_defaults($self,@_),
1300 typeMatch => Value::Formula->new("(1,2]"),
1301 showDomainErrors => 1,
1302 ) if $self->type eq 'Union';
1303
1304 my $type = $self->type;
1305 $type = ($self->isComplex)? 'Complex': 'Real' if $type eq 'Number';
1306 $type = 'Value::'.$type.'::';
1307
1308 return (
1309 &{$type.'cmp_defaults'}($self,@_),
1310 upToConstant => 0,
1311 showDomainErrors => 1,
1312 ) if defined(%$type) && $self->type ne 'List';
1313
1314 my $element;
1315 if ($self->{tree}->class eq 'List') {$element = Value::Formula->new($self->{tree}{coords}[0])}
1316 else {$element = Value::Formula->new(($self->createRandomPoints(1))[1]->[0]{data}[0])}
1317 return (
1318 Value::List::cmp_defaults($self,@_),
1319 removeParens => $self->{autoFormula},
1320 typeMatch => $element,
1321 showDomainErrors => 1,
1322 );
1323}
1324
409# 1325#
410# No cmp function (for now) 1326# Get the types from the values of the formulas
1327# and compare those.
1328#
1329sub typeMatch {
1330 my $self = shift; my $other = shift; my $ans = shift;
1331 return 1 if $self->type eq $other->type;
1332 my $typeMatch = ($self->createRandomPoints(1))[1]->[0];
1333 $other = eval {($other->createRandomPoints(1))[1]->[0]} if Value::isFormula($other);
1334 return 1 unless defined($other); # can't really tell, so don't report type mismatch
1335 $typeMatch->typeMatch($other,$ans);
1336}
1337
1338#
1339# Handle removal of outermost parens in a list.
1340# Evaluate answer, if the eval option is used.
1341# Handle the UpToConstant option.
411# 1342#
412sub cmp { 1343sub cmp {
413 die "Answer checker for formulas is not yet defined"; 1344 my $self = shift;
1345 my $cmp = $self->SUPER::cmp(@_);
1346 if ($cmp->{rh_ans}{removeParens} && $self->type eq 'List') {
1347 $self->{tree}{open} = $self->{tree}{close} = '';
1348 $cmp->ans_hash(correct_ans => $self->stringify)
1349 unless defined($self->{correct_ans});
1350 }
1351 if ($cmp->{rh_ans}{eval} && $self->isConstant) {
1352 $cmp->ans_hash(correct_value => $self->eval);
1353 return $cmp;
1354 }
1355 if ($cmp->{rh_ans}{upToConstant}) {
1356 my $current = Parser::Context->current();
1357 my $context = $self->{context} = $self->{context}->copy;
1358 Parser::Context->current(undef,$context);
1359 $context->variables->add('C0' => 'Parameter');
1360 my $f = Value::Formula->new('C0')+$self;
1361 for ('limits','test_points','test_values','num_points','granularity','resolution',
1362 'checkUndefinedPoints','max_undefined')
1363 {$f->{$_} = $self->{$_} if defined($self->{$_})}
1364 $cmp->ans_hash(correct_value => $f);
1365 Parser::Context->current(undef,$current);
1366 }
1367 return $cmp;
1368}
1369
1370sub cmp_equal {
1371 my $self = shift; my $ans = shift;
1372 #
1373 # Get the problem's seed
1374 #
1375 $self->{context}->flags->set(
1376 random_seed => $self->getPG('$PG_original_problemSeed')
1377 );
1378
1379 #
1380 # Use the list checker if the formula is a list or union
1381 # Otherwise use the normal checker
1382 #
1383 if ($self->type =~ m/^(List|Union|Set)$/) {
1384 Value::List::cmp_equal($self,$ans);
1385 } else {
1386 $self->SUPER::cmp_equal($ans);
1387 }
1388}
1389
1390sub cmp_postprocess {
1391 my $self = shift; my $ans = shift;
1392 return unless $ans->{score} == 0 && !$ans->{isPreview};
1393 return if $ans->{ans_message};
1394 if ($self->{domainMismatch} && $ans->{showDomainErrors}) {
1395 $self->cmp_Error($ans,"The domain of your function doesn't match that of the correct answer");
1396 return;
1397 }
1398 return if !$ans->{showDimensionHints};
1399 my $other = $ans->{student_value};
1400 return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String');
1401 return unless $other->type =~ m/^(Point|Vector|Matrix)$/;
1402 return unless $self->type =~ m/^(Point|Vector|Matrix)$/;
1403 return if Parser::Item::typeMatch($self->typeRef,$other->typeRef);
1404 $self->cmp_Error($ans,"The dimension of your result is incorrect");
1405}
1406
1407#
1408# Diagnostics for Formulas
1409#
1410sub cmp_diagnostics {
1411 my $self = shift; my $ans = shift;
1412 my $isEvaluator = (ref($ans) =~ /Evaluator/)? 1: 0;
1413 my $hash = $isEvaluator? $ans->rh_ans : $ans;
1414 my $diagnostics = $self->{context}->diagnostics->merge("formulas",$self,$hash);
1415 my $formulas = $diagnostics->{formulas};
1416 return unless $formulas->{show};
1417
1418 my $output = "";
1419 if ($isEvaluator) {
1420 #
1421 # The tests to be performed with the answer checker is created
1422 #
1423 $self->getPG('loadMacros("PGgraphmacros.pl")');
1424 my ($inputs) = $self->getPG('$inputs_ref');
1425 my $process = $inputs->{checkAnswers} || $inputs->{previewAnswers} || $inputs->{submitAnswers};
1426 if ($formulas->{checkNumericStability} && !$process) {
1427 ### still needs to be written
1428 }
1429 } else {
1430 #
1431 # The checks to be performed when an answer is submitted
1432 #
1433 my $student = $ans->{student_formula};
1434 my $points = [map {$_->[0]} @{$self->{test_points}}];
1435
1436 #
1437 # The graphs of the functions and errors
1438 #
1439 if ($formulas->{showGraphs}) {
1440 my @G = ();
1441 if ($formulas->{combineGraphs}) {
1442 push(@G,$self->cmp_graph($diagnostics,[$student,$self],
1443 title=>'Student Answer (red)<BR>Correct Answer (green)<BR>',
1444 points=>$points,showDomain=>1));
1445 } else {
1446 push(@G,$self->cmp_graph($diagnostics,$self,title=>'Correct Answer'));
1447 push(@G,$self->cmp_graph($diagnostics,$student,title=>'Student Answer'));
1448 }
1449 my $cutoff = Value::Formula->new($self->getFlag('tolerance'));
1450 if ($formulas->{graphAbsoluteErrors}) {
1451 push(@G,$self->cmp_graph($diagnostics,[abs($self-$student),$cutoff],
1452 clip=>$formulas->{clipAbsoluteError},
1453 title=>'Absolute Error',points=>$points));
1454 }
1455 if ($formulas->{graphRelativeErrors}) {
1456 push(@G,$self->cmp_graph($diagnostics,[abs(($self-$student)/$self),$cutoff],
1457 clip=>$formulas->{clipRelativeError},
1458 title=>'Relative Error',points=>$points));
1459 }
1460 $output .= '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0">'
1461 . '<TR VALIGN="TOP">'.join('<TD WIDTH="20"></TD>',@G).'</TR></TABLE>';
1462 }
1463
1464 #
1465 # The test points and values
1466 #
1467 my @rows = (); my $colsep = '</TD><TD WIDTH="20"></TD><TD ALIGN="RIGHT">';
1468 my @P = (map {(scalar(@{$_}) == 1)? $_->[0]: Value::Point->make(@{$_})} @{$self->{test_points}});
1469 my @i = sort {$P[$a] <=> $P[$b]} (0..$#P);
1470 if ($formulas->{showTestPoints}) {
1471 $student->createPointValues($self->{test_points},0,1,1) unless $student->{test_values};
1472 my @p = ("Input:",(map {$P[$i[$_]]} (0..$#P)));
1473 push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,@p).'</TD></TR>');
1474 push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,("<HR>")x scalar(@p)).'</TD></TR>');
1475 push(@rows,'<TR><TD ALIGN="RIGHT">'
1476 .join($colsep,"Correct Answer:", map {$self->{test_values}[$i[$_]]} (0..$#P))
1477 .'</TD></TR>');
1478 my $test = $student->{test_values};
1479 push(@rows,'<TR><TD ALIGN="RIGHT">'
1480 .join($colsep,"Student Answer:", map {Value::isNumber($test->[$i[$_]])? $test->[$i[$_]]: "undefined"} (0..$#P))
1481 .'</TD></TR>');
1482 }
1483 #
1484 # The absolute errors (colored by whether they are ok or too big)
1485 #
1486 if ($formulas->{showAbsoluteErrors}) {
1487 my @p = ("Absolute Error:");
1488 my $tolerance = $self->getFlag('tolerance');
1489 my $tolType = $self->getFlag('tolType'); my $error;
1490 foreach my $j (0..$#P) {
1491 if (Value::isNumber($student->{test_values}[$i[$j]])) {
1492 $error = abs($self->{test_values}[$i[$j]]-$student->{test_values}[$i[$j]]);
1493 $error = '<SPAN STYLE="color:#'.($error<$tolerance ? '00AA00': 'AA0000').'">'.$error.'</SPAN>'
1494 if $tolType eq 'absolute';
1495 } else {$error = "---"}
1496 push(@p,$error);
1497 }
1498 push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,@p).'</TD></TR>');
1499 }
1500 #
1501 # The relative errors (colored by whether they are OK ro too big)
1502 #
1503 if ($formulas->{showRelativeErrors}) {
1504 my @p = ("Relative Error:");
1505 my $tolerance = $self->getFlag('tolerance');
1506 my $tolType = $self->getFlag('tolType'); my $error;
1507 foreach my $j (0..$#P) {
1508 if (Value::isNumber($student->{test_values}[$i[$j]])) {
1509 $error = abs(($self->{test_values}[$i[$j]]-$student->{test_values}[$i[$j]])/
1510 ($self->{test_values}[$i[$j]]||1E-10));
1511 $error = '<SPAN STYLE="color:#'.($error<$tolerance ? '00AA00': 'AA0000').'">'.$error.'</SPAN>'
1512 if $tolType eq 'relative';
1513 } else {$error = "---"}
1514 push(@p,$error);
1515 }
1516 push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,@p).'</TD></TR>');
1517 }
1518 #
1519 # Put the data into a table
1520 #
1521 if (scalar(@rows)) {
1522 $output .= '<p><HR><p><TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0">'
1523 . join('<TR><TD HEIGHT="3"></TD>',@rows)
1524 . '</TABLE>';
1525 }
1526 }
1527 #
1528 # Put all the diagnostic output into a frame
1529 #
1530 return unless $output;
1531 $output
1532 = '<TABLE BORDER="1" CELLSPACING="2" CELLPADDING="20" BGCOLOR="#F0F0F0">'
1533 . '<TR><TD ALIGN="LEFT"><B>Diagnostics for '.$self->string .':</B>'
1534 . '<P><CENTER>' . $output . '</CENTER></TD></TR></TABLE><P>';
1535 warn $output;
1536}
1537
1538#
1539# Draw a graph from a given Formula object
1540#
1541sub cmp_graph {
1542 my $self = shift; my $diagnostics = shift;
1543 my $F1 = shift; my $F2; ($F1,$F2) = @{$F1} if (ref($F1) eq 'ARRAY');
1544 #
1545 # Get the various options
1546 #
1547 my %options = (title=>'',points=>[],@_);
1548 my $graphs = $diagnostics->{graphs};
1549 my $limits = $graphs->{limits}; $limits = $self->getFlag('limits',[-2,2]) unless $limits;
1550 $limits = $limits->[0] if ref($limits) eq 'ARRAY' && ref($limits->[0]) eq 'ARRAY';
1551 my $size = $graphs->{size}; $size = [$size,$size] unless ref($size) eq 'ARRAY';
1552 my $steps = $graphs->{divisions};
1553 my $points = $options{points}; my $clip = $options{clip};
1554 my ($my,$My) = (0,0); my ($mx,$Mx) = @{$limits};
1555 my $dx = ($Mx-$mx)/$steps; my $f; my $y;
1556
1557 #
1558 # Find the max and min values of the function
1559 #
1560 foreach $f ($F1,$F2) {
1561 next unless defined($f);
1562 unless (scalar(keys(%{$f->{variables}})) < 2) {
1563 warn "Only formulas with one variable can be graphed";
1564 return "";
1565 }
1566 if ($f->isConstant) {
1567 $y = $f->eval;
1568 $my = $y if $y < $my; $My = $y if $y > $My;
1569 } else {
1570 my $F = $f->perlFunction;
1571 foreach my $i (0..$steps-1) {
1572 $y = eval {&{$F}($mx+$i*$dx)}; next unless defined($y) && Value::isNumber($y);
1573 $my = $y if $y < $my; $My = $y if $y > $My;
1574 }
1575 }
1576 }
1577 $My = 1 if abs($My - $my) < 1E-5;
1578 $my *= 1.1; $My *= 1.1;
1579 if ($clip) {
1580 $my = -$clip if $my < -$clip;
1581 $My = $clip if $My > $clip;
1582 }
1583 $my = -$My/10 if $my > -$My/10; $My = -$my/10 if $My < -$my/10;
1584 my $a = Value::Real->new(($My-$my)/($Mx-$mx));
1585
1586 #
1587 # Create the graph itself, with suitable title
1588 #
1589 my $grf = $self->getPG('$_grf_ = {n => 0}');
1590 $grf->{Goptions} = [
1591 $mx,$my,$Mx,$My,
1592 axes => $graphs->{axes},
1593 grid => $graphs->{grid},
1594 size => $size,
1595 ];
1596 $grf->{G} = $self->getPG('init_graph(@{$_grf_->{Goptions}})');
1597 $grf->{G}->imageName($grf->{G}->imageName.'-'.time()); # avoid browser cache
1598 $self->cmp_graph_function($grf,$F2,"green",$steps,$points) if defined($F2);
1599 $self->cmp_graph_function($grf,$F1,"red",$steps,$points);
1600 my $image = $self->getPG('alias(insertGraph($_grf_->{G}))');
1601 $image = '<IMG SRC="'.$image.'" WIDTH="'.$size->[0].'" HEIGHT="'.$size->[1].'" BORDER="0" STYLE="margin-bottom:5px">';
1602 my $title = $options{title}; $title .= '<DIV STYLE="margin-top:5px"></DIV>' if $title;
1603 $title .= "<SMALL>Domain: [$mx,$Mx]</SMALL><BR>" if $options{showDomain};
1604 $title .= "<SMALL>Range: [$my,$My]<BR>Aspect ratio: $a:1</SMALL>";
1605 return '<TD ALIGN="CENTER" VALIGN="TOP" NOWRAP>'.$image.'<BR>'.$title.'</TD>';
1606}
1607
1608#
1609# Add a function to a graph object, and plot the points
1610# that are used to test the function
1611#
1612sub cmp_graph_function {
1613 my $self = shift; my $grf = shift; my $F = shift;
1614 my $color = shift; my $steps = shift; my $points = shift;
1615 $grf->{n}++; my $Fn = "F".$grf->{n}; $grf->{$Fn} = $F; my $f;
1616 if ($F->isConstant) {
1617 my $y = $F->eval;
1618 $f = $self->getPG('new Fun(sub {'.$y.'},$_grf_->{G})');
1619 } else {
1620 my $X = (keys %{$F->{variables}})[0];
1621 $f = $self->getPG('new Fun(sub {Parser::Evaluate($_grf_->{'.$Fn.'},'.$X.'=>shift)},$_grf_->{G})');
1622 foreach my $x (@{$points}) {
1623 my $y = Parser::Evaluate($F,($X)=>$x); next unless defined($y) && Value::isNumber($y);
1624 $grf->{x} = $x; $grf->{y} = $y;
1625 my $C = $self->getPG('new Circle($_grf_->{x},$_grf_->{y},4,"'.$color.'","'.$color.'")');
1626 $grf->{G}->stamps($C);
1627 }
1628 }
1629 $f->color($color); $f->weight(2); $f->steps($steps);
1630}
1631
1632#
1633# If an answer array was used, get the data from the
1634# Matrix, Vector or Point, and format the array of
1635# data using the original parameter
1636#
1637sub correct_ans {
1638 my $self = shift;
1639 return $self->SUPER::correct_ans unless $self->{ans_name};
1640 my @array = ();
1641 if ($self->{tree}->type eq 'Matrix') {
1642 foreach my $row (@{$self->{tree}{coords}}) {
1643 my @row = ();
1644 foreach my $x (@{$row->coords}) {push(@row,$x->string)}
1645 push(@array,[@row]);
1646 }
1647 } else {
1648 foreach my $x (@{$self->{tree}{coords}}) {push(@array,$x->string)}
1649 if ($self->{tree}{ColumnVector}) {foreach my $x (@array) {$x = [$x]}}
1650 else {@array = [@array]}
1651 }
1652 Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
1653}
1654
1655#
1656# Get the size of the array and create the appropriate answer array
1657#
1658sub ANS_MATRIX {
1659 my $self = shift;
1660 my $extend = shift; my $name = shift;
1661 my $size = shift || 5; my $type = $self->type;
1662 my $cols = $self->length; my $rows = 1; my $sep = ',';
1663 if ($type eq 'Matrix') {
1664 $sep = ''; $rows = $cols; $cols = $self->{tree}->typeRef->{entryType}{length};
1665 }
1666 if ($self->{tree}{ColumnVector}) {
1667 $sep = ""; $type = "Matrix";
1668 my $tmp = $rows; $rows = $cols; $cols = $tmp;
1669 $self->{ColumnVector} = 1;
1670 }
1671 my $def = ($self->{context} || $$Value::context)->lists->get($type);
1672 my $open = $self->{open} || $self->{tree}{open} || $def->{open};
1673 my $close = $self->{close} || $self->{tree}{close} || $def->{close};
1674 $self->ans_matrix($extend,$name,$rows,$cols,$size,$open,$close,$sep);
1675}
1676
1677sub ans_array {
1678 my $self = shift;
1679 return $self->SUPER::ans_array(@_) unless $self->array_OK;
1680 $self->ANS_MATRIX(0,'',@_);
1681}
1682sub named_ans_array {
1683 my $self = shift;
1684 return $self->SUPER::named_ans_array(@_) unless $self->array_OK;
1685 $self->ANS_MATRIX(0,@_);
1686}
1687sub named_ans_array_extension {
1688 my $self = shift;
1689 return $self->SUPER::named_ans_array_extension(@_) unless $self->array_OK;
1690 $self->ANS_MATRIX(1,@_);
1691}
1692
1693sub array_OK {
1694 my $self = shift; my $tree = $self->{tree};
1695 return $tree->type =~ m/^(Point|Vector|Matrix)$/ && $tree->class eq 'List';
1696}
1697
1698#
1699# Get an array of values from a Matrix, Vector or Point
1700#
1701sub value {
1702 my $self = shift;
1703 my @array = ();
1704 if ($self->{tree}->type eq 'Matrix') {
1705 foreach my $row (@{$self->{tree}->coords}) {
1706 my @row = ();
1707 foreach my $x (@{$row->coords}) {push(@row,Value::Formula->new($x))}
1708 push(@array,[@row]);
1709 }
1710 } else {
1711 foreach my $x (@{$self->{tree}->coords}) {
1712 push(@array,Value::Formula->new($x));
1713 }
1714 }
1715 return @array;
414} 1716}
415 1717
416############################################################# 1718#############################################################
417 1719
4181; 17201;
Legend:
Removed from v.2600  
changed lines
  Added in v.4093
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9