Parent Directory
| 
Revision Log
Check routine can now return an array rather than an array reference. (This requires pg/lib/Value/AnswerCheckers.pm to be at least version 1.80).
1 sub _parserMultiPart_init {} 2 3 # 4 # MultiPart objects let you tie several answer blanks to a single 5 # answer checker, so you can have the answer in one blank influence 6 # the answer in another. The MultiPart can produce either a single 7 # result in the answer results area, or a separate result for each 8 # blank. 9 # 10 # To create a MultiPart pass a list of answers to MultiPart() in the 11 # order they will appear in the problem. For example: 12 # 13 # $mp = MultiPart("x^2",-1,1); 14 # 15 # or 16 # 17 # $mp = MultiPart(Vector(1,1,1),Vector(2,2,2))->with(singleResult=>1); 18 # 19 # Then, use $mp->ans_rule to create answer blanks for the various parts 20 # just as you would ans_rule. You can pass the width of the blank, which 21 # defaults to 20 otherwise. For example: 22 # 23 # BEGIN_TEXT 24 # \(f(x)\) = \{$mp->ans_rule(20)\} produces the same value 25 # at \(x\) = \{$mp->ans_rule(10)\} as it does at \(x\) = \{$mp->ans_rule(10)\}. 26 # END_TEXT 27 # 28 # Finally, call $mp->cmp to produce the answer checker(s) used in the MultiPart. 29 # You need to provide a checker routine that will be called to determine if the 30 # answers are correct or not. The checker will only be called if the student 31 # answers have no syntax errors and their types match the types of the professor's 32 # answers, so you don't have to worry about handling bad data from the student 33 # (at least as far as typechecking goes). 34 # 35 # The checker routine should accept three parameters: a reference to the array 36 # of correct answers, a reference to the array of student answers, and a reference 37 # to the MultiPart itself. It should do whatever checking it needs to do and 38 # then return a score for the MultiPart as a whole (every answer blank will be 39 # given the same score), or a reference to an array of scores, one for each 40 # blank. The routine can set error messages via the MultiPart's setMessage() 41 # method (e.g., $mp->setMessage(1,"The function can't be the identity") would 42 # set the message for the first answer blank of the MultiPart), or can call 43 # Value::Error() to generate an error and die. 44 # 45 # The checker routine can be supplied either when the MultiPart is created, or 46 # when the cmp() method is called. For example: 47 # 48 # $mp = MultiPart("x^2",1,-1)->with( 49 # singleResult => 1, 50 # checker => sub { 51 # my ($correct,$student,$self) = @_; # get the parameters 52 # my ($f,$x1,$x2) = @{$student}; # extract the student answers 53 # Value::Error("Function can't be the identity") if ($f == 'x'); 54 # Value::Error("Function can't be constant") if ($f->isConstant); 55 # return $f->eval(x=>$x1) == $f->eval(x=>$x2); 56 # }, 57 # ); 58 # . 59 # . 60 # . 61 # ANS($mp->cmp); 62 # 63 # or 64 # 65 # $mp = MultiPart("x^2",1,-1)->with(singleResult=>1); 66 # sub check { 67 # my ($correct,$student,$self) = @_; # get the parameters 68 # my ($f,$x1,$x2) = @{$student}; # extract the student answers 69 # Value::Error("Function can't be the identity") if ($f == 'x'); 70 # Value::Error("Function can't be constant") if ($f->isConstant); 71 # return $f->eval(x=>$x1) == $f->eval(x=>$x2); 72 # }; 73 # . 74 # . 75 # . 76 # ANS($mp->cmp(checker=>~~&check)); 77 # 78 ###################################################################### 79 80 package MultiPart; 81 our @ISA = qw(Value); 82 83 our $count = 0; # counter for unique identifier for multi-parts 84 our $answerPrefix = "MuLtIpArT"; # answer rule prefix 85 our $separator = ';'; # separator for singleResult previews 86 87 # 88 # Create a new MultiPart item from a list of items. 89 # The items are converted if Value items, if they aren't already. 90 # You can set the following fields of the resulting item: 91 # 92 # checker => code a subroutine to be called to check the 93 # student answers. The routine is passed 94 # three parameters: a reference to the array 95 # or correct answers, a reference to the 96 # array of student answers, and a reference 97 # to the MultiPart object itself. The routine 98 # should return either a score or an array of 99 # scores (one for each student answer). 100 # 101 # singleResult => 0 or 1 whether to show only one entry in the 102 # results area at the top of the page, 103 # or one for each answer rule. 104 # (Default: 0) 105 # 106 # namedRules => 0 or 1 whether to use named rules or default 107 # rule names. Use named rules if you need 108 # to intersperse other rules with the 109 # ones for the MultiPart, in which case 110 # you must use NAMED_ANS not ANS. 111 # (Default: 0) 112 # 113 # checkTypes => 0 or 1 whether the types of the student and 114 # professor's answers must match exactly 115 # or just pass the usual type-match error 116 # checking (in which case, you should check 117 # the types before you use the data). 118 # (Default: 1) 119 # 120 # allowBlankAnswers=>0 or 1 whether to remove the blank-check prefilter 121 # from the answer checkers for the answer 122 # checkers used for type checking the student's 123 # answers. 124 # (Default: 0) 125 # 126 # separator => string the string to use between entries in the 127 # results area when singleResult is set. 128 # 129 # tex_separator => string same, but for the preview area. 130 # 131 my @ans_defaults = ( 132 checker => sub {0}, 133 showCoordinateHints => 0, 134 showEndpointHints => 0, 135 showEndTypeHints => 0, 136 ); 137 138 sub new { 139 my $self = shift; my $class = ref($self) || $self; 140 my @data = @_; my @cmp; 141 Value::Error("%s lists can't be empty",$class) if scalar(@data) == 0; 142 foreach my $x (@data) { 143 $x = Value::makeValue($x) unless Value::isValue($x); 144 push(@cmp,$x->cmp(@ans_defaults)); 145 } 146 bless { 147 data => [@data], cmp => [@cmp], ans => [], 148 part => 0, singleResult => 0, namedRules => 0, 149 checkTypes => 1, allowBlankAnswers => 0, 150 tex_separator => $separator.'\,', separator => $separator.' ', 151 context => $$Value::context, id => $answerPrefix.($count++), 152 }, $class; 153 } 154 155 # 156 # Creates an answer checker (or array of same) to be passed 157 # to ANS() or NAMED_ANS(). Any parameters are passed to 158 # the individual answer checkers. 159 # 160 sub cmp { 161 my $self = shift; my %options = @_; 162 foreach my $id ('checker','separator') { 163 if (defined($options{$id})) { 164 $self->{$id} = $options{$id}; 165 delete $options{$id}; 166 } 167 } 168 die "You must supply a checker subroutine" unless ref($self->{checker}) eq 'CODE'; 169 if ($self->{allowBlankAnswers}) { 170 foreach my $cmp (@{$self->{cmp}}) { 171 $cmp->install_pre_filter('erase'); 172 $cmp->install_pre_filter(sub { 173 my $ans = shift; 174 $ans->{student_ans} =~ s/^\s+//g; 175 $ans->{student_ans} =~ s/\s+$//g; 176 return $ans; 177 }); 178 } 179 } 180 my @cmp = (); 181 if ($self->{singleResult}) { 182 push(@cmp,$self->ANS_NAME(0)) if $self->{namedRules}; 183 push(@cmp,$self->single_cmp(%options)); 184 } else { 185 foreach my $i (0..$self->length-1) { 186 push(@cmp,$self->ANS_NAME($i)) if $self->{namedRules}; 187 push(@cmp,$self->entry_cmp($i,%options)); 188 } 189 } 190 return @cmp; 191 } 192 193 ###################################################################### 194 195 # 196 # Get the answer checker used for when all the answers are treated 197 # as a single result. 198 # 199 sub single_cmp { 200 my $self = shift; my @correct; 201 foreach my $cmp (@{$self->{cmp}}) {push(@correct,$cmp->{rh_ans}{correct_ans})} 202 my $ans = new AnswerEvaluator; 203 $ans->ans_hash( 204 correct_ans => join($self->{separator},@correct), 205 type => "MultiPart", 206 @_, 207 ); 208 $ans->install_evaluator(sub {my $ans = shift; (shift)->single_check($ans)},$self); 209 $ans->install_pre_filter('erase'); # don't do blank check 210 return $ans; 211 } 212 213 # 214 # Check the answers when they are treated as a single result. 215 # 216 # First, call individual answer checkers to get any type-check errors 217 # Then perform the user's checker routine 218 # Finally collect the individual answers and errors and combine 219 # them for the single result. 220 # 221 sub single_check { 222 my $self = shift; my $ans = shift; 223 my $inputs = $main::inputs_ref; 224 $self->{ans}[0] = $self->{cmp}[0]->evaluate($ans->{student_ans}); 225 foreach my $i (1..$self->length-1) 226 {$self->{ans}[$i] = $self->{cmp}[$i]->evaluate($inputs->{$self->ANS_NAME($i)})} 227 my $score = 0; my (@errors,@student,@latex,@text); 228 my $i = 0; my $nonblank = 0; 229 if ($self->perform_check) { 230 push(@errors,$self->{ans}[0]{ans_message}); 231 $self->{ans}[0]{ans_message} = ""; 232 } 233 foreach my $result (@{$self->{ans}}) { 234 $i++; $nonblank |= ($result->{student_ans} =~ m/\S/); 235 push(@latex,check_string($result->{preview_latex_string},'\_\_')); 236 push(@text,check_string($result->{preview_text_string},'__')); 237 push(@student,check_string($result->{student_ans},'__')); 238 if ($result->{ans_message}) { 239 push(@errors,'<TR VALIGN="TOP"><TD STYLE="text-align:right; border:0px" NOWRAP>' . 240 "<I>In answer $i</I>: </TD>". 241 '<TD STYLE="text-align:left; border:0px">'.$result->{ans_message}.'</TD></TR>'); 242 } else {$score += $result->{score}} 243 } 244 $ans->score($score/$self->length); 245 $ans->{ans_message} = $ans->{error_message} = ""; 246 if (scalar(@errors)) { 247 $ans->{ans_message} = $ans->{error_message} = 248 '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout">' . 249 join('<TR><TD HEIGHT="4"></TD></TR>',@errors). 250 '</TABLE>'; 251 } 252 if ($nonblank) { 253 $ans->{preview_latex_string} = '{'.join('}'.$self->{tex_separator}.'{',@latex).'}'; 254 $ans->{preview_text_string} = join($self->{separator},@text); 255 $ans->{student_ans} = join($self->{separator},@student); 256 } 257 return $ans; 258 } 259 260 # 261 # Return a given string or a default if it is empty or not defined 262 # 263 sub check_string { 264 my $s = shift; 265 $s = shift unless defined($s) && $s =~ m/\S/; 266 return $s; 267 } 268 269 ###################################################################### 270 271 # 272 # Answer checker to use for individual entries when singleResult 273 # is not in effect. 274 # 275 sub entry_cmp { 276 my $self = shift; my $i = shift; 277 my $ans = new AnswerEvaluator; 278 $ans->ans_hash( 279 correct_ans => $self->{cmp}[$i]{rh_ans}{correct_ans}, 280 part => $i, 281 type => "MultiPart($i)", 282 @_, 283 ); 284 $ans->install_evaluator(sub {my $ans = shift; (shift)->entry_check($ans)},$self); 285 $ans->install_pre_filter('erase'); # don't do blank check 286 return $ans; 287 } 288 289 # 290 # Call the correct answser's checker to check for syntax and type errors. 291 # If this is the last one, perform the user's checker routine as well 292 # Return the individual answer (our answer hash is discarded). 293 # 294 sub entry_check { 295 my $self = shift; my $ans = shift; 296 my $i = $ans->{part}; 297 $self->{ans}[$i] = $self->{cmp}[$i]->evaluate($ans->{student_ans}); 298 $self->{ans}[$i]->score(0); 299 $self->perform_check($ans) if ($i == $self->length - 1); 300 return $self->{ans}[$i]; 301 } 302 303 ###################################################################### 304 305 # 306 # Collect together the correct and student answers, and call the 307 # user's checker routine. 308 # 309 # If any of the answers produced errors or the types don't match 310 # don't call the user's routine. 311 # Otherwise, call it, and if there was an error, report that. 312 # Set the individual scores based on the result from the user's routine. 313 # 314 sub perform_check { 315 my $self = shift; my $rh_ans = shift; 316 $self->{context}->clearError; 317 my @correct; my @student; 318 foreach my $ans (@{$self->{ans}}) { 319 push(@correct,$ans->{correct_value}); 320 push(@student,$ans->{student_value}); 321 return if $ans->{ans_message} ne "" || !defined($ans->{student_value}); 322 return if $self->{checkTypes} && $ans->{student_value}->type ne $ans->{correct_value}->type; 323 } 324 my @result = Value::cmp_compare([@correct],[@student],$self,$rh_ans); 325 if (!defined(@result) && $self->{context}{error}{flag}) {$self->cmp_error($self->{ans}[0]); return 1} 326 my $result = (scalar(@result) > 1 ? [@result] : $result[0] || 0); 327 if (ref($result) eq 'ARRAY') { 328 die "Checker subroutine returned the wrong number of results" 329 if (scalar(@{$result}) != $self->length); 330 foreach my $i (0..$self->length-1) {$self->{ans}[$i]->score($result->[$i])} 331 } elsif (Value::matchNumber($result)) { 332 foreach my $ans (@{$self->{ans}}) {$ans->score($result)} 333 } else { 334 die "Checker subroutine should return a number or array of numbers ($result)"; 335 } 336 return; 337 } 338 339 ###################################################################### 340 341 # 342 # The user's checker can call setMessage(n,message) to set the error message 343 # for the n-th answer blank. 344 # 345 sub setMessage { 346 my $self = shift; my $i = (shift)-1; my $message = shift; 347 $self->{ans}[$i]->{ans_message} = $self->{ans}[$i]->{error_message} = $message; 348 } 349 350 351 ###################################################################### 352 353 # 354 # Produce the name for a named answer blank 355 # 356 sub ANS_NAME { 357 my $self = shift; my $i = shift; 358 $self->{id}.'_'.$i; 359 } 360 361 # 362 # Record an answer-blank name (when using extensions) 363 # 364 sub NEW_NAME { 365 my $self = shift; 366 main::RECORD_FORM_LABEL(shift); 367 } 368 369 # 370 # Produce an answer rule for the next item in the list, 371 # taking care to use names or extensions as needed 372 # by the settings of the MultiPart. 373 # 374 sub ans_rule { 375 my $self = shift; my $size = shift || 20; 376 my $data = $self->{data}[$self->{part}]; 377 my $name = $self->ANS_NAME($self->{part}++); 378 return $data->named_ans_rule_extension($self->NEW_NAME($name),$size,@_) 379 if ($self->{singleResult} && $self->{part} > 1); 380 return $data->ans_rule($size,@_) unless $self->{namedRules}; 381 return $data->named_ans_rule($name,$size,@_); 382 } 383 384 # 385 # Do the same, but for answer arrays, which are generated by the 386 # Value objects automatically sized to suit their data. 387 # Reset the correct_ans once the array is made 388 # 389 sub ans_array { 390 my $self = shift; my $size = shift || 5; my $HTML; 391 my $data = $self->{data}[$self->{part}]; 392 my $name = $self->ANS_NAME($self->{part}++); 393 if ($self->{singleResult} && $self->{part} > 1) { 394 $HTML = $data->named_ans_array_extension($self->NEW_NAME($name),$size,@_); 395 } elsif (!$self->{namedRules}) { 396 $HTML = $data->ans_array($size,@_); 397 } else { 398 $HTML = $data->named_ans_array($name,$size,@_); 399 } 400 $self->{cmp}[$self->{part}-1] = $data->cmp(@ans_defaults); 401 return $HTML; 402 } 403 404 ###################################################################### 405 406 package main; 407 408 # 409 # Main routine to create MultiPart items. 410 # 411 sub MultiPart {MultiPart->new(@_)}; 412 413 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |