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

Revision 4143 - (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 :	dpvc	3589	# Context can add default values to the answer checkers by class;
18 :			#
19 :			$Value::defaultContext->{cmpDefaults} = {};
20 :
21 :
22 :			#
23 :	dpvc	3629	# Default flags for the answer checkers
24 :	dpvc	2593	#
25 :	dpvc	2609	sub cmp_defaults {(
26 :	dpvc	2593	showTypeWarnings => 1,
27 :	dpvc	2627	showEqualErrors => 1,
28 :			ignoreStrings => 1,
29 :	dpvc	3497	studentsMustReduceUnions => 1,
30 :			showUnionReduceWarnings => 1,
31 :	dpvc	2621	)}
32 :	dpvc	2593
33 :	dpvc	3629	#
34 :	dpvc	3703	# Special Context flags to be set for the student answer
35 :			#
36 :			sub 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 :			#
56 :	dpvc	3629	# Create an answer checker for the given type of object
57 :			#
58 :	dpvc	2593	sub cmp {
59 :			my $self = shift;
60 :			my $ans = new AnswerEvaluator;
61 :	dpvc	3269	my $correct = protectHTML($self->{correct_ans});
62 :			$correct = $self->correct_ans unless defined($correct);
63 :	dpvc	3589	$self->{context} = $$Value::context unless defined($self->{context});
64 :	dpvc	2593	$ans->ans_hash(
65 :			type => "Value (".$self->class.")",
66 :	dpvc	3269	correct_ans => $correct,
67 :	dpvc	2593	correct_value => $self,
68 :	dpvc	3206	$self->cmp_defaults(@_),
69 :	dpvc	3589	%{$self->{context}{cmpDefaults}{$self->class} \|\| {}}, # context-specified defaults
70 :	dpvc	2593	@_
71 :			);
72 :	dpvc	3713	$ans->{debug} = $ans->{rh_ans}{debug};
73 :	dpvc	2648	$ans->install_evaluator(sub {$ans = shift; $ans->{correct_value}->cmp_parse($ans)});
74 :	dpvc	3269	$ans->install_pre_filter('erase') if $self->{ans_name}; # don't do blank check if answer_array
75 :	dpvc	3715	$self->cmp_diagnostics($ans);
76 :	dpvc	2593	return $ans;
77 :			}
78 :
79 :	dpvc	3269	sub correct_ans {protectHTML(shift->string)}
80 :	dpvc	3715	sub cmp_diagnostics {}
81 :	dpvc	3269
82 :	dpvc	2593	#
83 :			# Parse the student answer and compute its value,
84 :			# produce the preview strings, and then compare the
85 :			# student and professor's answers for equality.
86 :			#
87 :	dpvc	2648	sub cmp_parse {
88 :	dpvc	2593	my $self = shift; my $ans = shift;
89 :	dpvc	2599	#
90 :	dpvc	2648	# Do some setup
91 :	dpvc	2599	#
92 :	dpvc	2688	my $current = $$Value::context; # save it for later
93 :	dpvc	2692	my $context = $ans->{correct_value}{context} \|\| $current;
94 :	dpvc	2688	Parser::Context->current(undef,$context); # change to correct answser's context
95 :	dpvc	3703	my $flags = contextSet($context,$self->cmp_contextFlags($ans)); # save old context flags
96 :	dpvc	3493	my $inputs = $self->getPG('$inputs_ref',{action=>""});
97 :			$ans->{isPreview} = $inputs->{previewAnswers} \|\| ($inputs->{action} =~ m/^Preview/);
98 :	dpvc	2648	$ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class};
99 :	dpvc	2916	$ans->{error_message} = $ans->{ans_message} = ''; # clear any old messages
100 :			$ans->{preview_latex_string} = $ans->{preview_text_string} = '';
101 :	dpvc	2648
102 :	dpvc	2599	#
103 :			# Parse and evaluate the student answer
104 :			#
105 :	dpvc	2593	$ans->score(0); # assume failure
106 :	dpvc	2621	$ans->{student_value} = $ans->{student_formula} = Parser::Formula($ans->{student_ans});
107 :			$ans->{student_value} = Parser::Evaluate($ans->{student_formula})
108 :	dpvc	2624	if defined($ans->{student_formula}) && $ans->{student_formula}->isConstant;
109 :	dpvc	2648
110 :	dpvc	2599	#
111 :			# If it parsed OK, save the output forms and check if it is correct
112 :			# otherwise report an error
113 :			#
114 :	dpvc	2593	if (defined $ans->{student_value}) {
115 :			$ans->{student_value} = Value::Formula->new($ans->{student_value})
116 :			unless Value::isValue($ans->{student_value});
117 :			$ans->{preview_latex_string} = $ans->{student_formula}->TeX;
118 :	dpvc	2648	$ans->{preview_text_string} = protectHTML($ans->{student_formula}->string);
119 :	dpvc	3703	#
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 :	dpvc	3269	if ($self->cmp_collect($ans)) {
133 :			$self->cmp_equal($ans);
134 :	dpvc	4093	$self->cmp_postprocess($ans) if !$ans->{error_message} && !$ans->{typeError};
135 :	dpvc	3715	$self->cmp_diagnostics($ans);
136 :	dpvc	3269	}
137 :	dpvc	2593	} else {
138 :	dpvc	3629	$self->cmp_collect($ans);
139 :	dpvc	2648	$self->cmp_error($ans);
140 :	dpvc	2593	}
141 :	dpvc	2791	contextSet($context,%{$flags}); # restore context values
142 :	dpvc	2688	Parser::Context->current(undef,$current); # put back the old context
143 :	dpvc	2593	return $ans;
144 :			}
145 :
146 :			#
147 :	dpvc	3269	# Check if the object has an answer array and collect the results
148 :			# Build the combined student answer and set the preview values
149 :			#
150 :			sub 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 :	dpvc	3629	{Parser::reportEvalError($@); $self->cmp_error($ans); return 0}
167 :	dpvc	3269	$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;
175 :			}
176 :
177 :			#
178 :	dpvc	2593	# Check if the parsed student answer equals the professor's answer
179 :			#
180 :			sub cmp_equal {
181 :			my $self = shift; my $ans = shift;
182 :	dpvc	2627	my $correct = $ans->{correct_value};
183 :			my $student = $ans->{student_value};
184 :			if ($correct->typeMatch($student,$ans)) {
185 :	dpvc	3206	my $equal = $correct->cmp_compare($student,$ans);
186 :	dpvc	2594	if (defined($equal) \|\| !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return}
187 :	dpvc	2648	$self->cmp_error($ans);
188 :	dpvc	2593	} else {
189 :	dpvc	2627	return if $ans->{ignoreStrings} && (!Value::isValue($student) \|\| $student->type eq 'String');
190 :	dpvc	4093	$ans->{typeError} = 1;
191 :	dpvc	2593	$ans->{ans_message} = $ans->{error_message} =
192 :	dpvc	3336	"Your answer isn't ".lc($ans->{cmp_class})."\n".
193 :	dpvc	3269	"(it looks like ".lc($student->showClass).")"
194 :	dpvc	2593	if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message};
195 :			}
196 :			}
197 :
198 :			#
199 :	dpvc	3206	# Perform the comparison, either using the checker supplied
200 :			# by the answer evaluator, or the overloaded == operator.
201 :			#
202 :
203 :	dpvc	3504	our $CMP_ERROR = 2; # a fatal error was detected
204 :			our $CMP_WARNING = 3; # a warning was produced
205 :	dpvc	3206
206 :			sub cmp_compare {
207 :	dpvc	3504	my $self = shift; my $other = shift; my $ans = shift; my $nth = shift \|\| '';
208 :	dpvc	3754	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 :	dpvc	3206	}
215 :			return $equal;
216 :			}
217 :
218 :			sub cmp_list_compare {Value::List::cmp_list_compare(@_)}
219 :
220 :			#
221 :	dpvc	2593	# Check if types are compatible for equality check
222 :			#
223 :			sub typeMatch {
224 :	dpvc	2600	my $self = shift; my $other = shift;
225 :			return 1 unless ref($other);
226 :	dpvc	2621	$self->type eq $other->type && $other->class ne 'Formula';
227 :	dpvc	2593	}
228 :
229 :			#
230 :	dpvc	2605	# Class name for cmp error messages
231 :			#
232 :	dpvc	2609	sub cmp_class {
233 :			my $self = shift; my $ans = shift;
234 :	dpvc	2624	my $class = $self->showClass; $class =~ s/Real //;
235 :			return $class if $class =~ m/Formula/;
236 :	dpvc	3516	return "an Interval, Set or Union" if $self->isSetOfReals;
237 :	dpvc	2609	return $class;
238 :			}
239 :	dpvc	2605
240 :			#
241 :	dpvc	2593	# Student answer evaluation failed.
242 :			# Report the error, with formatting, if possible.
243 :			#
244 :			sub cmp_error {
245 :			my $self = shift; my $ans = shift;
246 :	dpvc	3206	my $error = $$Value::context->{error};
247 :			my $message = $error->{message};
248 :			if ($error->{pos}) {
249 :			my $string = $error->{string};
250 :			my ($s,$e) = @{$error->{pos}};
251 :	dpvc	2593	$message =~ s/; see.*//; # remove the position from the message
252 :			$ans->{student_ans} =
253 :			protectHTML(substr($string,0,$s)) .
254 :			'<SPAN CLASS="parsehilight">' .
255 :			protectHTML(substr($string,$s,$e-$s)) .
256 :			'</SPAN>' .
257 :			protectHTML(substr($string,$e));
258 :			}
259 :	dpvc	2601	$self->cmp_Error($ans,$message);
260 :			}
261 :
262 :			#
263 :			# Set the error message
264 :			#
265 :			sub cmp_Error {
266 :			my $self = shift; my $ans = shift;
267 :			return unless scalar(@_) > 0;
268 :	dpvc	2599	$ans->score(0);
269 :	dpvc	2601	$ans->{ans_message} = $ans->{error_message} = join("\n",@_);
270 :	dpvc	2593	}
271 :
272 :			#
273 :	dpvc	2601	# filled in by sub-classes
274 :			#
275 :			sub cmp_postprocess {}
276 :
277 :			#
278 :	dpvc	3504	# Check for unreduced reduced Unions and Sets
279 :	dpvc	3497	#
280 :			sub cmp_checkUnionReduce {
281 :	dpvc	3504	my $self = shift; my $student = shift; my $ans = shift; my $nth = shift \|\| '';
282 :	dpvc	3497	return unless $ans->{studentsMustReduceUnions} &&
283 :			$ans->{showUnionReduceWarnings} &&
284 :	dpvc	3504	!$ans->{isPreview} && !Value::isFormula($student);
285 :	dpvc	3497	if ($student->type eq 'Union' && $student->length >= 2) {
286 :			my $reduced = $student->reduce;
287 :	dpvc	3630	return "Your$nth union can be written without overlaps"
288 :	dpvc	3497	unless $reduced->type eq 'Union' && $reduced->length == $student->length;
289 :	dpvc	3505	my @R = $reduced->sort->value;
290 :			my @S = $student->sort->value;
291 :	dpvc	3497	foreach my $i (0..$#R) {
292 :	dpvc	3630	return "Your$nth union can be written without overlaps"
293 :	dpvc	3507	unless $R[$i] == $S[$i] && $R[$i]->length == $S[$i]->length;
294 :	dpvc	3497	}
295 :	dpvc	3507	} elsif ($student->type eq 'Set' && $student->length >= 2) {
296 :	dpvc	3516	return "Your$nth set should have no repeated elements"
297 :	dpvc	3507	unless $student->reduce->length == $student->length;
298 :	dpvc	3497	}
299 :			return;
300 :			}
301 :
302 :			#
303 :	dpvc	3269	# create answer rules of various types
304 :			#
305 :			sub ans_rule {shift; pgCall('ans_rule',@_)}
306 :			sub named_ans_rule {shift; pgCall('NAMED_ANS_RULE',@_)}
307 :			sub named_ans_rule_extension {shift; pgCall('NAMED_ANS_RULE_EXTENSION',@_)}
308 :			sub ans_array {shift->ans_rule(@_)};
309 :			sub named_ans_array {shift->named_ans_rule(@_)};
310 :			sub named_ans_array_extension {shift->named_ans_rule_extension(@_)};
311 :
312 :			sub pgCall {my $call = shift; &{WeBWorK::PG::Translator::PG_restricted_eval('\&'.$call)}(@_)}
313 :			sub pgRef {WeBWorK::PG::Translator::PG_restricted_eval('\&'.shift)}
314 :
315 :			our $answerPrefix = "MaTrIx";
316 :
317 :			#
318 :			# Lay out a matrix of answer rules
319 :			#
320 :			sub 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 :
350 :			sub ANS_NAME {
351 :			my ($name,$i,$j) = @_;
352 :			$name.'_'.$i.'_'.$j;
353 :			}
354 :
355 :
356 :			#
357 :			# Lay out an arbitrary matrix
358 :			#
359 :			sub 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 :
366 :			sub format_matrix_tex {
367 :			my $self = shift; my $array = shift;
368 :	dpvc	3273	my %options = (open=>'.',close=>'.',sep=>'',@_);
369 :	dpvc	3269	$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 :	dpvc	3273	$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 :	dpvc	3269	return $tex;
380 :			}
381 :
382 :			sub 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 :	dpvc	3631	$HTML .= '<TR ALIGN="MIDDLE"><TD>'.join($sep,EVALUATE(@{$array->[$i]})).'</TD></TR>'."\n";
394 :	dpvc	3269	}
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 :
414 :	dpvc	3631	sub EVALUATE {map {(Value::isFormula($_) && $_->isConstant? $_->eval: $_)} @_}
415 :
416 :	dpvc	3273	sub 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 :	dpvc	3269	#
424 :			# Create a tall delimiter to match the line height
425 :			#
426 :			sub 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 :			#
441 :			my %tth_delim = (
442 :			'[' => ['','','',''],
443 :			']' => ['','','',''],
444 :			'(' => ['','','',''],
445 :			')' => ['','','',''],
446 :			'{' => ['','','',''],
447 :			'}' => ['','','',''],
448 :			'\|' => ['\|','','\|','\|'],
449 :			'<' => ['<'],
450 :			'>' => ['>'],
451 :			'\lgroup' => ['','','',''],
452 :			'\rgroup' => ['','','',''],
453 :			);
454 :
455 :			#
456 :			# Make delimiters as stacks of characters
457 :			#
458 :			sub 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 :
485 :	dpvc	3629	my @ans_cmp_defaults = (showCoodinateHints => 0, checker => sub {0});
486 :	dpvc	3269
487 :			sub 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 :	dpvc	3629	my @row = (); my $entry;
497 :	dpvc	3269	foreach my $j (0..$cols-1) {
498 :			if ($i \|\| $j) {
499 :	dpvc	3629	$entry = $inputs->{ANS_NAME($self->{ans_name},$i,$j)};
500 :	dpvc	3269	} else {
501 :	dpvc	3629	$entry = $ans->{original_student_ans};
502 :			$ans->{student_formula} = $ans->{student_value} = undef unless $entry =~ m/\S/;
503 :	dpvc	3269	}
504 :	dpvc	3629	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 :	dpvc	3269	}
509 :			push(@array,[@row]);
510 :			}
511 :			$ans->{student_formula} = [@array];
512 :	dpvc	3629	$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 :	dpvc	3269	}
522 :
523 :			sub entryMessage {
524 :			my $message = shift; return unless $message;
525 :	dpvc	3629	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 :	dpvc	3633	push(@{$errors},"<TR VALIGN=\"TOP\"><TD NOWRAP STYLE=\"text-align:right; border:0px\"><I>$title</I>: </TD>".
531 :	dpvc	3629	"<TD STYLE=\"text-align:left; border:0px\">$message</TD></TR>");
532 :	dpvc	3269	}
533 :
534 :			sub 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 :	dpvc	2791	# Get and Set values in context
547 :			#
548 :			sub 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;
553 :			}
554 :
555 :			#
556 :	dpvc	2593	# Quote HTML characters
557 :			#
558 :			sub protectHTML {
559 :			my $string = shift;
560 :	dpvc	3488	return unless defined($string);
561 :	dpvc	2661	return $string if eval ('$main::displayMode') eq 'TeX';
562 :	dpvc	2593	$string =~ s/&/\&/g;
563 :			$string =~ s/</\</g;
564 :			$string =~ s/>/\>/g;
565 :			$string;
566 :			}
567 :
568 :	dpvc	2599	#
569 :	dpvc	2601	# names for numbers
570 :			#
571 :			sub 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 :			#
580 :	dpvc	2599	# Get a value from the safe compartment
581 :			#
582 :			sub getPG {
583 :			my $self = shift;
584 :	dpvc	2664	# (WeBWorK::PG::Translator::PG_restricted_eval(shift))[0];
585 :			eval ('package main; '.shift); # faster
586 :	dpvc	2599	}
587 :
588 :	dpvc	2593	#############################################################
589 :			#############################################################
590 :
591 :	dpvc	2596	package Value::Real;
592 :
593 :	dpvc	2609	sub cmp_defaults {(
594 :	dpvc	3206	shift->SUPER::cmp_defaults(@_),
595 :	dpvc	2605	ignoreInfinity => 1,
596 :	dpvc	2621	)}
597 :	dpvc	2597
598 :	dpvc	2596	sub typeMatch {
599 :			my $self = shift; my $other = shift; my $ans = shift;
600 :	dpvc	2600	return 1 unless ref($other);
601 :	dpvc	2648	return 0 if Value::isFormula($other);
602 :	dpvc	2605	return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity};
603 :	dpvc	2596	$self->type eq $other->type;
604 :			}
605 :
606 :			#############################################################
607 :
608 :	dpvc	2605	package Value::Infinity;
609 :
610 :	dpvc	2609	sub cmp_class {'a Number'};
611 :	dpvc	2605
612 :			sub typeMatch {
613 :			my $self = shift; my $other = shift; my $ans = shift;
614 :			return 1 unless ref($other);
615 :	dpvc	2648	return 0 if Value::isFormula($other);
616 :	dpvc	2605	return 1 if $other->type eq 'Number';
617 :			$self->type eq $other->type;
618 :			}
619 :
620 :			#############################################################
621 :
622 :	dpvc	2609	package Value::String;
623 :
624 :			sub cmp_defaults {(
625 :	dpvc	3206	Value::Real->cmp_defaults(@_),
626 :	dpvc	2621	typeMatch => 'Value::Real',
627 :			)}
628 :	dpvc	2609
629 :			sub cmp_class {
630 :	dpvc	2621	my $self = shift; my $ans = shift; my $typeMatch = $ans->{typeMatch};
631 :	dpvc	2612	return 'a Word' if !Value::isValue($typeMatch) \|\| $typeMatch->class eq 'String';
632 :	dpvc	2609	return $typeMatch->cmp_class;
633 :			};
634 :
635 :			sub typeMatch {
636 :			my $self = shift; my $other = shift; my $ans = shift;
637 :	dpvc	3678	# return 0 if ref($other) && Value::isFormula($other);
638 :	dpvc	2612	my $typeMatch = $ans->{typeMatch};
639 :	dpvc	3872	return &$typeMatch($other,$ans) if ref($typeMatch) eq 'CODE';
640 :	dpvc	2621	return 1 if !Value::isValue($typeMatch) \|\| $typeMatch->class eq 'String' \|\|
641 :			$self->type eq $other->type;
642 :	dpvc	2612	return $typeMatch->typeMatch($other,$ans);
643 :	dpvc	2609	}
644 :
645 :	dpvc	3652	#
646 :			# Remove the blank-check prefilter when the string is empty,
647 :			# and add a filter that removes leading and trailing whitespace.
648 :			#
649 :			sub 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 :	dpvc	2609	#############################################################
665 :
666 :	dpvc	2593	package Value::Point;
667 :
668 :	dpvc	2609	sub cmp_defaults {(
669 :	dpvc	3206	shift->SUPER::cmp_defaults(@_),
670 :	dpvc	2601	showDimensionHints => 1,
671 :			showCoordinateHints => 1,
672 :	dpvc	2621	)}
673 :	dpvc	2593
674 :			sub typeMatch {
675 :			my $self = shift; my $other = shift; my $ans = shift;
676 :	dpvc	2621	return ref($other) && $other->type eq 'Point' && $other->class ne 'Formula';
677 :	dpvc	2601	}
678 :
679 :			#
680 :			# Check for dimension mismatch and incorrect coordinates
681 :			#
682 :			sub cmp_postprocess {
683 :			my $self = shift; my $ans = shift;
684 :			return unless $ans->{score} == 0 && !$ans->{isPreview};
685 :	dpvc	3205	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 :	dpvc	3269	$self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
689 :	dpvc	2593	}
690 :	dpvc	2601	if ($ans->{showCoordinateHints}) {
691 :			my @errors;
692 :			foreach my $i (1..$self->length) {
693 :			push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
694 :	dpvc	3205	if ($self->{data}[$i-1] != $student->{data}[$i-1]);
695 :	dpvc	2601	}
696 :			$self->cmp_Error($ans,@errors); return;
697 :			}
698 :	dpvc	2593	}
699 :
700 :	dpvc	3269	sub correct_ans {
701 :			my $self = shift;
702 :			return $self->SUPER::correct_ans unless $self->{ans_name};
703 :	dpvc	3273	Value::VERBATIM($self->format_matrix([[@{$self->{data}}]],@{$self->{format_options}},tth_delims=>1));
704 :	dpvc	3269	}
705 :
706 :			sub 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 :
715 :			sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
716 :			sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
717 :			sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
718 :
719 :	dpvc	2593	#############################################################
720 :
721 :			package Value::Vector;
722 :
723 :	dpvc	2609	sub cmp_defaults {(
724 :	dpvc	3206	shift->SUPER::cmp_defaults(@_),
725 :	dpvc	2601	showDimensionHints => 1,
726 :			showCoordinateHints => 1,
727 :	dpvc	2594	promotePoints => 0,
728 :	dpvc	2597	parallel => 0,
729 :			sameDirection => 0,
730 :	dpvc	2621	)}
731 :	dpvc	2593
732 :			sub typeMatch {
733 :			my $self = shift; my $other = shift; my $ans = shift;
734 :	dpvc	2621	return 0 unless ref($other) && $other->class ne 'Formula';
735 :	dpvc	2627	return $other->type eq 'Vector' \|\|
736 :			($ans->{promotePoints} && $other->type eq 'Point');
737 :	dpvc	2593	}
738 :
739 :	dpvc	2597	#
740 :	dpvc	2601	# check for dimension mismatch
741 :			# for parallel vectors, and
742 :			# for incorrect coordinates
743 :	dpvc	2597	#
744 :			sub cmp_postprocess {
745 :			my $self = shift; my $ans = shift;
746 :	dpvc	4093	return unless $ans->{score} == 0 && !$ans->{isPreview};
747 :	dpvc	3205	my $student = $ans->{student_value};
748 :			return if $ans->{ignoreStrings} && (!Value::isValue($student) \|\| $student->type eq 'String');
749 :	dpvc	4093	if ($ans->{showDimensionHints} && $self->length != $student->length) {
750 :	dpvc	3269	$self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
751 :	dpvc	2601	}
752 :	dpvc	4143	if ($ans->{parallel} && $student->class ne 'Formula' && $student->class ne 'String' &&
753 :	dpvc	3205	$self->isParallel($student,$ans->{sameDirection})) {
754 :	dpvc	2900	$ans->score(1); return;
755 :			}
756 :	dpvc	4093	if ($ans->{showCoordinateHints} && !$ans->{parallel}) {
757 :	dpvc	2601	my @errors;
758 :			foreach my $i (1..$self->length) {
759 :			push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
760 :	dpvc	3205	if ($self->{data}[$i-1] != $student->{data}[$i-1]);
761 :	dpvc	2601	}
762 :			$self->cmp_Error($ans,@errors); return;
763 :			}
764 :	dpvc	2597	}
765 :
766 :	dpvc	3269	sub correct_ans {
767 :			my $self = shift;
768 :			return $self->SUPER::correct_ans unless $self->{ans_name};
769 :	dpvc	3273	return Value::VERBATIM($self->format_matrix([[$self->value]],@{$self->{format_options}},tth_delims=>1))
770 :	dpvc	3269	unless $self->{ColumnVector};
771 :			my @array = (); foreach my $x ($self->value) {push(@array,[$x])}
772 :	dpvc	3273	return Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
773 :	dpvc	3269	}
774 :	dpvc	2597
775 :	dpvc	3269	sub 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 :	dpvc	2597
788 :	dpvc	3269	sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
789 :			sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
790 :			sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
791 :
792 :
793 :	dpvc	2593	#############################################################
794 :
795 :			package Value::Matrix;
796 :
797 :	dpvc	2609	sub cmp_defaults {(
798 :	dpvc	3206	shift->SUPER::cmp_defaults(@_),
799 :	dpvc	2601	showDimensionHints => 1,
800 :			showEqualErrors => 0,
801 :	dpvc	2621	)}
802 :	dpvc	2593
803 :			sub typeMatch {
804 :			my $self = shift; my $other = shift; my $ans = shift;
805 :	dpvc	2621	return 0 unless ref($other) && $other->class ne 'Formula';
806 :	dpvc	2627	return $other->type eq 'Matrix' \|\|
807 :			($other->type =~ m/^(Point\|list)$/ &&
808 :			$other->{open}.$other->{close} eq $self->{open}.$self->{close});
809 :	dpvc	2601	}
810 :
811 :			sub cmp_postprocess {
812 :			my $self = shift; my $ans = shift;
813 :			return unless $ans->{score} == 0 &&
814 :			!$ans->{isPreview} && $ans->{showDimensionHints};
815 :	dpvc	3205	my $student = $ans->{student_value};
816 :			return if $ans->{ignoreStrings} && (!Value::isValue($student) \|\| $student->type eq 'String');
817 :			my @d1 = $self->dimensions; my @d2 = $student->dimensions;
818 :	dpvc	2593	if (scalar(@d1) != scalar(@d2)) {
819 :	dpvc	2601	$self->cmp_Error($ans,"Matrix dimension is not correct");
820 :			return;
821 :	dpvc	2593	} else {
822 :			foreach my $i (0..scalar(@d1)-1) {
823 :			if ($d1[$i] != $d2[$i]) {
824 :	dpvc	2601	$self->cmp_Error($ans,"Matrix dimension is not correct");
825 :			return;
826 :	dpvc	2593	}
827 :			}
828 :			}
829 :			}
830 :
831 :	dpvc	3269	sub 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 :	dpvc	3273	Value::VERBATIM($self->format_matrix([$self->value],@{$self->{format_options}},tth_delims=>1));
836 :	dpvc	3269	}
837 :
838 :			sub 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 :	dpvc	3370	Value::Error("Can't create ans_array for %d-dimensional matrix",scalar(@d))
846 :	dpvc	3269	if (scalar(@d) > 2);
847 :			@d = (1,@d) if (scalar(@d) == 1);
848 :			$self->ans_matrix($extend,$name,@d,$size,$open,$close,'');
849 :			}
850 :
851 :			sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
852 :			sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
853 :			sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
854 :
855 :	dpvc	2593	#############################################################
856 :
857 :			package Value::Interval;
858 :
859 :	dpvc	2609	sub cmp_defaults {(
860 :	dpvc	3206	shift->SUPER::cmp_defaults(@_),
861 :	dpvc	2601	showEndpointHints => 1,
862 :			showEndTypeHints => 1,
863 :	dpvc	3460	requireParenMatch => 1,
864 :	dpvc	2621	)}
865 :	dpvc	2594
866 :	dpvc	2593	sub typeMatch {
867 :			my $self = shift; my $other = shift;
868 :	dpvc	3516	return 0 if !Value::isValue($other) \|\| $other->isFormula;
869 :			return $other->canBeInUnion;
870 :	dpvc	2593	}
871 :
872 :	dpvc	2601	#
873 :	dpvc	3504	# Check for unreduced sets and unions
874 :	dpvc	3497	#
875 :	dpvc	3504	sub cmp_compare {
876 :			my $self = shift; my $student = shift; my $ans = shift;
877 :			my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
878 :	dpvc	3511	if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return}
879 :	dpvc	3504	$self->SUPER::cmp_compare($student,$ans,@_);
880 :	dpvc	3497	}
881 :
882 :			#
883 :	dpvc	2601	# Check for wrong enpoints and wrong type of endpoints
884 :			#
885 :			sub cmp_postprocess {
886 :			my $self = shift; my $ans = shift;
887 :			return unless $ans->{score} == 0 && !$ans->{isPreview};
888 :			my $other = $ans->{student_value};
889 :	dpvc	3205	return if $ans->{ignoreStrings} && (!Value::isValue($other) \|\| $other->type eq 'String');
890 :	dpvc	2604	return unless $other->class eq 'Interval';
891 :	dpvc	2601	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 :	dpvc	3460	if (scalar(@errors) == 0 && $ans->{showEndTypeHints} && $ans->{requireParenMatch}) {
899 :	dpvc	2601	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 :	dpvc	2593	#############################################################
906 :
907 :	dpvc	3469	package Value::Set;
908 :
909 :			sub typeMatch {
910 :			my $self = shift; my $other = shift;
911 :	dpvc	3516	return 0 if !Value::isValue($other) \|\| $other->isFormula;
912 :			return $other->canBeInUnion;
913 :	dpvc	3469	}
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 :			#
920 :			sub 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 :	dpvc	3504	# error messages).
933 :	dpvc	3469	#
934 :			sub cmp_equal {
935 :			my ($self,$ans) = @_;
936 :	dpvc	3497	return Value::List::cmp_equal(@_) if $ans->{student_value}->type eq 'Set';
937 :			$self->SUPER::cmp_equal($ans);
938 :	dpvc	3469	}
939 :
940 :	dpvc	3504	#
941 :			# Check for unreduced sets and unions
942 :			#
943 :			sub cmp_compare {
944 :			my $self = shift; my $student = shift; my $ans = shift;
945 :			my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
946 :	dpvc	3511	if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return}
947 :	dpvc	3504	$self->SUPER::cmp_compare($student,$ans,@_);
948 :			}
949 :
950 :	dpvc	3469	#############################################################
951 :
952 :	dpvc	2593	package Value::Union;
953 :
954 :			sub typeMatch {
955 :			my $self = shift; my $other = shift;
956 :	dpvc	2621	return 0 unless ref($other) && $other->class ne 'Formula';
957 :	dpvc	2597	return $other->length == 2 &&
958 :			($other->{open} eq '(' \|\| $other->{open} eq '[') &&
959 :			($other->{close} eq ')' \|\| $other->{close} eq ']')
960 :			if $other->type =~ m/^(Point\|List)$/;
961 :	dpvc	3516	$other->isSetOfReals;
962 :	dpvc	2593	}
963 :
964 :	dpvc	2617	#
965 :			# Use the List checker for unions, in order to get
966 :			# partial credit. Set the various types for error
967 :			# messages.
968 :			#
969 :			sub cmp_defaults {(
970 :	dpvc	2621	Value::List::cmp_defaults(@_),
971 :			typeMatch => 'Value::Interval',
972 :	dpvc	3469	list_type => 'an interval, set or union',
973 :			short_type => 'a union',
974 :			entry_type => 'an interval or set',
975 :	dpvc	2617	)}
976 :
977 :	dpvc	3511	sub cmp_equal {
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 :	dpvc	3504
984 :	dpvc	3497	#
985 :			# Check for unreduced sets and unions
986 :			#
987 :	dpvc	3504	sub cmp_compare {
988 :			my $self = shift; my $student = shift; my $ans = shift;
989 :			my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
990 :	dpvc	3511	if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return}
991 :	dpvc	3504	$self->SUPER::cmp_compare($student,$ans,@_);
992 :	dpvc	3497	}
993 :	dpvc	2617
994 :	dpvc	2593	#############################################################
995 :
996 :	dpvc	2599	package Value::List;
997 :
998 :	dpvc	2621	sub cmp_defaults {
999 :			my $self = shift;
1000 :	dpvc	3206	my %options = (@_);
1001 :	dpvc	3207	my $element = Value::makeValue($self->{data}[0]);
1002 :			$element = Value::Formula->new($element) unless Value::isValue($element);
1003 :	dpvc	2621	return (
1004 :	dpvc	3206	Value::Real->cmp_defaults(@_),
1005 :	dpvc	2621	showHints => undef,
1006 :			showLengthHints => undef,
1007 :	dpvc	2661	showParenHints => undef,
1008 :	dpvc	2757	partialCredit => undef,
1009 :	dpvc	2621	ordered => 0,
1010 :			entry_type => undef,
1011 :	dpvc	2629	list_type => undef,
1012 :	dpvc	3207	typeMatch => $element,
1013 :	dpvc	3872	firstElement => $element,
1014 :	dpvc	3678	extra => undef,
1015 :	dpvc	2661	requireParenMatch => 1,
1016 :			removeParens => 1,
1017 :	dpvc	3869	implicitList => 1,
1018 :	dpvc	3487	);
1019 :	dpvc	2621	}
1020 :	dpvc	2599
1021 :	dpvc	2621	#
1022 :			# Match anything but formulas
1023 :			#
1024 :			sub typeMatch {return !ref($other) \|\| $other->class ne 'Formula'}
1025 :	dpvc	2599
1026 :	dpvc	2604	#
1027 :			# Handle removal of outermost parens in correct answer.
1028 :			#
1029 :			sub cmp {
1030 :			my $self = shift;
1031 :	dpvc	3696	my %params = @_;
1032 :	dpvc	2604	my $cmp = $self->SUPER::cmp(@_);
1033 :	dpvc	2661	if ($cmp->{rh_ans}{removeParens}) {
1034 :	dpvc	2604	$self->{open} = $self->{close} = '';
1035 :	dpvc	3172	$cmp->ans_hash(correct_ans => $self->stringify)
1036 :	dpvc	3696	unless defined($self->{correct_ans}) \|\| defined($params{correct_ans});
1037 :	dpvc	2604	}
1038 :			return $cmp;
1039 :			}
1040 :
1041 :	dpvc	2599	sub cmp_equal {
1042 :			my $self = shift; my $ans = shift;
1043 :	dpvc	2621	$ans->{showPartialCorrectAnswers} = $self->getPG('$showPartialCorrectAnswers');
1044 :
1045 :			#
1046 :			# get the paramaters
1047 :			#
1048 :	dpvc	3206	my $showHints = getOption($ans,'showHints');
1049 :			my $showLengthHints = getOption($ans,'showLengthHints');
1050 :	dpvc	3469	my $showParenHints = getOption($ans,'showParenHints');
1051 :	dpvc	3206	my $partialCredit = getOption($ans,'partialCredit');
1052 :	dpvc	2661	my $requireParenMatch = $ans->{requireParenMatch};
1053 :	dpvc	3869	my $implicitList = $ans->{implicitList};
1054 :	dpvc	3206	my $typeMatch = $ans->{typeMatch};
1055 :			my $value = $ans->{entry_type};
1056 :			my $ltype = $ans->{list_type} \|\| lc($self->type);
1057 :	dpvc	3469	my $stype = $ans->{short_type} \|\| $ltype;
1058 :	dpvc	2621
1059 :	dpvc	3678	$value = (Value::isValue($typeMatch)? lc($typeMatch->cmp_class): 'a value')
1060 :	dpvc	2621	unless defined($value);
1061 :	dpvc	2624	$value =~ s/(real\|complex) //; $ans->{cmp_class} = $value;
1062 :			$value =~ s/^an? //; $value = 'formula' if $value =~ m/formula/;
1063 :	dpvc	3469	$ltype =~ s/^an? //; $stype =~ s/^an? //;
1064 :	dpvc	3206	$showHints = $showLengthHints = 0 if $ans->{isPreview};
1065 :	dpvc	2599
1066 :	dpvc	2621	#
1067 :			# Get the lists of correct and student answers
1068 :	dpvc	2624	# (split formulas that return lists or unions)
1069 :	dpvc	2621	#
1070 :	dpvc	2661	my @correct = (); my ($cOpen,$cClose);
1071 :			if ($self->class ne 'Formula') {
1072 :			@correct = $self->value;
1073 :			$cOpen = $ans->{correct_value}{open}; $cClose = $ans->{correct_value}{close};
1074 :			} else {
1075 :			@correct = Value::List->splitFormula($self,$ans);
1076 :			$cOpen = $self->{tree}{open}; $cClose = $self->{tree}{close};
1077 :			}
1078 :			my $student = $ans->{student_value}; my @student = ($student);
1079 :			my ($sOpen,$sClose) = ('','');
1080 :	dpvc	2648	if (Value::isFormula($student) && $student->type eq $self->type) {
1081 :	dpvc	3869	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 :	dpvc	2661	} elsif ($student->class ne 'Formula' && $student->class eq $self->type) {
1088 :	dpvc	3869	if ($implicitList && $student->{open} ne '') {
1089 :			@student = ($student);
1090 :			} else {
1091 :			@student = @{$student->{data}};
1092 :			$sOpen = $student->{open}; $sClose = $student->{close};
1093 :			}
1094 :	dpvc	2621	}
1095 :	dpvc	2624	return if $ans->{split_error};
1096 :	dpvc	2661	#
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 :	dpvc	3469	else {$message .= "seem to be missing"}
1106 :	dpvc	2664	$self->cmp_Error($ans,$message) unless $ans->{isPreview};
1107 :	dpvc	2661	}
1108 :			return;
1109 :			}
1110 :	dpvc	2599
1111 :	dpvc	2621	#
1112 :	dpvc	3206	# Determine the maximum score
1113 :	dpvc	2621	#
1114 :	dpvc	2624	my $M = scalar(@correct);
1115 :	dpvc	2599	my $m = scalar(@student);
1116 :	dpvc	2624	my $maxscore = ($m > $M)? $m : $M;
1117 :	dpvc	3206
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 :	dpvc	3504	$value =~ s/( or\|,) /s$1 /g; # fix "interval or union"
1139 :	dpvc	3469	push(@errors,"There should be more ${value}s in your $stype")
1140 :	dpvc	3206	if ($score < $maxscore && $score == $m);
1141 :	dpvc	3469	push(@errors,"There should be fewer ${value}s in your $stype")
1142 :	dpvc	3206	if ($score < $maxscore && $score == $M && !$showHints);
1143 :			}
1144 :
1145 :			#
1146 :	dpvc	3497	# 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 :	dpvc	3206	# 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 :	dpvc	3207	my $error = join("\n",@errors); $error =~ s!</DIV>\n!</DIV>!g;
1163 :			$ans->{error_message} = $ans->{ans_message} = $error;
1164 :	dpvc	3206	}
1165 :
1166 :			#
1167 :			# Compare the contents of the list to see of they are equal
1168 :			#
1169 :			sub 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 :	dpvc	3872	my $extra = $ans->{extra} \|\|
1177 :			(Value::isValue($typeMatch) ? $typeMatch: $ans->{firstElement}) \|\|
1178 :			"Value::List";
1179 :	dpvc	3206	my $showHints = getOption($ans,'showHints') && !$ans->{isPreview};
1180 :			my $error = $$Value::context->{error};
1181 :	dpvc	2599	my $score = 0; my @errors; my $i = 0;
1182 :
1183 :	dpvc	2621	#
1184 :	dpvc	3206	# Check for empty lists
1185 :			#
1186 :			if (scalar(@correct) == 0) {$ans->score($m == 0); return}
1187 :
1188 :			#
1189 :	dpvc	2621	# Loop through student answers looking for correct ones
1190 :			#
1191 :	dpvc	2599	ENTRY: foreach my $entry (@student) {
1192 :	dpvc	3206	$i++; $$Value::context->clearError;
1193 :	dpvc	2605	$entry = Value::makeValue($entry);
1194 :	dpvc	2600	$entry = Value::Formula->new($entry) if !Value::isValue($entry);
1195 :	dpvc	3504
1196 :			#
1197 :			# Some words differ if ther eis only one entry in the student's list
1198 :			#
1199 :			my $nth = ''; my $answer = 'answer';
1200 :	dpvc	3678	my $class = $ans->{list_type} \|\| $ans->{cmp_class};
1201 :	dpvc	3504	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 :			#
1211 :	dpvc	2599	if ($ordered) {
1212 :	dpvc	3207	if (scalar(@correct)) {
1213 :	dpvc	3504	if (shift(@correct)->cmp_compare($entry,$ans,$nth,$value)) {$score++; next ENTRY}
1214 :	dpvc	3207	} else {
1215 :	dpvc	3872	# do syntax check
1216 :			if (ref($extra) eq 'CODE') {&$extra($entry,$ans,$nth,$value)}
1217 :			else {$extra->cmp_compare($entry,$ans,$nth,$value)}
1218 :	dpvc	3207	}
1219 :	dpvc	3206	if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
1220 :	dpvc	2599	} else {
1221 :			foreach my $k (0..$#correct) {
1222 :	dpvc	3504	if ($correct[$k]->cmp_compare($entry,$ans,$nth,$value)) {
1223 :	dpvc	2599	splice(@correct,$k,1);
1224 :			$score++; next ENTRY;
1225 :			}
1226 :	dpvc	3206	if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
1227 :	dpvc	2599	}
1228 :	dpvc	3504	$$Value::context->clearError;
1229 :	dpvc	3872	# do syntax check
1230 :			if (ref($extra) eq 'CODE') {&$extra($entry,$ans,$nth,$value)}
1231 :			else {$extra->cmp_compare($entry,$ans,$nth,$value)}
1232 :	dpvc	2599	}
1233 :	dpvc	2621	#
1234 :			# Give messages about incorrect answers
1235 :			#
1236 :	dpvc	3872	my $match = (ref($typeMatch) eq 'CODE')? &$typeMatch($entry,$ans) :
1237 :			$typeMatch->typeMatch($entry,$ans);
1238 :			if ($showTypeWarnings && !$match &&
1239 :			!($ans->{ignoreStrings} && $entry->class eq 'String')) {
1240 :	dpvc	2624	push(@errors,"Your$nth $answer isn't ".lc($class).
1241 :			" (it looks like ".lc($entry->showClass).")");
1242 :	dpvc	3504	} elsif ($error->{flag} && $ans->{showEqualErrors}) {
1243 :			my $message = $error->{message}; $message =~ s/\s+$//;
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)}
1248 :	dpvc	2621	} elsif ($showHints && $m > 1) {
1249 :			push(@errors,"Your$nth $value is incorrect");
1250 :	dpvc	2599	}
1251 :			}
1252 :
1253 :	dpvc	2621	#
1254 :	dpvc	3206	# Return the score and errors
1255 :	dpvc	2621	#
1256 :	dpvc	3206	return ($score,@errors);
1257 :	dpvc	2599	}
1258 :
1259 :			#
1260 :	dpvc	2624	# Split a formula that is a list or union into a
1261 :			# list of formulas (or Value objects).
1262 :			#
1263 :			sub splitFormula {
1264 :			my $self = shift; my $formula = shift; my $ans = shift;
1265 :			my @formula; my @entries;
1266 :	dpvc	3469	if ($formula->type eq 'Union') {@entries = $formula->{tree}->makeUnion}
1267 :			else {@entries = @{$formula->{tree}{coords}}}
1268 :	dpvc	2624	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 :	dpvc	2648	if (!defined($v)) {$ans->{split_error} = 1; $self->cmp_error; return}
1277 :	dpvc	2624	}
1278 :			return @formula;
1279 :			}
1280 :
1281 :			#
1282 :	dpvc	2621	# Return the value if it is defined, otherwise use a default
1283 :	dpvc	2599	#
1284 :			sub getOption {
1285 :	dpvc	2621	my $ans = shift; my $name = shift;
1286 :			my $value = $ans->{$name};
1287 :	dpvc	2599	return $value if defined($value);
1288 :	dpvc	2621	return $ans->{showPartialCorrectAnswers};
1289 :	dpvc	2599	}
1290 :
1291 :			#############################################################
1292 :
1293 :	dpvc	2593	package Value::Formula;
1294 :
1295 :	dpvc	2624	sub cmp_defaults {
1296 :			my $self = shift;
1297 :	dpvc	2626
1298 :	dpvc	2624	return (
1299 :			Value::Union::cmp_defaults($self,@_),
1300 :			typeMatch => Value::Formula->new("(1,2]"),
1301 :	dpvc	3257	showDomainErrors => 1,
1302 :	dpvc	2624	) if $self->type eq 'Union';
1303 :	dpvc	2622
1304 :	dpvc	2667	my $type = $self->type;
1305 :			$type = ($self->isComplex)? 'Complex': 'Real' if $type eq 'Number';
1306 :			$type = 'Value::'.$type.'::';
1307 :	dpvc	2624
1308 :	dpvc	3257	return (
1309 :			&{$type.'cmp_defaults'}($self,@_),
1310 :			upToConstant => 0,
1311 :			showDomainErrors => 1,
1312 :			) if defined(%$type) && $self->type ne 'List';
1313 :	dpvc	2667
1314 :	dpvc	3678	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 :	dpvc	2624	return (
1318 :			Value::List::cmp_defaults($self,@_),
1319 :	dpvc	2661	removeParens => $self->{autoFormula},
1320 :	dpvc	3678	typeMatch => $element,
1321 :	dpvc	3257	showDomainErrors => 1,
1322 :	dpvc	2624	);
1323 :			}
1324 :
1325 :			#
1326 :			# Get the types from the values of the formulas
1327 :			# and compare those.
1328 :			#
1329 :			sub 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 :	dpvc	2648	$other = eval {($other->createRandomPoints(1))[1]->[0]} if Value::isFormula($other);
1334 :	dpvc	2624	return 1 unless defined($other); # can't really tell, so don't report type mismatch
1335 :			$typeMatch->typeMatch($other,$ans);
1336 :			}
1337 :
1338 :	dpvc	2629	#
1339 :			# Handle removal of outermost parens in a list.
1340 :	dpvc	3715	# Evaluate answer, if the eval option is used.
1341 :			# Handle the UpToConstant option.
1342 :	dpvc	2629	#
1343 :			sub cmp {
1344 :			my $self = shift;
1345 :			my $cmp = $self->SUPER::cmp(@_);
1346 :	dpvc	2661	if ($cmp->{rh_ans}{removeParens} && $self->type eq 'List') {
1347 :	dpvc	2629	$self->{tree}{open} = $self->{tree}{close} = '';
1348 :	dpvc	3172	$cmp->ans_hash(correct_ans => $self->stringify)
1349 :			unless defined($self->{correct_ans});
1350 :	dpvc	2629	}
1351 :	dpvc	2799	if ($cmp->{rh_ans}{eval} && $self->isConstant) {
1352 :			$cmp->ans_hash(correct_value => $self->eval);
1353 :			return $cmp;
1354 :			}
1355 :	dpvc	2688	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 :	dpvc	3868	$context->variables->add('C0' => 'Parameter');
1360 :	dpvc	3217	my $f = Value::Formula->new('C0')+$self;
1361 :	dpvc	3257	for ('limits','test_points','test_values','num_points','granularity','resolution',
1362 :			'checkUndefinedPoints','max_undefined')
1363 :	dpvc	3217	{$f->{$_} = $self->{$_} if defined($self->{$_})}
1364 :			$cmp->ans_hash(correct_value => $f);
1365 :	dpvc	2688	Parser::Context->current(undef,$current);
1366 :			}
1367 :	dpvc	2629	return $cmp;
1368 :			}
1369 :
1370 :	dpvc	2622	sub cmp_equal {
1371 :	dpvc	2624	my $self = shift; my $ans = shift;
1372 :			#
1373 :			# Get the problem's seed
1374 :			#
1375 :	dpvc	2622	$self->{context}->flags->set(
1376 :			random_seed => $self->getPG('$PG_original_problemSeed')
1377 :			);
1378 :	dpvc	2624
1379 :			#
1380 :			# Use the list checker if the formula is a list or union
1381 :			# Otherwise use the normal checker
1382 :			#
1383 :	dpvc	3497	if ($self->type =~ m/^(List\|Union\|Set)$/) {
1384 :	dpvc	2624	Value::List::cmp_equal($self,$ans);
1385 :			} else {
1386 :			$self->SUPER::cmp_equal($ans);
1387 :			}
1388 :	dpvc	2622	}
1389 :
1390 :	dpvc	2667	sub cmp_postprocess {
1391 :			my $self = shift; my $ans = shift;
1392 :			return unless $ans->{score} == 0 && !$ans->{isPreview};
1393 :	dpvc	3257	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 :	dpvc	2667	my $other = $ans->{student_value};
1400 :	dpvc	3205	return if $ans->{ignoreStrings} && (!Value::isValue($other) \|\| $other->type eq 'String');
1401 :	dpvc	2667	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 :	dpvc	2671	$self->cmp_Error($ans,"The dimension of your result is incorrect");
1405 :	dpvc	2593	}
1406 :
1407 :	dpvc	3269	#
1408 :	dpvc	3715	# Diagnostics for Formulas
1409 :			#
1410 :			sub 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 :	dpvc	4143	#
1435 :			# Get the test points
1436 :			#
1437 :			my @names = $self->{context}->variables->names;
1438 :			my $vx = (keys(%{$self->{variables}}))[0];
1439 :			my $vi = 0; while ($names[$vi] ne $vx) {$vi++}
1440 :			my $points = [map {$_->[$vi]} @{$self->{test_points}}];
1441 :	dpvc	3715
1442 :			#
1443 :			# The graphs of the functions and errors
1444 :			#
1445 :			if ($formulas->{showGraphs}) {
1446 :			my @G = ();
1447 :			if ($formulas->{combineGraphs}) {
1448 :			push(@G,$self->cmp_graph($diagnostics,[$student,$self],
1449 :			title=>'Student Answer (red)<BR>Correct Answer (green)<BR>',
1450 :			points=>$points,showDomain=>1));
1451 :			} else {
1452 :			push(@G,$self->cmp_graph($diagnostics,$self,title=>'Correct Answer'));
1453 :			push(@G,$self->cmp_graph($diagnostics,$student,title=>'Student Answer'));
1454 :			}
1455 :			my $cutoff = Value::Formula->new($self->getFlag('tolerance'));
1456 :			if ($formulas->{graphAbsoluteErrors}) {
1457 :			push(@G,$self->cmp_graph($diagnostics,[abs($self-$student),$cutoff],
1458 :			clip=>$formulas->{clipAbsoluteError},
1459 :			title=>'Absolute Error',points=>$points));
1460 :			}
1461 :			if ($formulas->{graphRelativeErrors}) {
1462 :			push(@G,$self->cmp_graph($diagnostics,[abs(($self-$student)/$self),$cutoff],
1463 :			clip=>$formulas->{clipRelativeError},
1464 :			title=>'Relative Error',points=>$points));
1465 :			}
1466 :			$output .= '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0">'
1467 :			. '<TR VALIGN="TOP">'.join('<TD WIDTH="20"></TD>',@G).'</TR></TABLE>';
1468 :			}
1469 :
1470 :			#
1471 :			# The test points and values
1472 :			#
1473 :			my @rows = (); my $colsep = '</TD><TD WIDTH="20"></TD><TD ALIGN="RIGHT">';
1474 :			my @P = (map {(scalar(@{$_}) == 1)? $_->[0]: Value::Point->make(@{$_})} @{$self->{test_points}});
1475 :			my @i = sort {$P[$a] <=> $P[$b]} (0..$#P);
1476 :	dpvc	4143	foreach $p (@P) {if (Value::isValue($p) && $p->length > 2) {$p = $p->string; $p =~ s\|,\|,<br />\|g}}
1477 :			my $zeroLevelTol = $self->getFlag('zeroLevelTol');
1478 :			$self->{context}{flags}{zeroLevelTol} = 0; # always show full resolution in the tables below
1479 :			my $names = join(',',@names); $names = '('.$names.')' if scalar(@names) > 1;
1480 :	dpvc	3715	if ($formulas->{showTestPoints}) {
1481 :			$student->createPointValues($self->{test_points},0,1,1) unless $student->{test_values};
1482 :	dpvc	4143	my @p = ("$names:", (map {$P[$i[$_]]} (0..$#P)));
1483 :	dpvc	3715	push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,@p).'</TD></TR>');
1484 :			push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,("<HR>")x scalar(@p)).'</TD></TR>');
1485 :			push(@rows,'<TR><TD ALIGN="RIGHT">'
1486 :	dpvc	4143	.join($colsep,"Correct Answer:",
1487 :			map {Value::isNumber($self->{test_values}[$i[$_]])? $self->{test_values}[$i[$_]]: "undefined"} (0..$#P))
1488 :	dpvc	3715	.'</TD></TR>');
1489 :			my $test = $student->{test_values};
1490 :			push(@rows,'<TR><TD ALIGN="RIGHT">'
1491 :	dpvc	4143	.join($colsep,"Student Answer:",
1492 :			map {Value::isNumber($test->[$i[$_]])? $test->[$i[$_]]: "undefined"} (0..$#P))
1493 :	dpvc	3715	.'</TD></TR>');
1494 :			}
1495 :			#
1496 :			# The absolute errors (colored by whether they are ok or too big)
1497 :			#
1498 :			if ($formulas->{showAbsoluteErrors}) {
1499 :			my @p = ("Absolute Error:");
1500 :			my $tolerance = $self->getFlag('tolerance');
1501 :			my $tolType = $self->getFlag('tolType'); my $error;
1502 :			foreach my $j (0..$#P) {
1503 :			if (Value::isNumber($student->{test_values}[$i[$j]])) {
1504 :			$error = abs($self->{test_values}[$i[$j]]-$student->{test_values}[$i[$j]]);
1505 :	dpvc	4143	$error = '<SPAN STYLE="color:#'.($error->value<$tolerance ? '00AA00': 'AA0000').'">'.$error.'</SPAN>'
1506 :	dpvc	3715	if $tolType eq 'absolute';
1507 :			} else {$error = "---"}
1508 :			push(@p,$error);
1509 :			}
1510 :			push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,@p).'</TD></TR>');
1511 :			}
1512 :			#
1513 :	dpvc	4143	# The relative errors (colored by whether they are OK or too big)
1514 :	dpvc	3715	#
1515 :			if ($formulas->{showRelativeErrors}) {
1516 :			my @p = ("Relative Error:");
1517 :	dpvc	4143	my $tolerance = $self->getFlag('tolerance'); my $tol;
1518 :	dpvc	3715	my $tolType = $self->getFlag('tolType'); my $error;
1519 :	dpvc	4143	my $zeroLevel = $self->getFlag('zeroLevel');
1520 :	dpvc	3715	foreach my $j (0..$#P) {
1521 :			if (Value::isNumber($student->{test_values}[$i[$j]])) {
1522 :	dpvc	4143	my $c = $self->{test_values}[$i[$j]]; my $s = $student->{test_values}[$i[$j]];
1523 :			if (abs($c->value) < $zeroLevel \|\| abs($s->value) < $zeroLevel)
1524 :			{$error = abs($c-$s); $tol = $zeroLevelTol} else
1525 :			{$error = abs(($c-$s)/($c\|\|1E-10)); $tol = $tolerance}
1526 :			$error = '<SPAN STYLE="color:#'.($error < $tol ? '00AA00': 'AA0000').'">'.$error.'</SPAN>'
1527 :	dpvc	3715	if $tolType eq 'relative';
1528 :			} else {$error = "---"}
1529 :			push(@p,$error);
1530 :			}
1531 :			push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,@p).'</TD></TR>');
1532 :			}
1533 :	dpvc	4143	$self->{context}{flags}{zeroLevelTol} = $zeroLevelTol;
1534 :	dpvc	3715	#
1535 :			# Put the data into a table
1536 :			#
1537 :			if (scalar(@rows)) {
1538 :			$output .= '<p><HR><p><TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0">'
1539 :			. join('<TR><TD HEIGHT="3"></TD>',@rows)
1540 :			. '</TABLE>';
1541 :			}
1542 :			}
1543 :			#
1544 :			# Put all the diagnostic output into a frame
1545 :			#
1546 :			return unless $output;
1547 :			$output
1548 :			= '<TABLE BORDER="1" CELLSPACING="2" CELLPADDING="20" BGCOLOR="#F0F0F0">'
1549 :			. '<TR><TD ALIGN="LEFT"><B>Diagnostics for '.$self->string .':</B>'
1550 :			. '<P><CENTER>' . $output . '</CENTER></TD></TR></TABLE><P>';
1551 :			warn $output;
1552 :			}
1553 :
1554 :			#
1555 :			# Draw a graph from a given Formula object
1556 :			#
1557 :			sub cmp_graph {
1558 :			my $self = shift; my $diagnostics = shift;
1559 :			my $F1 = shift; my $F2; ($F1,$F2) = @{$F1} if (ref($F1) eq 'ARRAY');
1560 :			#
1561 :			# Get the various options
1562 :			#
1563 :			my %options = (title=>'',points=>[],@_);
1564 :			my $graphs = $diagnostics->{graphs};
1565 :			my $limits = $graphs->{limits}; $limits = $self->getFlag('limits',[-2,2]) unless $limits;
1566 :	dpvc	4143	$limits = $limits->[0] while ref($limits) eq 'ARRAY' && ref($limits->[0]) eq 'ARRAY';
1567 :	dpvc	3715	my $size = $graphs->{size}; $size = [$size,$size] unless ref($size) eq 'ARRAY';
1568 :			my $steps = $graphs->{divisions};
1569 :			my $points = $options{points}; my $clip = $options{clip};
1570 :			my ($my,$My) = (0,0); my ($mx,$Mx) = @{$limits};
1571 :			my $dx = ($Mx-$mx)/$steps; my $f; my $y;
1572 :
1573 :			#
1574 :			# Find the max and min values of the function
1575 :			#
1576 :			foreach $f ($F1,$F2) {
1577 :			next unless defined($f);
1578 :			unless (scalar(keys(%{$f->{variables}})) < 2) {
1579 :			warn "Only formulas with one variable can be graphed";
1580 :			return "";
1581 :			}
1582 :			if ($f->isConstant) {
1583 :			$y = $f->eval;
1584 :			$my = $y if $y < $my; $My = $y if $y > $My;
1585 :			} else {
1586 :			my $F = $f->perlFunction;
1587 :			foreach my $i (0..$steps-1) {
1588 :			$y = eval {&{$F}($mx+$i*$dx)}; next unless defined($y) && Value::isNumber($y);
1589 :			$my = $y if $y < $my; $My = $y if $y > $My;
1590 :			}
1591 :			}
1592 :			}
1593 :			$My = 1 if abs($My - $my) < 1E-5;
1594 :			$my = 1.1; $My = 1.1;
1595 :			if ($clip) {
1596 :			$my = -$clip if $my < -$clip;
1597 :			$My = $clip if $My > $clip;
1598 :			}
1599 :			$my = -$My/10 if $my > -$My/10; $My = -$my/10 if $My < -$my/10;
1600 :			my $a = Value::Real->new(($My-$my)/($Mx-$mx));
1601 :
1602 :			#
1603 :			# Create the graph itself, with suitable title
1604 :			#
1605 :			my $grf = $self->getPG('$_grf_ = {n => 0}');
1606 :			$grf->{Goptions} = [
1607 :			$mx,$my,$Mx,$My,
1608 :			axes => $graphs->{axes},
1609 :			grid => $graphs->{grid},
1610 :			size => $size,
1611 :			];
1612 :			$grf->{G} = $self->getPG('init_graph(@{$_grf_->{Goptions}})');
1613 :			$grf->{G}->imageName($grf->{G}->imageName.'-'.time()); # avoid browser cache
1614 :			$self->cmp_graph_function($grf,$F2,"green",$steps,$points) if defined($F2);
1615 :			$self->cmp_graph_function($grf,$F1,"red",$steps,$points);
1616 :			my $image = $self->getPG('alias(insertGraph($_grf_->{G}))');
1617 :			$image = '<IMG SRC="'.$image.'" WIDTH="'.$size->[0].'" HEIGHT="'.$size->[1].'" BORDER="0" STYLE="margin-bottom:5px">';
1618 :			my $title = $options{title}; $title .= '<DIV STYLE="margin-top:5px"></DIV>' if $title;
1619 :			$title .= "<SMALL>Domain: [$mx,$Mx]</SMALL><BR>" if $options{showDomain};
1620 :			$title .= "<SMALL>Range: [$my,$My]<BR>Aspect ratio: $a:1</SMALL>";
1621 :			return '<TD ALIGN="CENTER" VALIGN="TOP" NOWRAP>'.$image.'<BR>'.$title.'</TD>';
1622 :			}
1623 :
1624 :			#
1625 :			# Add a function to a graph object, and plot the points
1626 :			# that are used to test the function
1627 :			#
1628 :			sub cmp_graph_function {
1629 :			my $self = shift; my $grf = shift; my $F = shift;
1630 :			my $color = shift; my $steps = shift; my $points = shift;
1631 :			$grf->{n}++; my $Fn = "F".$grf->{n}; $grf->{$Fn} = $F; my $f;
1632 :			if ($F->isConstant) {
1633 :			my $y = $F->eval;
1634 :			$f = $self->getPG('new Fun(sub {'.$y.'},$_grf_->{G})');
1635 :			} else {
1636 :			my $X = (keys %{$F->{variables}})[0];
1637 :			$f = $self->getPG('new Fun(sub {Parser::Evaluate($_grf_->{'.$Fn.'},'.$X.'=>shift)},$_grf_->{G})');
1638 :			foreach my $x (@{$points}) {
1639 :			my $y = Parser::Evaluate($F,($X)=>$x); next unless defined($y) && Value::isNumber($y);
1640 :			$grf->{x} = $x; $grf->{y} = $y;
1641 :			my $C = $self->getPG('new Circle($_grf_->{x},$_grf_->{y},4,"'.$color.'","'.$color.'")');
1642 :			$grf->{G}->stamps($C);
1643 :			}
1644 :			}
1645 :			$f->color($color); $f->weight(2); $f->steps($steps);
1646 :			}
1647 :
1648 :			#
1649 :	dpvc	3269	# If an answer array was used, get the data from the
1650 :			# Matrix, Vector or Point, and format the array of
1651 :			# data using the original parameter
1652 :			#
1653 :			sub correct_ans {
1654 :			my $self = shift;
1655 :			return $self->SUPER::correct_ans unless $self->{ans_name};
1656 :			my @array = ();
1657 :			if ($self->{tree}->type eq 'Matrix') {
1658 :			foreach my $row (@{$self->{tree}{coords}}) {
1659 :			my @row = ();
1660 :			foreach my $x (@{$row->coords}) {push(@row,$x->string)}
1661 :			push(@array,[@row]);
1662 :			}
1663 :			} else {
1664 :			foreach my $x (@{$self->{tree}{coords}}) {push(@array,$x->string)}
1665 :			if ($self->{tree}{ColumnVector}) {foreach my $x (@array) {$x = [$x]}}
1666 :			else {@array = [@array]}
1667 :			}
1668 :	dpvc	3273	Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
1669 :	dpvc	3269	}
1670 :
1671 :			#
1672 :			# Get the size of the array and create the appropriate answer array
1673 :			#
1674 :			sub ANS_MATRIX {
1675 :			my $self = shift;
1676 :			my $extend = shift; my $name = shift;
1677 :			my $size = shift \|\| 5; my $type = $self->type;
1678 :			my $cols = $self->length; my $rows = 1; my $sep = ',';
1679 :			if ($type eq 'Matrix') {
1680 :			$sep = ''; $rows = $cols; $cols = $self->{tree}->typeRef->{entryType}{length};
1681 :			}
1682 :			if ($self->{tree}{ColumnVector}) {
1683 :			$sep = ""; $type = "Matrix";
1684 :			my $tmp = $rows; $rows = $cols; $cols = $tmp;
1685 :			$self->{ColumnVector} = 1;
1686 :			}
1687 :			my $def = ($self->{context} \|\| $$Value::context)->lists->get($type);
1688 :			my $open = $self->{open} \|\| $self->{tree}{open} \|\| $def->{open};
1689 :			my $close = $self->{close} \|\| $self->{tree}{close} \|\| $def->{close};
1690 :			$self->ans_matrix($extend,$name,$rows,$cols,$size,$open,$close,$sep);
1691 :			}
1692 :
1693 :			sub ans_array {
1694 :			my $self = shift;
1695 :			return $self->SUPER::ans_array(@_) unless $self->array_OK;
1696 :			$self->ANS_MATRIX(0,'',@_);
1697 :			}
1698 :			sub named_ans_array {
1699 :			my $self = shift;
1700 :			return $self->SUPER::named_ans_array(@_) unless $self->array_OK;
1701 :			$self->ANS_MATRIX(0,@_);
1702 :			}
1703 :			sub named_ans_array_extension {
1704 :			my $self = shift;
1705 :			return $self->SUPER::named_ans_array_extension(@_) unless $self->array_OK;
1706 :			$self->ANS_MATRIX(1,@_);
1707 :			}
1708 :
1709 :			sub array_OK {
1710 :			my $self = shift; my $tree = $self->{tree};
1711 :			return $tree->type =~ m/^(Point\|Vector\|Matrix)$/ && $tree->class eq 'List';
1712 :			}
1713 :
1714 :			#
1715 :			# Get an array of values from a Matrix, Vector or Point
1716 :			#
1717 :			sub value {
1718 :			my $self = shift;
1719 :			my @array = ();
1720 :			if ($self->{tree}->type eq 'Matrix') {
1721 :			foreach my $row (@{$self->{tree}->coords}) {
1722 :			my @row = ();
1723 :			foreach my $x (@{$row->coords}) {push(@row,Value::Formula->new($x))}
1724 :			push(@array,[@row]);
1725 :			}
1726 :			} else {
1727 :			foreach my $x (@{$self->{tree}->coords}) {
1728 :			push(@array,Value::Formula->new($x));
1729 :			}
1730 :			}
1731 :			return @array;
1732 :			}
1733 :
1734 :	dpvc	2593	#############################################################
1735 :
1736 :			1;

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9