| … | |
… | |
| 17 | # Create an answer checker for the given type of object |
17 | # Create an answer checker for the given type of object |
| 18 | # |
18 | # |
| 19 | |
19 | |
| 20 | our $cmp_defaults = { |
20 | our $cmp_defaults = { |
| 21 | showTypeWarnings => 1, |
21 | showTypeWarnings => 1, |
|
|
22 | showEqualErrors => 1, |
| 22 | }; |
23 | }; |
| 23 | |
24 | |
| 24 | sub cmp { |
25 | sub cmp { |
| 25 | my $self = shift; |
26 | my $self = shift; |
| 26 | my $ans = new AnswerEvaluator; |
27 | my $ans = new AnswerEvaluator; |
| … | |
… | |
| 79 | sub cmp_equal { |
80 | sub cmp_equal { |
| 80 | my $self = shift; my $ans = shift; |
81 | my $self = shift; my $ans = shift; |
| 81 | my $v = $ans->{correct_value}; |
82 | my $v = $ans->{correct_value}; |
| 82 | my $V = $ans->{student_value}; |
83 | my $V = $ans->{student_value}; |
| 83 | if ($v->typeMatch($V,$ans)) { |
84 | if ($v->typeMatch($V,$ans)) { |
| 84 | $ans->score(1) if (eval {$v == $V}); # let the overloaded == do the check |
85 | my $equal = eval {$v == $V}; # let the overloaded == do the check |
|
|
86 | if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return} |
|
|
87 | my $cmp_error = $ans->{cmp_error} || 'cmp_error'; |
|
|
88 | $self->$cmp_error($ans); |
| 85 | } else { |
89 | } else { |
| 86 | $ans->{ans_message} = $ans->{error_message} = |
90 | $ans->{ans_message} = $ans->{error_message} = |
| 87 | "Your answer isn't ".$v->showClass." (it looks like ".$V->showClass.")" |
91 | "Your answer isn't ".$v->showClass." (it looks like ".$V->showClass.")" |
| 88 | if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message}; |
92 | if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message}; |
| 89 | } |
93 | } |
| … | |
… | |
| 150 | showDimensionWarnings => 1, |
154 | showDimensionWarnings => 1, |
| 151 | }; |
155 | }; |
| 152 | |
156 | |
| 153 | sub typeMatch { |
157 | sub typeMatch { |
| 154 | my $self = shift; my $other = shift; my $ans = shift; |
158 | my $self = shift; my $other = shift; my $ans = shift; |
| 155 | return 0 unless $other->type eq 'Vector'; |
159 | return 0 unless $other->type eq 'Point'; |
| 156 | if (!$ans->{isPreview} && $ans->{showDimensionWarnings} && |
160 | if (!$ans->{isPreview} && $ans->{showDimensionWarnings} && |
| 157 | $self->length != $other->length) { |
161 | $self->length != $other->length) { |
| 158 | $ans->{ans_message} = $ans->{error_message} = "The dimension is incorrect"; |
162 | $ans->{ans_message} = $ans->{error_message} = "The dimension is incorrect"; |
| 159 | return 0; |
163 | return 0; |
| 160 | } |
164 | } |
| … | |
… | |
| 166 | package Value::Vector; |
170 | package Value::Vector; |
| 167 | |
171 | |
| 168 | our $cmp_defaults = { |
172 | our $cmp_defaults = { |
| 169 | %{$Value::cmp_defaults}, |
173 | %{$Value::cmp_defaults}, |
| 170 | showDimensionWarnings => 1, |
174 | showDimensionWarnings => 1, |
|
|
175 | promotePoints => 0, |
| 171 | }; |
176 | }; |
| 172 | |
177 | |
| 173 | sub typeMatch { |
178 | sub typeMatch { |
| 174 | my $self = shift; my $other = shift; my $ans = shift; |
179 | my $self = shift; my $other = shift; my $ans = shift; |
| 175 | return 0 unless $other->type eq 'Vector'; |
180 | return 0 unless $other->type eq 'Vector' || |
|
|
181 | ($ans->{promotePoints} && $other->type eq 'Point'); |
| 176 | if (!$ans->{isPreview} && $ans->{showDimensionWarnings} && |
182 | if (!$ans->{isPreview} && $ans->{showDimensionWarnings} && |
| 177 | $self->length != $other->length) { |
183 | $self->length != $other->length) { |
| 178 | $ans->{ans_message} = $ans->{error_message} = "The dimension is incorrect"; |
184 | $ans->{ans_message} = $ans->{error_message} = "The dimension is incorrect"; |
| 179 | return 0; |
185 | return 0; |
| 180 | } |
186 | } |
| … | |
… | |
| 214 | |
220 | |
| 215 | ############################################################# |
221 | ############################################################# |
| 216 | |
222 | |
| 217 | package Value::Interval; |
223 | package Value::Interval; |
| 218 | |
224 | |
|
|
225 | ## @@@ report interval-type mismatch? @@@ |
|
|
226 | |
|
|
227 | sub typeMatch { |
|
|
228 | my $self = shift; my $other = shift; |
|
|
229 | return $other->length == 2 && |
|
|
230 | ($other->{open} eq '(' || $other->{open} eq '[') && |
|
|
231 | ($other->{close} eq ')' || $other->{close} eq ']') |
|
|
232 | if $other->type =~ m/^(Point|List)$/; |
|
|
233 | $other->type =~ m/^(Interval|Union)$/; |
|
|
234 | } |
|
|
235 | |
|
|
236 | ############################################################# |
|
|
237 | |
|
|
238 | package Value::Union; |
|
|
239 | |
| 219 | sub typeMatch { |
240 | sub typeMatch { |
| 220 | my $self = shift; my $other = shift; |
241 | my $self = shift; my $other = shift; |
| 221 | return $other->length == 2 if $other->type eq 'Point'; |
242 | return $other->length == 2 if $other->type eq 'Point'; |
| 222 | $other->type =~ m/^(Interval|Union)/; |
243 | $other->type =~ m/^(Interval|Union)/; |
| 223 | } |
244 | } |
| 224 | |
245 | |
| 225 | ############################################################# |
246 | ############################################################# |
| 226 | |
247 | |
| 227 | package Value::Union; |
|
|
| 228 | |
|
|
| 229 | sub typeMatch { |
|
|
| 230 | my $self = shift; my $other = shift; |
|
|
| 231 | return $other->length == 2 if $other->type eq 'Point'; |
|
|
| 232 | $other->type =~ m/^(Interval|Union)/; |
|
|
| 233 | } |
|
|
| 234 | |
|
|
| 235 | ############################################################# |
|
|
| 236 | |
|
|
| 237 | package Value::Formula; |
248 | package Value::Formula; |
| 238 | |
249 | |
| 239 | # |
250 | # |
| 240 | # No cmp function (for now) |
251 | # No cmp function (for now) |
| 241 | # |
252 | # |
Parent Directory
| 
Revision Log
| 
Patch