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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5959 - (download) (as text) (annotate)
Sat Jan 10 19:36:51 2009 UTC (10 years, 10 months ago) by dpvc
File size: 10190 byte(s)
New Context for handling ordered lists of letters like "D > A = C > B".
See the comments for details about how to use it.

    1 =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    '>' => {precedence => 1.5, associativity => 'left', type => 'bin', class => 'context::Ordering::BOP'},
   95    '=' => {precedence => 1.7, associativity => 'left', type => 'bin', class => 'context::Ordering::BOP'},
   96   );
   97   $context->{value}{String} = "context::Ordering::Value::String";
   98   $context->strings->add('='=>{hidden=>1},'>'=>{hidden=>1});
   99   $context->{error}{msg}{"Variable '%s' is not defined in this context"} = "'%s' is not defined in this context";
  100   $context->{error}{msg}{"Unexpected character '%s'"} = "Can't use '%s' in this context";
  101   $context->{error}{msg}{"Missing operand before '%s'"} = "Missing letter before '%s'";
  102   $context->{error}{msg}{"Missing operand after '%s'"} = "Missing letter after '%s'";
  103 
  104   $context = $main::context{'Ordering-List'} = $context->copy;
  105   $context->{name} eq 'Ordering-List';
  106   $context->operators->redefine(',',from => "Full");
  107   $context->{value}{List} = "context::Ordering::Value::List";
  108 
  109   main::PG_restricted_eval('sub Letters {context::Ordering::Letters(@_)}');
  110   main::PG_restricted_eval('sub Ordering {context::Ordering::Ordering(@_)}');
  111 }
  112 
  113 #
  114 #  A routine to set the letters allowed in this context.
  115 #  (Old letters are cleared, and > and = are allowed, but hidden,
  116 #   since they are used in the List() objects that implement the context).
  117 #
  118 sub Letters {
  119   my $context = (Value::isContext($_[0]) ? shift : main::Context());
  120   my @strings;
  121   foreach my $x (@_) {push(@strings, $x => {isLetter => 1, caseSensitive => 1})}
  122   $context->strings->are(@strings);
  123   $context->strings->add('='=>{hidden=>1},'>'=>{hidden=>1});
  124 }
  125 
  126 #
  127 #  Create orderings from strings or lists of letter => value pairs.
  128 #  A copy of the current context is created that contains the proper
  129 #  letters, and the correct string is created and parsed into an
  130 #  Ordering object.
  131 #
  132 sub Ordering {
  133   my $context = main::Context()->copy; my $string;
  134   Value->Error("The current context is not the Ordering context")
  135     unless $context->{name} =~ m/Ordering/;
  136   if (scalar(@_) == 1) {
  137     $string = shift;
  138     my $letters = $string; $letters =~ s/[^A-Z]//ig;
  139     context::Ordering::Letters($context,split(//,$letters));
  140   } else {
  141     my %letter = @_; my @letters = keys %letter;
  142     context::Ordering::Letters($context,@letters);
  143     foreach my $x (@letters) {$letter{$x} = Value::Real->new($context,$letter{$x})}
  144     my @order = main::PGsort(
  145       sub {$letter{$_[0]} == $letter{$_[1]} ?  $_[0] lt $_[1] : $letter{$_[0]} > $letter{$_[1]}},
  146       @letters
  147     );
  148     my $a = shift(@order); my $b; $string = $a;
  149     while ($b = shift(@order)) {
  150       $string .= ($letter{$a} == $letter{$b} ? " = " : " > ") . $b;
  151       $a = $b;
  152     }
  153   }
  154   return main::Formula($context,$string)->eval;
  155 }
  156 
  157 #############################################################
  158 #
  159 #  This is a Parser BOP used to create the Ordering objects
  160 #  used internally.  They are actually lists with the operator
  161 #  and the two operands, and the comparisons is based on the
  162 #  standard list comparisons.  The operands are either the strings
  163 #  for individual letters, or another Ordering object as a
  164 #  nested List.
  165 #
  166 
  167 package context::Ordering::BOP;
  168 our @ISA = ('Parser::BOP');
  169 
  170 sub class {"Ordering"}
  171 
  172 sub isOrdering {
  173   my $self = shift; my $obj = shift; my $class = $obj->class;
  174   return ($class eq 'Value' && $obj->{value}->class eq 'Ordering') ||
  175          ($class eq 'Ordering') || $obj->{def}{isLetter};
  176 }
  177 
  178 sub _check {
  179   my $self = shift;
  180   return if $self->isOrdering($self->{lop}) && $self->isOrdering($self->{rop});
  181   $self->Error("Operators of %s must be letters",$self->{bop});
  182 }
  183 
  184 sub _eval {
  185   my $self = shift;
  186   return context::Ordering::Value::Ordering->new($self->context,$self->{bop},@_);
  187 }
  188 
  189 sub string {
  190   my $self = shift;
  191   return $self->{lop}->string." ".$self->{bop}." ".$self->{rop}->string;
  192 }
  193 
  194 sub TeX {
  195   my $self = shift;
  196   return $self->{lop}->TeX." ".$self->{bop}." ".$self->{rop}->TeX;
  197 }
  198 
  199 #############################################################
  200 #
  201 #  This is the Value object used to implement the list That represents
  202 #  one ordering operation.  It is simply a normal Value::List with the
  203 #  operator as the first entry and the two operands as the remaing
  204 #  entries in the list.  The new() method is overriden to make binary
  205 #  trees of equal operators into flat sorted lists.  We override the
  206 #  List string and TeX methods so that they print correctly as binary
  207 #  operators.  The cmp_equal method is overriden to make sure the that
  208 #  the lists are treated as a unit during answer checking.  There is
  209 #  also a routine for adding letters to the object's context.
  210 #
  211 
  212 package context::Ordering::Value::Ordering;
  213 our @ISA = ('Value::List');
  214 
  215 #
  216 #  Put all equal letters into one list and sort them
  217 #
  218 sub new {
  219   my $self = shift;
  220   my $context = (Value::isContext($_[0]) ? shift : $self->context);
  221   my $bop = shift; my @letters = @_;
  222   if ($bop eq '=') {
  223     if (Value::classMatch($letters[0],'Ordering') && $letters[0]->{data}[0] eq '=')
  224       {@letters = ($letters[0]->value,$letters[1]); shift @letters}
  225     @letters = main::lex_sort(@letters);
  226   }
  227   return $self->SUPER::new($context,$bop,@letters);
  228 }
  229 
  230 sub string {
  231   my $self = shift;
  232   my ($bop,@rest) = $self->value;
  233   foreach my $x (@rest) {$x = $x->string};
  234   return join(" $bop ",@rest);
  235 }
  236 
  237 sub TeX {
  238   my $self = shift;
  239   my ($bop,@rest) = $self->value;
  240   foreach my $x (@rest) {$x = $x->TeX};
  241   return join(" $bop ",@rest);
  242 }
  243 
  244 #
  245 #  Make sure we do comparison as a list of lists (rather than as the
  246 #  individual entries in the underlying Value::List that encodes
  247 #  the ordering)
  248 #
  249 sub cmp_equal {
  250   my $self = shift;  my $ans = $_[0];
  251   $ans->{typeMatch} = $ans->{firstElement} = $self;
  252   $self = $ans->{correct_value} = Value::List->make($self);
  253   $ans->{student_value} = Value::List->make($ans->{student_value})
  254     if Value::classMatch($ans->{student_value},'Ordering');
  255   return $self->SUPER::cmp_equal(@_);
  256 }
  257 
  258 #
  259 #  Add more letters to the ordering's context (so student answers
  260 #  can include them even if they aren't in the correct answer).
  261 #
  262 sub AddLetters {
  263   my $self = shift; my $context = $self->context;
  264   my @strings;
  265   foreach my $x (@_) {
  266     push(@strings, $x => {isLetter => 1, caseSensitive => 1})
  267       unless $context->strings->get($x);
  268   }
  269   $context->strings->add(@strings) if scalar(@strings);
  270 }
  271 
  272 #############################################################
  273 #
  274 #  This overrides the TeX method of the letters
  275 #  so that they don't print using the \rm font.
  276 #
  277 
  278 package context::Ordering::Value::String;
  279 our @ISA = ('Value::String');
  280 
  281 sub TeX {shift->value}
  282 
  283 
  284 #############################################################
  285 #
  286 #  This overrides the cmp_equal method to make sure that
  287 #  Ordering lists are put into nested lists (since the
  288 #  underlying ordering is a list, we don't want the
  289 #  list checker to test the individual parts of the list,
  290 #  but rather the list as a whole).
  291 #
  292 
  293 package context::Ordering::Value::List;
  294 our @ISA = ('Value::List');
  295 
  296 sub cmp_equal {
  297   my $self = shift;  my $ans = $_[0];
  298   $ans->{student_value} = Value::List->make($ans->{student_value})
  299     if Value::classMatch($ans->{student_value},'Ordering');
  300   return $self->SUPER::cmp_equal(@_);
  301 }

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9