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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5694 - (download) (as text) (annotate)
Sat Jun 14 11:53:42 2008 UTC (11 years, 7 months ago) by dpvc
File size: 17098 byte(s)
Use \verb rather than \text, since it will show more characters
properly, and will handle missmatched braces in student answers.

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: pg/macros/PGstringevaluators.pl,v 1.2 2007/11/10 21:48:22 gage Exp $
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 =head1 NAME
   18 
   19 PGstringevaluators.pl - Macros that generate string answer evaluators.
   20 
   21 =head1 SYNOPSIS
   22 
   23   ANS(str_cmp("increasing"));
   24 
   25   ANS(unordered_str_cmp("A C E"));
   26 
   27 =head1 DESCRIPTION
   28 
   29 String answer evaluators compare a student string to the correct string.
   30 
   31 =head2 MathObjects and answer evaluators
   32 
   33 The MathObjects system provides a String->cmp() method that produce answer
   34 evaluators for string comparisons. It is recommended that you use the String
   35 object's cmp() method directly if possible.
   36 
   37 =cut
   38 
   39 BEGIN { be_strict() }
   40 sub _PGstringevaluators_init {}
   41 
   42 =head1 String Filters
   43 
   44 Different filters can be applied to allow various degrees of variation. Both the
   45 student and correct answers are subject to the same filters, to ensure that
   46 there are no unexpected matches or rejections.
   47 
   48 =cut
   49 
   50 ################################
   51 ## STRING ANSWER FILTERS
   52 
   53 ## IN:  --the string to be filtered
   54 ##    --a list of the filters to use
   55 ##
   56 ## OUT: --the modified string
   57 ##
   58 ## Use this subroutine instead of the
   59 ## individual filters below it
   60 
   61 sub str_filters {
   62   my $stringToFilter = shift @_;
   63   # filters now take an answer hash, so encapsulate the string
   64   # in the answer hash.
   65   my $rh_ans = new AnswerHash;
   66   $rh_ans->{student_ans} = $stringToFilter;
   67   $rh_ans->{correct_ans}='';
   68   my @filters_to_use = @_;
   69   my %known_filters = (
   70               'remove_whitespace'   =>  \&remove_whitespace,
   71         'compress_whitespace' =>  \&compress_whitespace,
   72         'trim_whitespace'   =>  \&trim_whitespace,
   73         'ignore_case'     =>  \&ignore_case,
   74         'ignore_order'      =>  \&ignore_order,
   75   );
   76 
   77   #test for unknown filters
   78   foreach my $filter ( @filters_to_use ) {
   79     #check that filter is known
   80     die "Unknown string filter $filter (try checking the parameters to str_cmp() )"
   81                 unless exists $known_filters{$filter};
   82     $rh_ans = $known_filters{$filter}($rh_ans);  # apply filter.
   83   }
   84 
   85   return $rh_ans->{student_ans};
   86 }
   87 
   88 =over
   89 
   90 =item remove_whitespace
   91 
   92 Removes all whitespace from the string. It applies the following substitution to
   93 the string:
   94 
   95   $filteredAnswer =~ s/\s+//g;
   96 
   97 =cut
   98 
   99 sub remove_whitespace {
  100   my $rh_ans = shift;
  101   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
  102   $rh_ans->{_filter_name} = 'remove_whitespace';
  103   $rh_ans->{student_ans} =~ s/\s+//g;   # remove all whitespace
  104   $rh_ans->{correct_ans} =~ s/\s+//g;   # remove all whitespace
  105   return $rh_ans;
  106 }
  107 
  108 =item compress_whitespace
  109 
  110 Removes leading and trailing whitespace, and replaces all other blocks of
  111 whitespace by a single space. Applies the following substitutions:
  112 
  113   $filteredAnswer =~ s/^\s*//;
  114   $filteredAnswer =~ s/\s*$//;
  115   $filteredAnswer =~ s/\s+/ /g;
  116 
  117 =cut
  118 
  119 sub compress_whitespace {
  120   my $rh_ans = shift;
  121   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
  122   $rh_ans->{_filter_name} = 'compress_whitespace';
  123   $rh_ans->{student_ans} =~ s/^\s*//;   # remove initial whitespace
  124   $rh_ans->{student_ans} =~ s/\s*$//;   # remove trailing whitespace
  125   $rh_ans->{student_ans} =~ s/\s+/ /g;    # replace spaces by single space
  126   $rh_ans->{correct_ans} =~ s/^\s*//;   # remove initial whitespace
  127   $rh_ans->{correct_ans} =~ s/\s*$//;   # remove trailing whitespace
  128   $rh_ans->{correct_ans} =~ s/\s+/ /g;    # replace spaces by single space
  129 
  130   return $rh_ans;
  131 }
  132 
  133 =item trim_whitespace
  134 
  135 Removes leading and trailing whitespace. Applies the following substitutions:
  136 
  137   $filteredAnswer =~ s/^\s*//;
  138   $filteredAnswer =~ s/\s*$//;
  139 
  140 =cut
  141 
  142 sub trim_whitespace {
  143   my $rh_ans = shift;
  144   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
  145   $rh_ans->{_filter_name} = 'trim_whitespace';
  146   $rh_ans->{student_ans} =~ s/^\s*//;   # remove initial whitespace
  147   $rh_ans->{student_ans} =~ s/\s*$//;   # remove trailing whitespace
  148   $rh_ans->{correct_ans} =~ s/^\s*//;   # remove initial whitespace
  149   $rh_ans->{correct_ans} =~ s/\s*$//;   # remove trailing whitespace
  150 
  151   return $rh_ans;
  152 }
  153 
  154 =item ignore_case
  155 
  156 Ignores the case of the string. More accurately, it converts the string to
  157 uppercase (by convention). Applies the following function:
  158 
  159   $filteredAnswer = uc($filteredAnswer);
  160 
  161 =cut
  162 
  163 sub ignore_case {
  164   my $rh_ans = shift;
  165   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
  166   $rh_ans->{_filter_name} = 'ignore_case';
  167   $rh_ans->{student_ans} =~ tr/a-z/A-Z/;
  168   $rh_ans->{correct_ans} =~ tr/a-z/A-Z/;
  169   return $rh_ans;
  170 }
  171 
  172 =item ignore_order
  173 
  174 Ignores the order of the letters in the string. This is used for problems of the
  175 form "Choose all that apply." Specifically, it removes all whitespace and
  176 lexically sorts the letters in ascending alphabetical order. Applies the
  177 following functions:
  178 
  179   $filteredAnswer = join("", lex_sort(split(/\s*/, $filteredAnswer)));
  180 
  181 =cut
  182 
  183 sub ignore_order {
  184   my $rh_ans = shift;
  185   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
  186   $rh_ans->{_filter_name} = 'ignore_order';
  187   $rh_ans->{student_ans} = join( "", lex_sort( split( /\s*/, $rh_ans->{student_ans} ) ) );
  188   $rh_ans->{correct_ans} = join( "", lex_sort( split( /\s*/, $rh_ans->{correct_ans} ) ) );
  189 
  190   return $rh_ans;
  191 }
  192 
  193 =back
  194 
  195 =head1 str_cmp
  196 
  197   ANS(str_cmp($answer_or_answer_array_ref, @filters));
  198   ANS(str_cmp($answer_or_answer_array_ref, %options));
  199 
  200 Compares a string or a list of strings, using a named hash of options to set
  201 parameters. This can make for more readable code than using the "mode"_str_cmp()
  202 style, but some people find one or the other easier to remember.
  203 
  204 $answer_or_answer_array_ref can be a scalar representing the correct answer or a
  205 reference to an array of string scalars. If multiple answers are given, str_cmp
  206 returns one answer evaluator for each answer.
  207 
  208 num_cmp() differentiates %options from @filters by checking for the names of
  209 supported options in the list. Currently "filter", "filters", and "debug" are
  210 checked for. If these strings are found in the argument list, it is assumed that
  211 %options is present rather than @filters.
  212 
  213 %options can contain the following items:
  214 
  215 =over
  216 
  217 =item filters
  218 
  219 A reference to an array of filter names, to be applied to both the correct
  220 answer and the student's answer before doing string comparison. Supported
  221 filters are listed above. filter is avaliable as a synonym for filters.
  222 
  223 =item debug
  224 
  225 If set to 1, extra debugging information will be output.
  226 
  227 =back
  228 
  229 If %options is not detected, the rest of the argument list is assumed to be a
  230 list of filter names. Hence, the following two forms are equivalent:
  231 
  232   ANS(str_cmp($ans, 'remove_whitespace', 'ignore_order'));
  233   ANS(str_cmp($ans, filters=>['remove_whitespace', 'ignore_order']));
  234 
  235 =head2 Examples
  236 
  237   # same as std_str_cmp() -- matches "Hello", "  hello", etc.
  238   str_cmp("Hello")
  239 
  240   # same as std_str_cmp_list()
  241   str_cmp(["Hello", "Goodbye"]);
  242 
  243   # matches "hello", " hello  ", etc.
  244   str_cmp(' hello ', 'trim_whitespace');
  245 
  246   # matches "ACB" and "A B C", but not "abc"
  247   str_cmp('ABC', filters=>'ignore_order');
  248 
  249   # matches "def" and "d e f" but not "fed"
  250   str_cmp('D E F', 'remove_whitespace', 'ignore_case');
  251 
  252 =cut
  253 
  254 sub str_cmp {
  255   my $correctAnswer = shift @_;
  256   $correctAnswer = '' unless defined($correctAnswer);
  257   my @options = @_;
  258   my %options = ();
  259   # backward compatibility
  260   if (grep /filters|debug|filter/, @options) { # see whether we have hash keys in the input.
  261     %options = @options;
  262   } elsif (@options) {     # all options are names of filters.
  263     $options{filters} = [@options];
  264   }
  265   my $ra_filters;
  266   assign_option_aliases( \%options,
  267         'filter'               =>  'filters',
  268      );
  269     set_default_options(  \%options,
  270           'filters'               =>  [qw(trim_whitespace compress_whitespace ignore_case)],
  271             'debug'         =>  0,
  272             'type'                  =>  'str_cmp',
  273     );
  274   $options{filters} = (ref($options{filters}))?$options{filters}:[$options{filters}];
  275   # make sure this is a reference to an array.
  276   # error-checking for filters occurs in the filters() subroutine
  277 #   if( not defined( $options[0] ) ) {    # used with no filters as alias for std_str_cmp()
  278 #     @options = ( 'compress_whitespace', 'ignore_case' );
  279 #   }
  280 #
  281 #   if( $options[0] eq 'filters' ) {    # using filters => [f1, f2, ...] notation
  282 #     $ra_filters = $options[1];
  283 #   }
  284 #   else {            # using a list of filters
  285 #     $ra_filters = \@options;
  286 #   }
  287 
  288   # thread over lists
  289   my @ans_list = ();
  290 
  291   if ( ref($correctAnswer) eq 'ARRAY' ) {
  292     @ans_list = @{$correctAnswer};
  293   }
  294   else {
  295     push( @ans_list, $correctAnswer );
  296   }
  297 
  298   # final_answer;
  299   my @output_list = ();
  300 
  301   foreach my $ans (@ans_list) {
  302     push(@output_list, STR_CMP(
  303                   'correct_ans' =>  $ans,
  304             'filters'   =>  $options{filters},
  305             'type'      =>  $options{type},
  306             'debug'         =>  $options{debug},
  307          )
  308     );
  309   }
  310 
  311   return (wantarray) ? @output_list : $output_list[0] ;
  312 }
  313 
  314 =head1 "mode"_str_cmp functions
  315 
  316 The functions of the the form "mode"_str_cmp() use different functions to
  317 specify which filters to apply. They take no options except the correct string.
  318 There are also versions which accept a list of strings.
  319 
  320 =over
  321 
  322 =item standard
  323 
  324   std_str_cmp($correctString)
  325   std_str_cmp_list(@correctStringList)
  326 
  327 Filters: compress_whitespace, ignore_case
  328 
  329 =item standard, case sensitive
  330 
  331   std_cs_str_cmp($correctString)
  332   std_cs_str_cmp_list(@correctStringList)
  333 
  334 Filters: compress_whitespace
  335 
  336 =item strict
  337 
  338   strict_str_cmp($correctString)
  339   strict_str_cmp_list(@correctStringList)
  340 
  341 Filters: trim_whitespace
  342 
  343 =item unordered
  344 
  345   unordered_str_cmp( $correctString )
  346   unordered_str_cmp_list( @correctStringList )
  347 
  348 Filters: ignore_order, ignore_case
  349 
  350 =item unordered, case sensitive
  351 
  352   unordered_cs_str_cmp( $correctString )
  353   unordered_cs_str_cmp_list( @correctStringList )
  354 
  355 Filters: ignore_order
  356 
  357 =item ordered
  358 
  359   ordered_str_cmp( $correctString )
  360   ordered_str_cmp_list( @correctStringList )
  361 
  362 Filters: remove_whitespace, ignore_case
  363 
  364 =item ordered, case sensitive
  365 
  366   ordered_cs_str_cmp( $correctString )
  367   ordered_cs_str_cmp_list( @correctStringList )
  368 
  369 Filters: remove_whitespace
  370 
  371 =back
  372 
  373 =head2 Examples
  374 
  375   # Accepts "W. Mozart", "W. MOZarT", and so forth. Case insensitive. All
  376   # internal spaces treated as single spaces.
  377   ANS(std_str_cmp("W. Mozart"));
  378 
  379   # Rejects "mozart". Same as std_str_cmp() but case sensitive.
  380   ANS(std_cs_str_cmp("Mozart"));
  381 
  382   # Accepts only the exact string.
  383   ANS(strict_str_cmp("W. Mozart"));
  384 
  385   # Accepts "a c B", "CBA" and so forth. Unordered, case insensitive, spaces
  386   # ignored.
  387   ANS(unordered_str_cmp("ABC"));
  388 
  389   # Rejects "abc". Same as unordered_str_cmp() but case sensitive.
  390   ANS(unordered_cs_str_cmp("ABC"));
  391 
  392   # Accepts "a b C", "A B C" and so forth. Ordered, case insensitive, spaces
  393   # ignored.
  394   ANS(ordered_str_cmp("ABC"));
  395 
  396   # Rejects "abc", accepts "A BC" and so forth. Same as ordered_str_cmp() but
  397   # case sensitive.
  398   ANS(ordered_cs_str_cmp("ABC"));
  399 
  400 =cut
  401 
  402 sub std_str_cmp {         # compare strings
  403   my $correctAnswer = shift @_;
  404   my @filters = ( 'compress_whitespace', 'ignore_case' );
  405   my $type = 'std_str_cmp';
  406   STR_CMP('correct_ans' =>  $correctAnswer,
  407       'filters' =>  \@filters,
  408       'type'    =>  $type
  409   );
  410 }
  411 
  412 sub std_str_cmp_list {        # alias for std_str_cmp
  413   my @answerList = @_;
  414   my @output;
  415   while (@answerList) {
  416     push( @output, std_str_cmp(shift @answerList) );
  417   }
  418   @output;
  419 }
  420 
  421 sub std_cs_str_cmp {        # compare strings case sensitive
  422   my $correctAnswer = shift @_;
  423   my @filters = ( 'compress_whitespace' );
  424   my $type = 'std_cs_str_cmp';
  425   STR_CMP(  'correct_ans' =>  $correctAnswer,
  426       'filters' =>  \@filters,
  427       'type'    =>  $type
  428   );
  429 }
  430 
  431 sub std_cs_str_cmp_list {     # alias for std_cs_str_cmp
  432   my @answerList = @_;
  433   my @output;
  434   while (@answerList) {
  435     push( @output, std_cs_str_cmp(shift @answerList) );
  436   }
  437   @output;
  438 }
  439 
  440 sub strict_str_cmp {        # strict string compare
  441   my $correctAnswer = shift @_;
  442   my @filters = ( 'trim_whitespace' );
  443   my $type = 'strict_str_cmp';
  444   STR_CMP(  'correct_ans' =>  $correctAnswer,
  445       'filters' =>  \@filters,
  446       'type'    =>  $type
  447   );
  448 }
  449 
  450 sub strict_str_cmp_list {     # alias for strict_str_cmp
  451   my @answerList = @_;
  452   my @output;
  453   while (@answerList) {
  454     push( @output, strict_str_cmp(shift @answerList) );
  455   }
  456   @output;
  457 }
  458 
  459 sub unordered_str_cmp {       # unordered, case insensitive, spaces ignored
  460   my $correctAnswer = shift @_;
  461   my @filters = ( 'ignore_order', 'ignore_case' );
  462   my $type = 'unordered_str_cmp';
  463   STR_CMP(  'correct_ans'   =>  $correctAnswer,
  464       'filters'   =>  \@filters,
  465       'type'      =>  $type
  466   );
  467 }
  468 
  469 sub unordered_str_cmp_list {    # alias for unordered_str_cmp
  470   my @answerList = @_;
  471   my @output;
  472   while (@answerList) {
  473     push( @output, unordered_str_cmp(shift @answerList) );
  474   }
  475   @output;
  476 }
  477 
  478 sub unordered_cs_str_cmp {      # unordered, case sensitive, spaces ignored
  479   my $correctAnswer = shift @_;
  480   my @filters = ( 'ignore_order' );
  481   my $type = 'unordered_cs_str_cmp';
  482   STR_CMP(  'correct_ans'   =>  $correctAnswer,
  483       'filters'   =>  \@filters,
  484       'type'      =>  $type
  485   );
  486 }
  487 
  488 sub unordered_cs_str_cmp_list {   # alias for unordered_cs_str_cmp
  489   my @answerList = @_;
  490   my @output;
  491   while (@answerList) {
  492     push( @output, unordered_cs_str_cmp(shift @answerList) );
  493   }
  494   @output;
  495 }
  496 
  497 sub ordered_str_cmp {       # ordered, case insensitive, spaces ignored
  498   my $correctAnswer = shift @_;
  499   my @filters = ( 'remove_whitespace', 'ignore_case' );
  500   my $type = 'ordered_str_cmp';
  501   STR_CMP(  'correct_ans' =>  $correctAnswer,
  502       'filters' =>  \@filters,
  503       'type'    =>  $type
  504   );
  505 }
  506 
  507 sub ordered_str_cmp_list {      # alias for ordered_str_cmp
  508   my @answerList = @_;
  509   my @output;
  510   while (@answerList) {
  511     push( @output, ordered_str_cmp(shift @answerList) );
  512   }
  513   @output;
  514 }
  515 
  516 sub ordered_cs_str_cmp {      # ordered,  case sensitive, spaces ignored
  517   my $correctAnswer = shift @_;
  518   my @filters = ( 'remove_whitespace' );
  519   my $type = 'ordered_cs_str_cmp';
  520   STR_CMP(  'correct_ans' =>  $correctAnswer,
  521       'filters' =>  \@filters,
  522       'type'    =>  $type
  523   );
  524 }
  525 
  526 sub ordered_cs_str_cmp_list {   # alias for ordered_cs_str_cmp
  527   my @answerList = @_;
  528   my @output;
  529   while (@answerList) {
  530     push( @output, ordered_cs_str_cmp(shift @answerList) );
  531   }
  532   @output;
  533 }
  534 
  535 
  536 ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
  537 ##
  538 ## IN:  a hashtable with the following entries (error-checking to be added later?):
  539 ##      correctAnswer --  the correct answer, before filtering
  540 ##      filters     --  reference to an array containing the filters to be applied
  541 ##      type      --  a string containing the type of answer evaluator in use
  542 ## OUT: a reference to an answer evaluator subroutine
  543 sub STR_CMP {
  544   my %str_params = @_;
  545   #my $correctAnswer =  str_filters( $str_params{'correct_ans'}, @{$str_params{'filters'}} );
  546   my $answer_evaluator = new AnswerEvaluator;
  547   $answer_evaluator->{debug} = $str_params{debug};
  548   $answer_evaluator->ans_hash(
  549     correct_ans       => "$str_params{correct_ans}",
  550     type              => $str_params{type}||'str_cmp',
  551     score             => 0,
  552 
  553     );
  554   # Remove blank prefilter if the correct answer is blank
  555   $answer_evaluator->install_pre_filter('erase') if $answer_evaluator->ans_hash->{correct_ans} eq '';
  556 
  557   my %known_filters = (
  558               'remove_whitespace'   =>  \&remove_whitespace,
  559         'compress_whitespace' =>  \&compress_whitespace,
  560         'trim_whitespace'   =>  \&trim_whitespace,
  561         'ignore_case'     =>  \&ignore_case,
  562         'ignore_order'      =>  \&ignore_order,
  563   );
  564 
  565   foreach my $filter ( @{$str_params{filters}} ) {
  566     #check that filter is known
  567     die "Unknown string filter |$filter|. Known filters are ".
  568          join(" ", keys %known_filters) .
  569          "(try checking the parameters to str_cmp() )"
  570                 unless exists $known_filters{$filter};
  571     # install related pre_filter
  572     $answer_evaluator->install_pre_filter( $known_filters{$filter} );
  573   }
  574   $answer_evaluator->install_evaluator(sub {
  575       my $rh_ans = shift;
  576       $rh_ans->{_filter_name} = "Evaluator: Compare string answers with eq";
  577       $rh_ans->{score} = ($rh_ans->{student_ans} eq $rh_ans->{correct_ans})?1:0  ;
  578       $rh_ans;
  579   });
  580   $answer_evaluator->install_post_filter(sub {
  581     my $rh_hash = shift; my $c = chr(128); ## something that won't be typed
  582     $rh_hash->{_filter_name} = "clean up preview strings";
  583     $rh_hash->{'preview_text_string'} = $rh_hash->{student_ans};
  584 #   $rh_hash->{'preview_latex_string'} = "\\text{ ".$rh_hash->{student_ans}." }";
  585     $rh_hash->{'preview_latex_string'} = "\\verb".$c.$rh_hash->{student_ans}.$c;
  586     $rh_hash;
  587   });
  588   return $answer_evaluator;
  589 }
  590 
  591 =head1 SEE ALSO
  592 
  593 L<PGanswermacros.pl>, L<MathObjects>.
  594 
  595 =cut
  596 
  597 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9