Parent Directory
| 
Revision Log
Revision 5962 - (view) (download) (as text)
| 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; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |