[system] / trunk / pg / macros / contextOrdering.pl Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5969 - (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 : 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;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9