View of /branches/gage_dev/pg/macros/contextOrdering.pl

    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 induce 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 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 =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    '>' => {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   );
  108   $context->{parser}{String}  = "context::Ordering::Parser::String";
  109   $context->{parser}{Value}   = "context::Ordering::Parser::Value";
  110   $context->{value}{String}   = "context::Ordering::Value::String";
  111   $context->{value}{Ordering} = "context::Ordering::Value::Ordering";
  112   $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   $context->{name} = 'Ordering-List';
  120   $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     my $letters = $string; $letters =~ s/ //g;
  153     context::Ordering::Letters($context,split(/[>=]/,$letters));
  154   } 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 package context::Ordering::BOP::ordering;
  182 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   return $class eq 'Ordering' || $obj->{def}{isLetter};
  189 }
  190 
  191 sub _check {
  192   my $self = shift;
  193   $self->Error("Operands of %s must be letters",$self->{bop})
  194     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       $self->Error("Each letter may appear only once in an ordering");
  200     }
  201     $self->{letters}{$x} = $self->{rop}{letters}{$x};
  202   }
  203 }
  204 
  205 sub _eval {
  206   my $self = shift;
  207   my $ordering = $self->Package("Ordering")->new($self->context,$self->{bop},@_);
  208   $ordering->{letters} = $self->{letters};
  209   return $ordering;
  210 }
  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 
  223 #############################################################
  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   my $self = shift; my $ans = $_[0];
  275   $ans->{typeMatch} = $ans->{firstElement} = $self;
  276   $ans->{correct_formula} = $self->{equation};
  277   $self = $ans->{correct_value} = Value::List->make($self);
  278   $ans->{student_value} = Value::List->make($ans->{student_value})
  279       if Value::classMatch($ans->{student_value},'Ordering');
  280   return $self->SUPER::cmp_equal(@_);
  281 }
  282 
  283 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   $self->cmp_Error($ans,"Your ordering should include all the letters")
  295     if $ans->{showMissingLetterHints} &&
  296        scalar(keys %{$ans->{correct_formula}{tree}{letters}}) !=
  297        scalar(keys %{$ans->{student_formula}{tree}{letters}});
  298 }
  299 
  300 #
  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 #  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   $self->{letters} = $self->{value}{letters} if defined $self->{value}{letters};
  356   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 #  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 
  387 #############################################################
  388 
  389 1;