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

Revision 5060 - (view) (download) (as text)

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

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9