[system] / trunk / pg / macros / contextOrdering.pl Repository: Repository Listing bbplugincoursesdistsnplrochestersystemwww

# Annotation of /trunk/pg/macros/contextOrdering.pl

 1 : dpvc 5959 =head1 NAME 2 : 3 : contextOrdering.pl - Parses ordered lists of letters like "B > A = C > D" 4 : 5 : =head1 DESCRIPTION 6 : 7 : This context provides a structured way to parse and check answers that 8 : are ordered lists of letters, where the letters are separated by 9 : greater-than signs or equal signs. The only operators allowed are > 10 : and =, and the only letters allowed are the ones you specify explicitly. 11 : 12 : To access the context, you must include 13 : 14 : loadMacros("contextOrdering.pl"); 15 : 16 : at the top of your problem file, and then specify the Ordering context: 17 : 18 : Context("Ordering"); 19 : 20 : There are two main ways to use the Ordering context. The first is to 21 : use the Ordering() command to generate your ordering. This command 22 : creates a context in which the proper letters are defined, and returns 23 : a MathObject that represents the ordering you have provided. For 24 : example, 25 : 26 : $ans = Ordering("B > A > C"); 27 : 28 : or 29 : 30 :$ans = Ordering(A => 2, B => 2.5, C => 1); 31 : 32 : would both produce the same ordering. The first form gives the 33 : ordering as the student must type it, and the second gives the 34 : ordering by specifying numeric values for the various letters that 35 : dpvc 5967 induce the resulting order. Note that equality is determined using 36 : dpvc 5959 the default tolerances for the Ordering context. You can change these 37 : using commands like the following: 38 : 39 : Context("Ordering"); 40 : Context()->flags->set(tolerance => .01, tolType => 'absolute'); 41 : 42 : If you want to allow lists of orderings, use the Ordering-List context: 43 : 44 : Context("Ordering-List"); 45 : $ans = Ordering("A > B , B = C"); 46 : 47 : Note that each Ordering() call uses its own copy of the current 48 : context. If you need to modify the actual context used, then use the 49 : context() method of the resulting object. 50 : 51 : The second method of generating orderings is to declare the letters 52 : you wish to use explicitly, and then build the Ordering objects using 53 : the standard Compute() method: 54 : 55 : Context("Ordering"); 56 : Letters("A","B","C","D"); 57 :$a = Compute("A > B = C"); 58 : $b = Compute("C > D"); 59 : 60 : Note that in this case, D is still a valid letter that students can 61 : enter in response to an answer checker for$a, and similarly for A and 62 : B with $b. Note also that both$a and $b use the same context, unlike 63 : orderings produced by calls to the Ordering() function. Changes to 64 : the current context WILL affect$a and $b. 65 : 66 : dpvc 5963 If the ordering contains duplicate letters (e.g., "A > B > A"), then a 67 : warning message will be issued. If not all the letters are used by 68 : the student, then that also produces a warning message. The latter 69 : can be controlled by the showMissingLetterHints flag to the cmp() 70 : method. For example: 71 : 72 : ANS(Ordering("A > B > C")->cmp(showMissingLetterHints => 0)); 73 : 74 : would prevent the message from being issued if the student submitted 75 : just "A > B". 76 : 77 : dpvc 5959 =cut 78 : 79 : loadMacros("MathObjects.pl"); 80 : 81 : sub _contextOrdering_init {context::Ordering::Init()} 82 : 83 : ########################################### 84 : # 85 : # The main Ordering routines 86 : # 87 : 88 : package context::Ordering; 89 : 90 : # 91 : # Here we set up the prototype contexts and define the needed 92 : # functions in the main:: namespace. Some error messages are 93 : # modified to read better for these contexts. 94 : # 95 : sub Init { 96 : my$context = $main::context{Ordering} = Parser::Context->getCopy("Numeric"); 97 :$context->{name} = "Ordering"; 98 : $context->parens->clear(); 99 :$context->variables->clear(); 100 : $context->constants->clear(); 101 :$context->operators->clear(); 102 : $context->functions->clear(); 103 :$context->strings->clear(); 104 : $context->operators->add( 105 : dpvc 5962 '>' => {precedence => 1.5, associativity => 'left', type => 'bin', class => 'context::Ordering::BOP::ordering'}, 106 : '=' => {precedence => 1.7, associativity => 'left', type => 'bin', class => 'context::Ordering::BOP::ordering'}, 107 : dpvc 5959 ); 108 : dpvc 5962$context->{parser}{String} = "context::Ordering::Parser::String"; 109 : $context->{parser}{Value} = "context::Ordering::Parser::Value"; 110 :$context->{value}{String} = "context::Ordering::Value::String"; 111 : dpvc 5960 $context->{value}{Ordering} = "context::Ordering::Value::Ordering"; 112 : dpvc 5959$context->strings->add('='=>{hidden=>1},'>'=>{hidden=>1}); 113 : $context->{error}{msg}{"Variable '%s' is not defined in this context"} = "'%s' is not defined in this context"; 114 :$context->{error}{msg}{"Unexpected character '%s'"} = "Can't use '%s' in this context"; 115 : $context->{error}{msg}{"Missing operand before '%s'"} = "Missing letter before '%s'"; 116 :$context->{error}{msg}{"Missing operand after '%s'"} = "Missing letter after '%s'"; 117 : 118 : $context =$main::context{'Ordering-List'} = $context->copy; 119 : dpvc 5969$context->{name} = 'Ordering-List'; 120 : dpvc 5959 $context->operators->redefine(',',from => "Full"); 121 :$context->{value}{List} = "context::Ordering::Value::List"; 122 : 123 : main::PG_restricted_eval('sub Letters {context::Ordering::Letters(@_)}'); 124 : main::PG_restricted_eval('sub Ordering {context::Ordering::Ordering(@_)}'); 125 : } 126 : 127 : # 128 : # A routine to set the letters allowed in this context. 129 : # (Old letters are cleared, and > and = are allowed, but hidden, 130 : # since they are used in the List() objects that implement the context). 131 : # 132 : sub Letters { 133 : my $context = (Value::isContext($_[0]) ? shift : main::Context()); 134 : my @strings; 135 : foreach my $x (@_) {push(@strings,$x => {isLetter => 1, caseSensitive => 1})} 136 : $context->strings->are(@strings); 137 :$context->strings->add('='=>{hidden=>1},'>'=>{hidden=>1}); 138 : } 139 : 140 : # 141 : # Create orderings from strings or lists of letter => value pairs. 142 : # A copy of the current context is created that contains the proper 143 : # letters, and the correct string is created and parsed into an 144 : # Ordering object. 145 : # 146 : sub Ordering { 147 : my $context = main::Context()->copy; my$string; 148 : Value->Error("The current context is not the Ordering context") 149 : unless $context->{name} =~ m/Ordering/; 150 : if (scalar(@_) == 1) { 151 :$string = shift; 152 : dpvc 5967 my $letters =$string; $letters =~ s/ //g; 153 : context::Ordering::Letters($context,split(/[>=]/,$letters)); 154 : dpvc 5959 } else { 155 : my %letter = @_; my @letters = keys %letter; 156 : context::Ordering::Letters($context,@letters); 157 : foreach my $x (@letters) {$letter{$x} = Value::Real->new($context,$letter{$x})} 158 : my @order = main::PGsort( 159 : sub {$letter{$_[0]} == $letter{$_[1]} ? $_[0] lt$_[1] : $letter{$_[0]} > $letter{$_[1]}}, 160 : @letters 161 : ); 162 : my $a = shift(@order); my$b; $string =$a; 163 : while ($b = shift(@order)) { 164 :$string .= ($letter{$a} == $letter{$b} ? " = " : " > ") . $b; 165 :$a = $b; 166 : } 167 : } 168 : return main::Formula($context,$string)->eval; 169 : } 170 : 171 : ############################################################# 172 : # 173 : # This is a Parser BOP used to create the Ordering objects 174 : # used internally. They are actually lists with the operator 175 : # and the two operands, and the comparisons is based on the 176 : # standard list comparisons. The operands are either the strings 177 : # for individual letters, or another Ordering object as a 178 : # nested List. 179 : # 180 : 181 : dpvc 5962 package context::Ordering::BOP::ordering; 182 : dpvc 5959 our @ISA = ('Parser::BOP'); 183 : 184 : sub class {"Ordering"} 185 : 186 : sub isOrdering { 187 : my$self = shift; my $obj = shift; my$class = $obj->class; 188 : dpvc 5962 return$class eq 'Ordering' || $obj->{def}{isLetter}; 189 : dpvc 5959 } 190 : 191 : sub _check { 192 : my$self = shift; 193 : dpvc 5968 $self->Error("Operands of %s must be letters",$self->{bop}) 194 : dpvc 5962 unless $self->isOrdering($self->{lop}) && $self->isOrdering($self->{rop}); 195 : $self->{letters} =$self->{lop}{letters}; # we modify {lop}{letters} this way, but that doesn't matter 196 : foreach my $x (keys %{$self->{rop}{letters}}) { 197 : if (defined($self->{letters}{$x})) { 198 : $self->{ref} =$self->{rop}{letters}{$x}; 199 : dpvc 5963$self->Error("Each letter may appear only once in an ordering"); 200 : dpvc 5962 } 201 : $self->{letters}{$x} = $self->{rop}{letters}{$x}; 202 : } 203 : dpvc 5959 } 204 : 205 : sub _eval { 206 : my $self = shift; 207 : dpvc 5963 my$ordering = $self->Package("Ordering")->new($self->context,$self->{bop},@_); 208 :$ordering->{letters} = $self->{letters}; 209 : return$ordering; 210 : dpvc 5959 } 211 : 212 : sub string { 213 : my $self = shift; 214 : return$self->{lop}->string." ".$self->{bop}." ".$self->{rop}->string; 215 : } 216 : 217 : sub TeX { 218 : my $self = shift; 219 : return$self->{lop}->TeX." ".$self->{bop}." ".$self->{rop}->TeX; 220 : } 221 : 222 : dpvc 5962 223 : dpvc 5959 ############################################################# 224 : # 225 : # This is the Value object used to implement the list That represents 226 : # one ordering operation. It is simply a normal Value::List with the 227 : # operator as the first entry and the two operands as the remaing 228 : # entries in the list. The new() method is overriden to make binary 229 : # trees of equal operators into flat sorted lists. We override the 230 : # List string and TeX methods so that they print correctly as binary 231 : # operators. The cmp_equal method is overriden to make sure the that 232 : # the lists are treated as a unit during answer checking. There is 233 : # also a routine for adding letters to the object's context. 234 : # 235 : 236 : package context::Ordering::Value::Ordering; 237 : our @ISA = ('Value::List'); 238 : 239 : # 240 : # Put all equal letters into one list and sort them 241 : # 242 : sub new { 243 : my $self = shift; 244 : my$context = (Value::isContext($_[0]) ? shift :$self->context); 245 : my $bop = shift; my @letters = @_; 246 : if ($bop eq '=') { 247 : if (Value::classMatch($letters[0],'Ordering') &&$letters[0]->{data}[0] eq '=') 248 : {@letters = ($letters[0]->value,$letters[1]); shift @letters} 249 : @letters = main::lex_sort(@letters); 250 : } 251 : return $self->SUPER::new($context,$bop,@letters); 252 : } 253 : 254 : sub string { 255 : my$self = shift; 256 : my ($bop,@rest) =$self->value; 257 : foreach my $x (@rest) {$x = $x->string}; 258 : return join("$bop ",@rest); 259 : } 260 : 261 : sub TeX { 262 : my $self = shift; 263 : my ($bop,@rest) = $self->value; 264 : foreach my$x (@rest) {$x =$x->TeX}; 265 : return join(" $bop ",@rest); 266 : } 267 : 268 : # 269 : # Make sure we do comparison as a list of lists (rather than as the 270 : # individual entries in the underlying Value::List that encodes 271 : # the ordering) 272 : # 273 : sub cmp_equal { 274 : dpvc 5962 my$self = shift; my $ans =$_[0]; 275 : dpvc 5959 $ans->{typeMatch} =$ans->{firstElement} = $self; 276 : dpvc 5963$ans->{correct_formula} = $self->{equation}; 277 : dpvc 5959$self = $ans->{correct_value} = Value::List->make($self); 278 : $ans->{student_value} = Value::List->make($ans->{student_value}) 279 : dpvc 5963 if Value::classMatch($ans->{student_value},'Ordering'); 280 : dpvc 5959 return$self->SUPER::cmp_equal(@_); 281 : } 282 : 283 : dpvc 5963 sub cmp_defaults { 284 : my $self = shift; 285 : return ( 286 :$self->SUPER::cmp_defaults(@_), 287 : showMissingLetterHints => 1, 288 : ); 289 : } 290 : 291 : sub cmp_postprocess { 292 : my $self = shift; my$ans = shift; 293 : return if $ans->{isPreview} ||$ans->{score} != 0; 294 : dpvc 5964 $self->cmp_Error($ans,"Your ordering should include all the letters") 295 : dpvc 5963 if $ans->{showMissingLetterHints} && 296 : scalar(keys %{$ans->{correct_formula}{tree}{letters}}) != 297 : scalar(keys %{$ans->{student_formula}{tree}{letters}}); 298 : } 299 : 300 : dpvc 5959 # 301 : # Add more letters to the ordering's context (so student answers 302 : # can include them even if they aren't in the correct answer). 303 : # 304 : sub AddLetters { 305 : my$self = shift; my $context =$self->context; 306 : my @strings; 307 : foreach my $x (@_) { 308 : push(@strings,$x => {isLetter => 1, caseSensitive => 1}) 309 : unless $context->strings->get($x); 310 : } 311 : $context->strings->add(@strings) if scalar(@strings); 312 : } 313 : 314 : ############################################################# 315 : # 316 : # This overrides the TeX method of the letters 317 : # so that they don't print using the \rm font. 318 : # 319 : 320 : package context::Ordering::Value::String; 321 : our @ISA = ('Value::String'); 322 : 323 : sub TeX {shift->value} 324 : 325 : 326 : ############################################################# 327 : # 328 : dpvc 5962 # Override Parser classes so that we can check for repeated letters 329 : # 330 : 331 : package context::Ordering::Parser::String; 332 : our @ISA = ('Parser::String'); 333 : 334 : # 335 : # Save the letters positional reference 336 : # 337 : sub new { 338 : my$self = shift; 339 : $self =$self->SUPER::new(@_); 340 : $self->{letters}{$self->{value}} = $self->{ref} if$self->{def}{isLetter}; 341 : return $self; 342 : } 343 : 344 : ######################### 345 : 346 : package context::Ordering::Parser::Value; 347 : our @ISA = ('Parser::Value'); 348 : 349 : # 350 : # Move letters to Value object 351 : # 352 : sub new { 353 : my$self = shift; 354 : $self =$self->SUPER::new(@_); 355 : dpvc 5964 $self->{letters} =$self->{value}{letters} if defined $self->{value}{letters}; 356 : dpvc 5962 return$self; 357 : } 358 : 359 : # 360 : # Return Ordering class if the object is one 361 : # 362 : sub class { 363 : my $self = shift; 364 : return "Ordering" if$self->{value}->classMatch('Ordering'); 365 : return $self->SUPER::class; 366 : } 367 : 368 : ############################################################# 369 : # 370 : dpvc 5959 # This overrides the cmp_equal method to make sure that 371 : # Ordering lists are put into nested lists (since the 372 : # underlying ordering is a list, we don't want the 373 : # list checker to test the individual parts of the list, 374 : # but rather the list as a whole). 375 : # 376 : 377 : package context::Ordering::Value::List; 378 : our @ISA = ('Value::List'); 379 : 380 : sub cmp_equal { 381 : my$self = shift; my $ans =$_[0]; 382 : $ans->{student_value} = Value::List->make($ans->{student_value}) 383 : if Value::classMatch($ans->{student_value},'Ordering'); 384 : return$self->SUPER::cmp_equal(@_); 385 : } 386 : dpvc 5962 387 : ############################################################# 388 : 389 : 1;