[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 : determine the resulting order. Note that equality is determined using 36 : 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 : =cut 67 : 68 : loadMacros("MathObjects.pl"); 69 : 70 : sub _contextOrdering_init {context::Ordering::Init()} 71 : 72 : ########################################### 73 : # 74 : # The main Ordering routines 75 : # 76 : 77 : package context::Ordering; 78 : 79 : # 80 : # Here we set up the prototype contexts and define the needed 81 : # functions in the main:: namespace. Some error messages are 82 : # modified to read better for these contexts. 83 : # 84 : sub Init { 85 : my$context = $main::context{Ordering} = Parser::Context->getCopy("Numeric"); 86 :$context->{name} = "Ordering"; 87 : $context->parens->clear(); 88 :$context->variables->clear(); 89 : $context->constants->clear(); 90 :$context->operators->clear(); 91 : $context->functions->clear(); 92 :$context->strings->clear(); 93 : $context->operators->add( 94 : dpvc 5962 '>' => {precedence => 1.5, associativity => 'left', type => 'bin', class => 'context::Ordering::BOP::ordering'}, 95 : '=' => {precedence => 1.7, associativity => 'left', type => 'bin', class => 'context::Ordering::BOP::ordering'}, 96 : dpvc 5959 ); 97 : dpvc 5962$context->{parser}{String} = "context::Ordering::Parser::String"; 98 : $context->{parser}{Value} = "context::Ordering::Parser::Value"; 99 :$context->{parser}{BOP} = "context::Ordering::Parser::BOP"; 100 : $context->{value}{String} = "context::Ordering::Value::String"; 101 : dpvc 5960$context->{value}{Ordering} = "context::Ordering::Value::Ordering"; 102 : dpvc 5959 $context->strings->add('='=>{hidden=>1},'>'=>{hidden=>1}); 103 :$context->{error}{msg}{"Variable '%s' is not defined in this context"} = "'%s' is not defined in this context"; 104 : $context->{error}{msg}{"Unexpected character '%s'"} = "Can't use '%s' in this context"; 105 :$context->{error}{msg}{"Missing operand before '%s'"} = "Missing letter before '%s'"; 106 : $context->{error}{msg}{"Missing operand after '%s'"} = "Missing letter after '%s'"; 107 : 108 :$context = $main::context{'Ordering-List'} =$context->copy; 109 : $context->{name} eq 'Ordering-List'; 110 :$context->operators->redefine(',',from => "Full"); 111 : $context->{value}{List} = "context::Ordering::Value::List"; 112 : 113 : main::PG_restricted_eval('sub Letters {context::Ordering::Letters(@_)}'); 114 : main::PG_restricted_eval('sub Ordering {context::Ordering::Ordering(@_)}'); 115 : } 116 : 117 : # 118 : # A routine to set the letters allowed in this context. 119 : # (Old letters are cleared, and > and = are allowed, but hidden, 120 : # since they are used in the List() objects that implement the context). 121 : # 122 : sub Letters { 123 : my$context = (Value::isContext($_[0]) ? shift : main::Context()); 124 : my @strings; 125 : foreach my$x (@_) {push(@strings, $x => {isLetter => 1, caseSensitive => 1})} 126 :$context->strings->are(@strings); 127 : $context->strings->add('='=>{hidden=>1},'>'=>{hidden=>1}); 128 : } 129 : 130 : # 131 : # Create orderings from strings or lists of letter => value pairs. 132 : # A copy of the current context is created that contains the proper 133 : # letters, and the correct string is created and parsed into an 134 : # Ordering object. 135 : # 136 : sub Ordering { 137 : my$context = main::Context()->copy; my $string; 138 : Value->Error("The current context is not the Ordering context") 139 : unless$context->{name} =~ m/Ordering/; 140 : if (scalar(@_) == 1) { 141 : $string = shift; 142 : my$letters = $string;$letters =~ s/[^A-Z]//ig; 143 : context::Ordering::Letters($context,split(//,$letters)); 144 : } else { 145 : my %letter = @_; my @letters = keys %letter; 146 : context::Ordering::Letters($context,@letters); 147 : foreach my$x (@letters) {$letter{$x} = Value::Real->new($context,$letter{$x})} 148 : my @order = main::PGsort( 149 : sub {$letter{$_[0]} ==$letter{$_[1]} ?$_[0] lt $_[1] :$letter{$_[0]} >$letter{$_[1]}}, 150 : @letters 151 : ); 152 : my$a = shift(@order); my $b;$string = $a; 153 : while ($b = shift(@order)) { 154 : $string .= ($letter{$a} ==$letter{$b} ? " = " : " > ") .$b; 155 : $a =$b; 156 : } 157 : } 158 : return main::Formula($context,$string)->eval; 159 : } 160 : 161 : ############################################################# 162 : # 163 : # This is a Parser BOP used to create the Ordering objects 164 : # used internally. They are actually lists with the operator 165 : # and the two operands, and the comparisons is based on the 166 : # standard list comparisons. The operands are either the strings 167 : # for individual letters, or another Ordering object as a 168 : # nested List. 169 : # 170 : 171 : dpvc 5962 package context::Ordering::BOP::ordering; 172 : dpvc 5959 our @ISA = ('Parser::BOP'); 173 : 174 : sub class {"Ordering"} 175 : 176 : sub isOrdering { 177 : my $self = shift; my$obj = shift; my $class =$obj->class; 178 : dpvc 5962 return $class eq 'Ordering' ||$obj->{def}{isLetter}; 179 : dpvc 5959 } 180 : 181 : sub _check { 182 : my $self = shift; 183 : dpvc 5962$self->Error("Operators of %s must be letters",$self->{bop}) 184 : unless$self->isOrdering($self->{lop}) &&$self->isOrdering($self->{rop}); 185 :$self->{letters} = $self->{lop}{letters}; # we modify {lop}{letters} this way, but that doesn't matter 186 : foreach my$x (keys %{$self->{rop}{letters}}) { 187 : if (defined($self->{letters}{$x})) { 188 :$self->{ref} = $self->{rop}{letters}{$x}; 189 : $self->Error("Letters can appear only once in an ordering"); 190 : } 191 :$self->{letters}{$x} =$self->{rop}{letters}{$x}; 192 : } 193 :$self->{equation}{letters} = $self->{letters}; # removed by context::Ordering::Parser::BOP; 194 : dpvc 5959 } 195 : 196 : sub _eval { 197 : my$self = shift; 198 : dpvc 5960 return $self->Package("Ordering")->new($self->context,$self->{bop},@_); 199 : dpvc 5959 } 200 : 201 : sub string { 202 : my$self = shift; 203 : return $self->{lop}->string." ".$self->{bop}." ".$self->{rop}->string; 204 : } 205 : 206 : sub TeX { 207 : my$self = shift; 208 : return $self->{lop}->TeX." ".$self->{bop}." ".$self->{rop}->TeX; 209 : } 210 : 211 : dpvc 5962 212 : dpvc 5959 ############################################################# 213 : # 214 : # This is the Value object used to implement the list That represents 215 : # one ordering operation. It is simply a normal Value::List with the 216 : # operator as the first entry and the two operands as the remaing 217 : # entries in the list. The new() method is overriden to make binary 218 : # trees of equal operators into flat sorted lists. We override the 219 : # List string and TeX methods so that they print correctly as binary 220 : # operators. The cmp_equal method is overriden to make sure the that 221 : # the lists are treated as a unit during answer checking. There is 222 : # also a routine for adding letters to the object's context. 223 : # 224 : 225 : package context::Ordering::Value::Ordering; 226 : our @ISA = ('Value::List'); 227 : 228 : # 229 : # Put all equal letters into one list and sort them 230 : # 231 : sub new { 232 : my$self = shift; 233 : my $context = (Value::isContext($_[0]) ? shift : $self->context); 234 : my$bop = shift; my @letters = @_; 235 : if ($bop eq '=') { 236 : if (Value::classMatch($letters[0],'Ordering') && $letters[0]->{data}[0] eq '=') 237 : {@letters = ($letters[0]->value,$letters[1]); shift @letters} 238 : @letters = main::lex_sort(@letters); 239 : } 240 : return$self->SUPER::new($context,$bop,@letters); 241 : } 242 : 243 : sub string { 244 : my $self = shift; 245 : my ($bop,@rest) = $self->value; 246 : foreach my$x (@rest) {$x =$x->string}; 247 : return join(" $bop ",@rest); 248 : } 249 : 250 : sub TeX { 251 : my$self = shift; 252 : my ($bop,@rest) =$self->value; 253 : foreach my $x (@rest) {$x = $x->TeX}; 254 : return join("$bop ",@rest); 255 : } 256 : 257 : # 258 : # Make sure we do comparison as a list of lists (rather than as the 259 : # individual entries in the underlying Value::List that encodes 260 : # the ordering) 261 : # 262 : sub cmp_equal { 263 : dpvc 5962 my $self = shift; my$ans = $_[0]; 264 : dpvc 5959$ans->{typeMatch} = $ans->{firstElement} =$self; 265 : $self =$ans->{correct_value} = Value::List->make($self); 266 :$ans->{student_value} = Value::List->make($ans->{student_value}) 267 : if Value::classMatch($ans->{student_value},'Ordering'); 268 : return $self->SUPER::cmp_equal(@_); 269 : } 270 : 271 : # 272 : # Add more letters to the ordering's context (so student answers 273 : # can include them even if they aren't in the correct answer). 274 : # 275 : sub AddLetters { 276 : my$self = shift; my $context =$self->context; 277 : my @strings; 278 : foreach my $x (@_) { 279 : push(@strings,$x => {isLetter => 1, caseSensitive => 1}) 280 : unless $context->strings->get($x); 281 : } 282 : $context->strings->add(@strings) if scalar(@strings); 283 : } 284 : 285 : ############################################################# 286 : # 287 : # This overrides the TeX method of the letters 288 : # so that they don't print using the \rm font. 289 : # 290 : 291 : package context::Ordering::Value::String; 292 : our @ISA = ('Value::String'); 293 : 294 : sub TeX {shift->value} 295 : 296 : 297 : ############################################################# 298 : # 299 : dpvc 5962 # Override Parser classes so that we can check for repeated letters 300 : # 301 : 302 : package context::Ordering::Parser::String; 303 : our @ISA = ('Parser::String'); 304 : 305 : # 306 : # Save the letters positional reference 307 : # 308 : sub new { 309 : my$self = shift; 310 : $self =$self->SUPER::new(@_); 311 : $self->{letters}{$self->{value}} = $self->{ref} if$self->{def}{isLetter}; 312 : return $self; 313 : } 314 : 315 : ######################### 316 : 317 : package context::Ordering::Parser::Value; 318 : our @ISA = ('Parser::Value'); 319 : 320 : # 321 : # Move letters to Value object 322 : # 323 : sub new { 324 : my$self = shift; 325 : $self =$self->SUPER::new(@_); 326 : if (defined($self->{value}{letters})) { 327 :$self->{letters} = $self->{value}{letters}; 328 : delete$self->{value}{letters}; 329 : } 330 : return $self; 331 : } 332 : 333 : # 334 : # Return Ordering class if the object is one 335 : # 336 : sub class { 337 : my$self = shift; 338 : return "Ordering" if $self->{value}->classMatch('Ordering'); 339 : return$self->SUPER::class; 340 : } 341 : 342 : ######################### 343 : 344 : package context::Ordering::Parser::BOP; 345 : our @ISA = ('Parser::BOP'); 346 : 347 : # 348 : # If a BOP is constant and so reduced automatically we will lose the 349 : # letters hash, so it is stored temporarily in the equation by _check(), 350 : # and replaced here. A hack, but that avoids adding letters to the 351 : # Ordering object in eval() and having them remain there after parsing. 352 : # 353 : sub new { 354 : my $self = shift; 355 :$self = $self->SUPER::new(@_); 356 :$self->{letters} = $self->{equation}{letters} unless defined$self->{letters} || $self->class ne 'Ordering'; 357 : delete$self->{equation}{letters}; 358 : return $self; 359 : } 360 : 361 : 362 : ############################################################# 363 : # 364 : dpvc 5959 # This overrides the cmp_equal method to make sure that 365 : # Ordering lists are put into nested lists (since the 366 : # underlying ordering is a list, we don't want the 367 : # list checker to test the individual parts of the list, 368 : # but rather the list as a whole). 369 : # 370 : 371 : package context::Ordering::Value::List; 372 : our @ISA = ('Value::List'); 373 : 374 : sub cmp_equal { 375 : my$self = shift; my $ans =$_[0]; 376 : $ans->{student_value} = Value::List->make($ans->{student_value}) 377 : if Value::classMatch($ans->{student_value},'Ordering'); 378 : return$self->SUPER::cmp_equal(@_); 379 : } 380 : dpvc 5962 381 : ############################################################# 382 : 383 : 1;