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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3615 - (download) (as text) (annotate)
Tue Sep 13 14:07:32 2005 UTC (14 years, 2 months ago) by dpvc
File size: 175429 byte(s)
The ORIGINAL_NUM_CMP was calling str_cmp as a code reference rather
than as the more modern AnswerEvaluator object.  This causes error
messages when string answers were used.  It now uses the evaluate()
method of the AnswerEvaluator.

    1 # This file is PGanswermacros.pl
    2 # This includes the subroutines for the ANS macros, that
    3 # is, macros allowing a more flexible answer checking
    4 ####################################################################
    5 # Copyright @ 1995-2000 University of Rochester
    6 # All Rights Reserved
    7 ####################################################################
    8 #$Id$
    9 
   10 =head1 NAME
   11 
   12   PGanswermacros.pl -- located in the courseScripts directory
   13 
   14 =head1 SYNPOSIS
   15 
   16   Number Answer Evaluators:
   17     num_cmp() --  uses an input hash to determine parameters
   18 
   19     std_num_cmp(), std_num_cmp_list(), std_num_cmp_abs, std_num_cmp_abs_list()
   20     frac_num_cmp(), frac_num_cmp_list(), frac_num_cmp_abs, frac_num_cmp_abs_list()
   21     arith_num_cmp(), arith_num_cmp_list(), arith_num_cmp_abs, arith_num_cmp_abs_list()
   22     strict_num_cmp(), strict_num_cmp_list(), strict_num_cmp_abs, strict_num_cmp_abs_list()
   23     numerical_compare_with_units()  --  requires units as part of the answer
   24     std_num_str_cmp() --  also accepts a set of strings as possible answers
   25 
   26   Function Answer Evaluators:
   27     fun_cmp() --  uses an input hash to determine parameters
   28 
   29     function_cmp(), function_cmp_abs()
   30     function_cmp_up_to_constant(), function_cmp_up_to_constant_abs()
   31     multivar_function_cmp()
   32 
   33   String Answer Evaluators:
   34     str_cmp() --  uses an input hash to determine parameters
   35 
   36     std_str_cmp(), std_str_cmp_list(), std_cs_str_cmp(), std_cs_str_cmp_list()
   37     strict_str_cmp(), strict_str_cmp_list()
   38     ordered_str_cmp(), ordered_str_cmp_list(), ordered_cs_str_cmp(), ordered_cs_str_cmp_list()
   39     unordered_str_cmp(), unordered_str_cmp_list(), unordered_cs_str_cmp(), unordered_cs_str_cmp_list()
   40 
   41   Miscellaneous Answer Evaluators:
   42     checkbox_cmp()
   43     radio_cmp()
   44 
   45 =cut
   46 
   47 =head1 DESCRIPTION
   48 
   49 This file adds subroutines which create "answer evaluators" for checking
   50 answers. Each answer evaluator accepts a single input from a student answer,
   51 checks it and creates an output hash %ans_hash with seven or eight entries
   52 (the preview_latex_string is optional). The output hash is now being created
   53 with the AnswerHash package "class", which is located at the end of this file.
   54 This class is currently just a wrapper for the hash, but this might change in
   55 the future as new capabilities are added.
   56 
   57           score     =>  $correctQ,
   58           correct_ans   =>  $originalCorrEqn,
   59           student_ans   =>  $modified_student_ans
   60           original_student_ans  =>  $original_student_answer,
   61           ans_message   =>  $PGanswerMessage,
   62           type      =>  'typeString',
   63           preview_text_string =>  $preview_text_string,
   64           preview_latex_string  =>  $preview_latex_string
   65 
   66 
   67   $ans_hash{score}      --  a number between 0 and 1 indicating
   68                     whether the answer is correct. Fractions
   69                     allow the implementation of partial
   70                     credit for incorrect answers.
   71   $ans_hash{correct_ans}      --  The correct answer, as supplied by the
   72                     instructor and then formatted. This can
   73                     be viewed by the student after the answer date.
   74   $ans_hash{student_ans}      --  This is the student answer, after reformatting;
   75                     for example the answer might be forced
   76                     to capital letters for comparison with
   77                     the instructors answer. For a numerical
   78                     answer, it gives the evaluated answer.
   79                     This is displayed in the section reporting
   80                     the results of checking the student answers.
   81   $ans_hash{original_student_ans}   --  This is the original student answer. This is displayed
   82                     on the preview page and may be used for sticky answers.
   83   $ans_hash{ans_message}      --  Any error message, or hint provided by the answer evaluator.
   84                     This is also displayed in the section reporting
   85                     the results of checking the student answers.
   86   $ans_hash{type}       --  A string indicating the type of answer evaluator. This
   87                     helps in preprocessing the student answer for errors.
   88                     Some examples:
   89                       'number_with_units'
   90                       'function'
   91                       'frac_number'
   92                       'arith_number'
   93   $ans_hash{preview_text_string}    --  This typically shows how the student answer was parsed. It is
   94                     displayed on the preview page. For a student answer of 2sin(3x)
   95                     this would be 2*sin(3*x). For string answers it is typically the
   96                     same as $ans_hash{student_ans}.
   97   $ans_hash{preview_latex_string}   --  THIS IS OPTIONAL. This is latex version of the student answer
   98                     which is used to show a typeset view on the answer on the preview
   99                     page. For a student answer of 2/3, this would be \frac{2}{3}.
  100 
  101 Technical note: the routines in this file are not actually answer evaluators. Instead, they create
  102 answer evaluators. An answer evaluator is an anonymous subroutine, referenced by a named scalar. The
  103 routines in this file build the subroutine and return a reference to it. Later, when the student
  104 actually enters an answer, the problem processor feeds that answer to the referenced subroutine, which
  105 evaluates it and returns a score (usually 0 or 1). For most users, this distinction is unimportant, but
  106 if you plan on writing your own answer evaluators, you should understand this point.
  107 
  108 =cut
  109 
  110 BEGIN {
  111   be_strict(); # an alias for use strict.  This means that all global variable must contain main:: as a prefix.
  112 }
  113 
  114 
  115 my ($BR                   ,   # convenient localizations.
  116   $PAR                  ,
  117   $numRelPercentTolDefault    ,
  118   $numZeroLevelDefault      ,
  119   $numZeroLevelTolDefault     ,
  120   $numAbsTolDefault         ,
  121   $numFormatDefault         ,
  122   $functRelPercentTolDefault      ,
  123   $functZeroLevelDefault      ,
  124   $functZeroLevelTolDefault   ,
  125   $functAbsTolDefault         ,
  126   $functNumOfPoints         ,
  127   $functVarDefault          ,
  128   $functLLimitDefault         ,
  129   $functULimitDefault         ,
  130   $functMaxConstantOfIntegration  ,
  131   $CA                             ,
  132   $rh_envir                       ,
  133   $useBaseTenLog                  ,
  134   $inputs_ref                     ,
  135   $QUESTIONNAIRE_ANSWERS          ,
  136   $user_context,
  137   $Context,
  138 );
  139 
  140 
  141 
  142 
  143 sub _PGanswermacros_init {
  144 
  145      $BR                              =   main::PG_restricted_eval(q!$main::BR!);
  146      $PAR                             =   main::PG_restricted_eval(q!$main::PAR!);
  147 
  148     # import defaults
  149     # these are now imported from the %envir variable
  150      $numRelPercentTolDefault     = main::PG_restricted_eval(q!$main::numRelPercentTolDefault!);
  151      $numZeroLevelDefault       = main::PG_restricted_eval(q!$main::numZeroLevelDefault!);
  152      $numZeroLevelTolDefault      = main::PG_restricted_eval(q!$main::numZeroLevelTolDefault!);
  153      $numAbsTolDefault            = main::PG_restricted_eval(q!$main::numAbsTolDefault!);
  154      $numFormatDefault            = main::PG_restricted_eval(q!$main::numFormatDefault!);
  155      $functRelPercentTolDefault     = main::PG_restricted_eval(q!$main::functRelPercentTolDefault!);
  156      $functZeroLevelDefault       = main::PG_restricted_eval(q!$main::functZeroLevelDefault!);
  157      $functZeroLevelTolDefault      = main::PG_restricted_eval(q!$main::functZeroLevelTolDefault!);
  158      $functAbsTolDefault        = main::PG_restricted_eval(q!$main::functAbsTolDefault!);
  159      $functNumOfPoints            = main::PG_restricted_eval(q!$main::functNumOfPoints!);
  160      $functVarDefault           = main::PG_restricted_eval(q!$main::functVarDefault!);
  161      $functLLimitDefault        = main::PG_restricted_eval(q!$main::functLLimitDefault!);
  162      $functULimitDefault        = main::PG_restricted_eval(q!$main::functULimitDefault!);
  163      $functMaxConstantOfIntegration   = main::PG_restricted_eval(q!$main::functMaxConstantOfIntegration!);
  164      $rh_envir                          =   main::PG_restricted_eval(q!\%main::envir!);
  165      $useBaseTenLog                     =   main::PG_restricted_eval(q!$main::useBaseTenLog!);
  166      $inputs_ref                        =   main::PG_restricted_eval(q!$main::inputs_ref!);
  167      $QUESTIONNAIRE_ANSWERS       =   '';
  168 
  169      if (!main::PG_restricted_eval(q!$main::useOldAnswerMacros!)) {
  170        $user_context = main::PG_restricted_eval(q!\%context!);
  171        $Context = sub {Parser::Context->current($user_context,@_)};
  172      }
  173 }
  174 
  175 
  176 
  177 ##########################################################################
  178 
  179 #Note   use $rh_envir to read environment variables
  180 
  181 ##########################################################################
  182 ## Number answer evaluators
  183 
  184 =head2 Number Answer Evaluators
  185 
  186 Number answer evaluators take in a numerical answer, compare it to the correct answer,
  187 and return a score. In addition, they can choose to accept or reject an answer based on
  188 its format, closeness to the correct answer, and other criteria. There are two types
  189 of numerical answer evaluators: num_cmp(), which takes a hash of named options as parameters,
  190 and the "mode"_num_cmp() variety, which use different functions to access different sets of
  191 options. In addition, there is the special case of std_num_str_cmp(), which can evaluate
  192 both numbers and strings.
  193 
  194 Numerical Comparison Options
  195 
  196   correctAnswer   --  This is the correct answer that the student answer will
  197             be compared to. However, this does not mean that the
  198             student answer must match this exactly. How close the
  199             student answer must be is determined by the other
  200             options, especially tolerance and format.
  201 
  202   tolerance   --  These options determine how close the student answer
  203             must be to the correct answer to qualify. There are two
  204             types of tolerance: relative and absolute. Relative
  205             tolerances are given in percentages. A relative
  206             tolerance of 1 indicates that the student answer must
  207             be within 1% of the correct answer to qualify as correct.
  208             In other words, a student answer is correct when
  209               abs(studentAnswer - correctAnswer) <= abs(.01*relpercentTol*correctAnswer)
  210             Using absolute tolerance, the student answer must be a
  211             fixed distance from the correct answer to qualify.
  212             For example, an absolute tolerance of 5 means that any
  213             number which is +-5 of the correct answer qualifies as correct.
  214               Final (rarely used) tolerance options are zeroLevel
  215             and zeroLevelTol, used in conjunction with relative
  216             tolerance. if correctAnswer has absolute value less than
  217             or equal to zeroLevel, then the student answer must be,
  218             in absolute terms, within zeroLevelTol of correctAnswer, i.e.,
  219               abs(studentAnswer - correctAnswer) <= zeroLevelTol.
  220             In other words, if the correct answer is very near zero,
  221             an absolute tolerance will be used. One must do this to
  222             handle floating point answers very near zero, because of
  223             the inaccuracy of floating point arithmetic. However, the
  224             default values are almost always adequate.
  225 
  226   mode      --  This determines the allowable methods for entering an
  227             answer. Answers which do not meet this requirement will
  228             be graded as incorrect, regardless of their numerical
  229             value. The recognized modes are:
  230               'std' (default) --  allows any expression which evaluates
  231                         to a number, including those using
  232                         elementary functions like sin() and
  233                         exp(), as well as the operations of
  234                         arithmetic (+, -, *, /, ^)
  235               'strict'  --  only decimal numbers are allowed
  236               'frac'    --  whole numbers and fractions are allowed
  237               'arith'   --  arithmetic expressions are allowed, but
  238                         no functions
  239             Note that all modes allow the use of "pi" and "e" as
  240             constants, and also the use of "E" to represent scientific
  241             notation.
  242 
  243   format      --  The format to use when displaying the correct and
  244             submitted answers. This has no effect on how answers are
  245             evaluated; it is only for cosmetic purposes. The
  246             formatting syntax is the same as Perl uses for the sprintf()
  247             function. Format strings are of the form '%m.nx' or '%m.nx#',
  248             where m and n are described below, and x is a formatter.
  249               Esentially, m is the minimum length of the field
  250             (make this negative to left-justify). Note that the decimal
  251             point counts as a character when determining the field width.
  252             If m begins with a zero, the number will be padded with zeros
  253             instead of spaces to fit the field.
  254               The precision specifier (n) works differently, depending
  255             on which formatter you are using. For d, i, o, u, x and X
  256             formatters (non-floating point formatters), n is the minimum
  257             number of digits to display. For e and f, it is the number of
  258             digits that appear after the decimal point (extra digits will
  259             be rounded; insufficient digits will be padded with spaces--see
  260             '#' below). For g, it is the number of significant digits to
  261             display.
  262               The full list of formatters can be found in the manpage
  263             for printf(3), or by typing "perldoc -f sprintf" at a
  264             terminal prompt. The following is a brief summary of the
  265             most frequent formatters:
  266               d --  decimal number
  267               ld  --  long decimal number
  268               u --  unsigned decimal number
  269               lu  --  long unsigned decimal number
  270               x --  hexadecimal number
  271               o --  octal number
  272               e --  floating point number in scientific notation
  273               f --  floating point number
  274               g --  either e or f, whichever takes less space
  275             Technically, g will use e if the exponent is less than -4 or
  276             greater than or equal to the precision. Trailing zeros are
  277             removed in this mode.
  278               If the format string ends in '#', trailing zeros will be
  279             removed in the decimal part. Note that this is not a standard
  280             syntax; it is handled internally by WeBWorK and not by Perl
  281             (although this should not be a concern to end users).
  282             The default format is '%0.5f#', which displays as a floating
  283             point number with 5 digits of precision and no trailing zeros.
  284             Other useful format strings might be '%0.2f' for displaying
  285             dollar amounts, or '%010d' to display an integer with leading
  286             zeros. Setting format to an empty string ( '' ) means no
  287             formatting will be used; this will show 'arbitrary' precision
  288             floating points.
  289 
  290 Default Values (As of 7/24/2000) (Option -- Variable Name -- Value)
  291 
  292   Format          --  $numFormatDefault   --  "%0.5f#"
  293   Relative Tolerance    --  $numRelPercentTolDefault  --  .1
  294   Absolute Tolerance    --  $numAbsTolDefault   --  .001
  295   Zero Level        --  $numZeroLevelDefault    --  1E-14
  296   Zero Level Tolerance  --  $numZeroLevelTolDefault   --  1E-12
  297 
  298 =cut
  299 
  300 
  301 =head3 num_cmp()
  302 
  303 Compares a number or a list of numbers, using a named hash of options to set
  304 parameters. This can make for more readable code than using the "mode"_num_cmp()
  305 style, but some people find one or the other easier to remember.
  306 
  307 ANS( num_cmp( answer or answer_array_ref, options_hash ) );
  308 
  309   1. the correct answer, or a reference to an array of correct answers
  310   2. a hash with the following keys (all optional):
  311     mode      --  'std' (default) (allows any expression evaluating to
  312                 a number)
  313               'strict' (only numbers are allowed)
  314               'frac' (fractions are allowed)
  315               'arith' (arithmetic expressions allowed)
  316     format      --  '%0.5f#' (default); defines formatting for the
  317                 correct answer
  318     tol       --  an absolute tolerance, or
  319     relTol      --  a relative tolerance
  320     units     --  the units to use for the answer(s)
  321     strings     --  a reference to an array of strings which are valid
  322                 answers (works like std_num_str_cmp() )
  323     zeroLevel   --  if the correct answer is this close to zero,
  324                  then zeroLevelTol applies
  325     zeroLevelTol  --  absolute tolerance to allow when answer is close
  326                  to zero
  327 
  328     debug     --  if set to 1, provides verbose listing of
  329                 hash entries throughout fliters.
  330 
  331   Returns an answer evaluator, or (if given a reference to an array of
  332   answers), a list of answer evaluators. Note that a reference to an array of
  333   answers results is just a shortcut for writing a separate <code>num_cmp()</code> for each
  334   answer.
  335 
  336 EXAMPLES:
  337 
  338   num_cmp( 5 )          --  correct answer is 5, using defaults
  339                   for all options
  340   num_cmp( [5,6,7] )        --  correct answers are 5, 6, and 7,
  341                   using defaults for all options
  342   num_cmp( 5, mode => 'strict' )  --  correct answer is 5, mode is strict
  343   num_cmp( [5,6], relTol => 5 ) --  correct answers are 5 and 6,
  344                     both with 5% relative tolerance
  345   num_cmp( 6, strings => ["Inf", "Minf", "NaN"] )
  346                   --  correct answer is 6, "Inf", "Minf",
  347                    and "NaN" recognized as valid, but
  348                    incorrect answers.
  349   num_cmp( "-INF", strings => ["INF", "-INF"] )
  350                   --  correct answer is "-INF", "INF" and
  351                    numerical expressions recognized as valid,
  352                    but incorrect answers.
  353 
  354 
  355 =cut
  356 
  357 sub num_cmp {
  358   my $correctAnswer = shift @_;
  359   $CA = $correctAnswer;
  360   my @opt = @_;
  361   my %out_options;
  362 
  363 #########################################################################
  364 # Retain this first check for backword compatibility.  Allows input of the form
  365 # num_cmp($ans, 1, '%0.5f') but warns against it
  366 #########################################################################
  367   my %known_options = (
  368           'mode'      =>  'std',
  369           'format'    =>  $numFormatDefault,
  370           'tol'     =>  $numAbsTolDefault,
  371           'relTol'    =>  $numRelPercentTolDefault,
  372           'units'     =>  undef,
  373           'strings'   =>  undef,
  374           'zeroLevel'   =>  $numZeroLevelDefault,
  375           'zeroLevelTol'  =>  $numZeroLevelTolDefault,
  376           'tolType'       =>  'relative',
  377           'tolerance'     =>  1,
  378           'reltol'    =>  undef,      #alternate spelling
  379           'unit'      =>  undef,      #alternate spelling
  380           'debug'     =>  0
  381         );
  382 
  383   my @output_list;
  384   my( $relPercentTol, $format, $zeroLevel, $zeroLevelTol) = @opt;
  385 
  386   unless( ref($correctAnswer) eq 'ARRAY' || scalar( @opt ) == 0 ||
  387         ( defined($opt[0]) and exists $known_options{$opt[0]} ) ) {
  388     # unless the first parameter is a list of arrays
  389     # or the second parameter is a known option or
  390     # no options were used,
  391     # use the old num_cmp which does not use options, but has inputs
  392     # $relPercentTol,$format,$zeroLevel,$zeroLevelTol
  393     warn "This method of using num_cmp() is deprecated. Please rewrite this" .
  394           " problem using the options style of parameter passing (or" .
  395           " check that your first option is spelled correctly).";
  396 
  397     %out_options = (  'relTol'    => $relPercentTol,
  398           'format'    => $format,
  399           'zeroLevel'   => $zeroLevel,
  400           'zeroLevelTol'  => $zeroLevelTol,
  401           'mode'      => 'std'
  402     );
  403   }
  404 
  405 #########################################################################
  406 # Now handle the options assuming they are entered in the form
  407 # num_cmp($ans, relTol=>1, format=>'%0.5f')
  408 #########################################################################
  409   %out_options = @opt;
  410   assign_option_aliases( \%out_options,
  411         'reltol'    =>      'relTol',
  412         'unit'      =>      'units',
  413         'abstol'  =>    'tol',
  414         );
  415 
  416   set_default_options( \%out_options,
  417            'tolType'    =>  (defined($out_options{'tol'}) ) ? 'absolute' : 'relative',  # the existence of "tol" means that we use absolute tolerance mode
  418            'tolerance'    =>  (defined($out_options{'tolType'}) && $out_options{'tolType'} eq 'absolute' ) ? $numAbsTolDefault : $numRelPercentTolDefault,  # relative tolerance is the default
  419            'mode'       =>  'std',
  420            'format'   =>  $numFormatDefault,
  421            'tol'        =>  undef,
  422            'relTol'   =>  undef,
  423            'units'    =>  undef,
  424            'strings'    =>  undef,
  425            'zeroLevel'  =>  $numZeroLevelDefault,
  426            'zeroLevelTol' =>  $numZeroLevelTolDefault,
  427            'debug'    =>  0,
  428   );
  429 
  430   # can't use both units and strings
  431   if( defined( $out_options{'units'} ) && defined( $out_options{'strings'} ) ) {
  432     warn "Can't use both 'units' and 'strings' in the same problem " .
  433     "(check your parameters to num_cmp() )";
  434   }
  435 
  436   # absolute tolType and relTol are incompatible. So are relative tolType and tol
  437   if( defined( $out_options{'relTol'} ) &&  $out_options{'tolType'} eq 'absolute' )  {
  438     warn "The 'tolType' 'absolute' is not compatible with 'relTol' " .
  439     "(check your parameters to num_cmp() )";
  440   }
  441   if( defined( $out_options{'tol'} ) &&  $out_options{'tolType'} eq 'relative' )  {
  442     warn "The 'tolType' 'relative' is not compatible with 'tol' " .
  443     "(check your parameters to num_cmp() )";
  444   }
  445 
  446 
  447   # Handle legacy options
  448     if ($out_options{tolType} eq 'absolute')   {
  449     $out_options{'tolerance'}=$out_options{'tol'} if defined($out_options{'tol'});
  450     delete($out_options{'relTol'}) if exists( $out_options{'relTol'} );
  451   } else {
  452     $out_options{'tolerance'}=$out_options{'relTol'} if defined($out_options{'relTol'});
  453     # delete($out_options{'tol'}) if exists( $out_options{'tol'} );
  454   }
  455   # end legacy options
  456 
  457   # thread over lists
  458   my @ans_list = ();
  459 
  460   if ( ref($correctAnswer) eq 'ARRAY' ) {
  461     @ans_list = @{$correctAnswer};
  462   }
  463   else { push( @ans_list, $correctAnswer );
  464   }
  465 
  466   # produce answer evaluators
  467   foreach my $ans (@ans_list) {
  468     if( defined( $out_options{'units'} ) ) {
  469       $ans = "$ans $out_options{'units'}";
  470 
  471       push( @output_list, NUM_CMP(  'correctAnswer'       =>  $ans,
  472               'tolerance'   =>  $out_options{'tolerance'},
  473               'tolType'   =>  $out_options{'tolType'},
  474               'format'    =>  $out_options{'format'},
  475               'mode'      =>  $out_options{'mode'},
  476               'zeroLevel'   =>  $out_options{'zeroLevel'},
  477               'zeroLevelTol'  =>  $out_options{'zeroLevelTol'},
  478               'debug'     =>  $out_options{'debug'},
  479               'units'     =>  $out_options{'units'},
  480             )
  481       );
  482     } elsif( defined( $out_options{'strings'} ) ) {
  483 
  484 
  485       push( @output_list, NUM_CMP(  'correctAnswer' =>  $ans,
  486               'tolerance' =>  $out_options{tolerance},
  487               'tolType' =>  $out_options{tolType},
  488               'format'  =>  $out_options{'format'},
  489               'mode'    =>  $out_options{'mode'},
  490               'zeroLevel' =>  $out_options{'zeroLevel'},
  491               'zeroLevelTol'  =>  $out_options{'zeroLevelTol'},
  492               'debug'   =>  $out_options{'debug'},
  493               'strings' =>  $out_options{'strings'},
  494          )
  495          );
  496     } else {
  497       push(@output_list,
  498         NUM_CMP(  'correctAnswer'       =>  $ans,
  499           'tolerance'   =>  $out_options{tolerance},
  500           'tolType'   =>  $out_options{tolType},
  501           'format'    =>  $out_options{'format'},
  502           'mode'      =>  $out_options{'mode'},
  503           'zeroLevel'   =>  $out_options{'zeroLevel'},
  504           'zeroLevelTol'        =>  $out_options{'zeroLevelTol'},
  505           'debug'     =>  $out_options{'debug'},
  506         ),
  507       );
  508       }
  509   }
  510 
  511   return (wantarray) ? @output_list : $output_list[0];
  512 }
  513 
  514 #legacy code for compatability purposes
  515 sub num_rel_cmp {   # compare numbers
  516     std_num_cmp( @_ );
  517 }
  518 
  519 
  520 =head3 "mode"_num_cmp() functions
  521 
  522 There are 16 functions total, 4 for each mode (std, frac, strict, arith). Each mode has
  523 one "normal" function, one which accepts a list of answers, one which uses absolute
  524 rather than relative tolerance, and one which uses absolute tolerance and accepts a list.
  525 The "std" family is documented below; all others work precisely the same.
  526 
  527  std_num_cmp($correctAnswer) OR
  528  std_num_cmp($correctAnswer, $relPercentTol) OR
  529  std_num_cmp($correctAnswer, $relPercentTol, $format) OR
  530  std_num_cmp($correctAnswer, $relPercentTol, $format, $zeroLevel) OR
  531  std_num_cmp($correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol)
  532 
  533   $correctAnswer  --  the correct answer
  534   $relPercentTol  --  the tolerance, as a percentage (optional)
  535   $format   --  the format of the displayed answer (optional)
  536   $zeroLevel  --  if the correct answer is this close to zero, then zeroLevelTol applies (optional)
  537   $zeroLevelTol --  absolute tolerance to allow when correct answer is close to zero (optional)
  538 
  539   std_num_cmp() uses standard mode (arithmetic operations and elementary
  540   functions allowed) and relative tolerance. Options are specified by
  541   one or more parameters. Note that if you wish to set an option which
  542   is later in the parameter list, you must set all previous options.
  543 
  544  std_num_cmp_abs($correctAnswer) OR
  545  std_num_cmp_abs($correctAnswer, $absTol) OR
  546  std_num_cmp_abs($correctAnswer, $absTol, $format)
  547 
  548   $correctAnswer    --  the correct answer
  549   $absTol     --  an absolute tolerance (optional)
  550   $format     --  the format of the displayed answer (optional)
  551 
  552   std_num_cmp_abs() uses standard mode and absolute tolerance. Options
  553   are set as with std_num_cmp(). Note that $zeroLevel and $zeroLevelTol
  554   do not apply with absolute tolerance.
  555 
  556  std_num_cmp_list($relPercentTol, $format, @answerList)
  557 
  558   $relPercentTol    --  the tolerance, as a percentage
  559   $format     --  the format of the displayed answer(s)
  560   @answerList   --  a list of one or more correct answers
  561 
  562   std_num_cmp_list() uses standard mode and relative tolerance. There
  563   is no way to set $zeroLevel or $zeroLevelTol. Note that no
  564   parameters are optional. All answers in the list will be
  565   evaluated with the same set of parameters.
  566 
  567  std_num_cmp_abs_list($absTol, $format, @answerList)
  568 
  569   $absTol   --  an absolute tolerance
  570   $format   --  the format of the displayed answer(s)
  571   @answerList --  a list of one or more correct answers
  572 
  573   std_num_cmp_abs_list() uses standard mode and absolute tolerance.
  574   Note that no parameters are optional. All answers in the list will be
  575   evaluated with the same set of parameters.
  576 
  577  arith_num_cmp(), arith_num_cmp_list(), arith_num_cmp_abs(), arith_num_cmp_abs_list()
  578  strict_num_cmp(), strict_num_cmp_list(), strict_num_cmp_abs(), strict_num_cmp_abs_list()
  579  frac_num_cmp(), frac_num_cmp_list(), frac_num_cmp_abs(), frac_num_cmp_abs_list()
  580 
  581 Examples:
  582 
  583   ANS( strict_num_cmp( 3.14159 ) )  --  The student answer must be a number
  584     in decimal or scientific notation which is within .1 percent of 3.14159.
  585     This assumes $numRelPercentTolDefault has been set to .1.
  586   ANS( strict_num_cmp( $answer, .01 ) ) --  The student answer must be a
  587     number within .01 percent of $answer (e.g. 3.14159 if $answer is 3.14159
  588     or $answer is "pi" or $answer is 4*atan(1)).
  589   ANS( frac_num_cmp( $answer) ) or ANS( frac_num_cmp( $answer,.01 ))  --
  590     The student answer can be a number or fraction, e.g. 2/3.
  591   ANS( arith_num_cmp( $answer) ) or ANS( arith_num_cmp( $answer,.01 ))  --
  592     The student answer can be an arithmetic expression, e.g. (2+3)/7-2^.5 .
  593   ANS( std_num_cmp( $answer) ) or ANS( std_num_cmp( $answer,.01 ))  --
  594     The student answer can contain elementary functions, e.g. sin(.3+pi/2)
  595 
  596 =cut
  597 
  598 sub std_num_cmp {           # compare numbers allowing use of elementary functions
  599     my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
  600 
  601   my %options = ( 'relTol'        =>  $relPercentTol,
  602             'format'    =>  $format,
  603             'zeroLevel'   =>  $zeroLevel,
  604             'zeroLevelTol'  =>  $zeroLevelTol
  605     );
  606 
  607     set_default_options( \%options,
  608        'tolType'      =>  'relative',
  609        'tolerance'    =>  $numRelPercentTolDefault,
  610        'mode'       =>  'std',
  611        'format'     =>  $numFormatDefault,
  612        'relTol'     =>  $numRelPercentTolDefault,
  613        'zeroLevel'    =>  $numZeroLevelDefault,
  614        'zeroLevelTol' =>  $numZeroLevelTolDefault,
  615        'debug'        =>  0,
  616     );
  617 
  618     num_cmp([$correctAnswer], %options);
  619 }
  620 
  621 ##  Similar to std_num_cmp but accepts a list of numbers in the form
  622 ##  std_num_cmp_list(relpercentTol,format,ans1,ans2,ans3,...)
  623 ##  format is of the form "%10.3g" or "", i.e., a format suitable for sprintf(). Use "" for default
  624 ##  You must enter a format and tolerance
  625 
  626 sub std_num_cmp_list {
  627   my ( $relPercentTol, $format, @answerList) = @_;
  628 
  629   my %options = ( 'relTol'  =>      $relPercentTol,
  630       'format'        =>      $format,
  631   );
  632 
  633   set_default_options( \%options,
  634            'tolType'      =>      'relative',
  635            'tolerance'    =>      $numRelPercentTolDefault,
  636            'mode'         =>      'std',
  637            'format'       =>      $numFormatDefault,
  638            'relTol'       =>      $numRelPercentTolDefault,
  639            'zeroLevel'    =>      $numZeroLevelDefault,
  640            'zeroLevelTol' =>      $numZeroLevelTolDefault,
  641            'debug'        =>      0,
  642   );
  643 
  644   num_cmp(\@answerList, %options);
  645 
  646 }
  647 
  648 sub std_num_cmp_abs {     # compare numbers allowing use of elementary functions with absolute tolerance
  649   my ( $correctAnswer, $absTol, $format) = @_;
  650   my %options = ( 'tolerance'  => $absTol,
  651             'format'     => $format
  652   );
  653 
  654   set_default_options (\%options,
  655            'tolType'      =>      'absolute',
  656            'tolerance'    =>      $absTol,
  657            'mode'         =>      'std',
  658            'format'       =>      $numFormatDefault,
  659            'zeroLevel'    =>      0,
  660            'zeroLevelTol' =>      0,
  661            'debug'        =>      0,
  662   );
  663 
  664   num_cmp([$correctAnswer], %options);
  665 }
  666 
  667 ##  See std_num_cmp_list for usage
  668 
  669 sub std_num_cmp_abs_list {
  670   my ( $absTol, $format, @answerList ) = @_;
  671 
  672         my %options = ( 'tolerance'         =>      $absTol,
  673                         'format'            =>      $format,
  674   );
  675 
  676         set_default_options( \%options,
  677                              'tolType'      =>      'absolute',
  678                              'tolerance'    =>      $absTol,
  679                              'mode'         =>      'std',
  680                              'format'       =>      $numFormatDefault,
  681                              'zeroLevel'    =>      0,
  682                              'zeroLevelTol' =>      0,
  683                              'debug'        =>      0,
  684         );
  685 
  686         num_cmp(\@answerList, %options);
  687 }
  688 
  689 sub frac_num_cmp {            # only allow fractions and numbers as submitted answer
  690 
  691   my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
  692 
  693   my %options = ( 'relTol'   =>   $relPercentTol,
  694           'format'     =>   $format,
  695           'zeroLevel'  =>   $zeroLevel,
  696           'zeroLevelTol'   =>   $zeroLevelTol
  697   );
  698 
  699   set_default_options( \%options,
  700          'tolType'     =>   'relative',
  701          'tolerance'   =>   $relPercentTol,
  702          'mode'      =>   'frac',
  703          'format'    =>   $numFormatDefault,
  704          'zeroLevel'   =>   $numZeroLevelDefault,
  705          'zeroLevelTol'  =>   $numZeroLevelTolDefault,
  706          'relTol'    =>   $numRelPercentTolDefault,
  707          'debug'     =>   0,
  708    );
  709 
  710   num_cmp([$correctAnswer], %options);
  711 }
  712 
  713 ##  See std_num_cmp_list for usage
  714 sub frac_num_cmp_list {
  715   my ( $relPercentTol, $format, @answerList ) = @_;
  716 
  717   my %options = (      'relTol'  =>   $relPercentTol,
  718                'format'    =>   $format
  719   );
  720 
  721   set_default_options( \%options,
  722        'tolType'     =>   'relative',
  723        'tolerance'   =>   $relPercentTol,
  724        'mode'      =>   'frac',
  725        'format'    =>   $numFormatDefault,
  726        'zeroLevel'   =>   $numZeroLevelDefault,
  727        'zeroLevelTol'  =>   $numZeroLevelTolDefault,
  728        'relTol'    =>   $numRelPercentTolDefault,
  729        'debug'     =>   0,
  730   );
  731 
  732   num_cmp(\@answerList, %options);
  733 }
  734 
  735 sub frac_num_cmp_abs {      # only allow fraction expressions as submitted answer with absolute tolerance
  736     my ( $correctAnswer, $absTol, $format ) = @_;
  737 
  738     my %options = (             'tolerance'    =>     $absTol,
  739               'format'       =>     $format
  740     );
  741 
  742   set_default_options (\%options,
  743       'tolType'    =>   'absolute',
  744       'tolerance'    =>   $absTol,
  745       'mode'       =>   'frac',
  746       'format'     =>   $numFormatDefault,
  747       'zeroLevel'    =>   0,
  748       'zeroLevelTol' =>   0,
  749       'debug'      =>   0,
  750   );
  751 
  752     num_cmp([$correctAnswer], %options);
  753 }
  754 
  755 ##  See std_num_cmp_list for usage
  756 
  757 sub frac_num_cmp_abs_list {
  758     my ( $absTol, $format, @answerList ) = @_;
  759 
  760     my %options = (             'tolerance'    =>     $absTol,
  761               'format'       =>     $format
  762     );
  763 
  764     set_default_options (\%options,
  765        'tolType'      =>     'absolute',
  766        'tolerance'    =>     $absTol,
  767        'mode'         =>     'frac',
  768        'format'       =>     $numFormatDefault,
  769        'zeroLevel'    =>     0,
  770        'zeroLevelTol' =>     0,
  771        'debug'        =>     0,
  772     );
  773 
  774     num_cmp(\@answerList, %options);
  775 }
  776 
  777 
  778 sub arith_num_cmp {           # only allow arithmetic expressions as submitted answer
  779 
  780     my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
  781 
  782     my %options = (     'relTol'      =>     $relPercentTol,
  783       'format'         =>     $format,
  784       'zeroLevel'      =>     $zeroLevel,
  785       'zeroLevelTol'   =>     $zeroLevelTol
  786     );
  787 
  788     set_default_options( \%options,
  789                         'tolType'       =>     'relative',
  790                         'tolerance'     =>     $relPercentTol,
  791                         'mode'          =>     'arith',
  792                         'format'        =>     $numFormatDefault,
  793                         'zeroLevel'     =>     $numZeroLevelDefault,
  794                         'zeroLevelTol'  =>     $numZeroLevelTolDefault,
  795                         'relTol'        =>     $numRelPercentTolDefault,
  796                         'debug'         =>     0,
  797     );
  798 
  799     num_cmp([$correctAnswer], %options);
  800 }
  801 
  802 ##  See std_num_cmp_list for usage
  803 sub arith_num_cmp_list {
  804     my ( $relPercentTol, $format, @answerList ) = @_;
  805 
  806     my %options = (     'relTol'     =>     $relPercentTol,
  807                         'format'        =>     $format,
  808     );
  809 
  810     set_default_options( \%options,
  811                          'tolType'       =>     'relative',
  812                          'tolerance'     =>     $relPercentTol,
  813                          'mode'          =>     'arith',
  814                          'format'        =>     $numFormatDefault,
  815                          'zeroLevel'     =>     $numZeroLevelDefault,
  816                          'zeroLevelTol'  =>     $numZeroLevelTolDefault,
  817                          'relTol'        =>     $numRelPercentTolDefault,
  818                          'debug'         =>     0,
  819     );
  820 
  821     num_cmp(\@answerList, %options);
  822 }
  823 
  824 sub arith_num_cmp_abs {     # only allow arithmetic expressions as submitted answer with absolute tolerance
  825     my ( $correctAnswer, $absTol, $format ) = @_;
  826 
  827     my %options = (      'tolerance'    =>     $absTol,
  828                          'format'       =>     $format
  829     );
  830 
  831     set_default_options (\%options,
  832                          'tolType'      =>     'absolute',
  833                          'tolerance'    =>     $absTol,
  834                          'mode'         =>     'arith',
  835                          'format'       =>     $numFormatDefault,
  836                          'zeroLevel'    =>     0,
  837                          'zeroLevelTol' =>     0,
  838                          'debug'        =>     0,
  839     );
  840 
  841     num_cmp([$correctAnswer], %options);
  842 }
  843 
  844 ##  See std_num_cmp_list for usage
  845 sub arith_num_cmp_abs_list {
  846     my ( $absTol, $format, @answerList ) = @_;
  847 
  848     my %options = (      'tolerance'    =>     $absTol,
  849                          'format'       =>     $format
  850     );
  851 
  852     set_default_options (\%options,
  853                          'tolType'      =>     'absolute',
  854                          'tolerance'    =>     $absTol,
  855                          'mode'         =>     'arith',
  856                          'format'       =>     $numFormatDefault,
  857                          'zeroLevel'    =>     0,
  858                          'zeroLevelTol' =>     0,
  859                          'debug'        =>     0,
  860     );
  861 
  862     num_cmp(\@answerList, %options);
  863 }
  864 
  865 sub strict_num_cmp {          # only allow numbers as submitted answer
  866     my ( $correctAnswer, $relPercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
  867 
  868     my %options = (      'relTol'     =>     $relPercentTol,
  869                          'format'        =>     $format,
  870                          'zeroLevel'     =>     $zeroLevel,
  871                          'zeroLevelTol'  =>     $zeroLevelTol
  872     );
  873 
  874     set_default_options( \%options,
  875                          'tolType'       =>     'relative',
  876                          'tolerance'     =>     $relPercentTol,
  877                          'mode'          =>     'strict',
  878                          'format'        =>     $numFormatDefault,
  879                          'zeroLevel'     =>     $numZeroLevelDefault,
  880                          'zeroLevelTol'  =>     $numZeroLevelTolDefault,
  881                          'relTol'        =>     $numRelPercentTolDefault,
  882                          'debug'         =>     0,
  883     );
  884     num_cmp([$correctAnswer], %options);
  885 
  886 }
  887 
  888 ##  See std_num_cmp_list for usage
  889 sub strict_num_cmp_list {       # compare numbers
  890     my ( $relPercentTol, $format, @answerList ) = @_;
  891 
  892     my %options = (    'relTol'     =>     $relPercentTol,
  893        'format'        =>     $format,
  894     );
  895 
  896     set_default_options( \%options,
  897                          'tolType'       =>     'relative',
  898                          'tolerance'     =>     $relPercentTol,
  899                          'mode'          =>     'strict',
  900                          'format'        =>     $numFormatDefault,
  901                          'zeroLevel'     =>     $numZeroLevelDefault,
  902                          'zeroLevelTol'  =>     $numZeroLevelTolDefault,
  903                          'relTol'        =>     $numRelPercentTolDefault,
  904                          'debug'         =>     0,
  905     );
  906 
  907     num_cmp(\@answerList, %options);
  908 }
  909 
  910 
  911 sub strict_num_cmp_abs {        # only allow numbers as submitted answer with absolute tolerance
  912     my ( $correctAnswer, $absTol, $format ) = @_;
  913 
  914     my %options = (       'tolerance'    =>     $absTol,
  915                     'format'       =>     $format
  916     );
  917 
  918     set_default_options (\%options,
  919                          'tolType'      =>     'absolute',
  920                          'tolerance'    =>     $absTol,
  921                          'mode'         =>     'strict',
  922                          'format'       =>     $numFormatDefault,
  923                          'zeroLevel'    =>     0,
  924                          'zeroLevelTol' =>     0,
  925                          'debug'        =>     0,
  926     );
  927     num_cmp([$correctAnswer], %options);
  928 
  929 }
  930 
  931 ##  See std_num_cmp_list for usage
  932 sub strict_num_cmp_abs_list {     # compare numbers
  933     my ( $absTol, $format, @answerList ) = @_;
  934 
  935     my %options = (      'tolerance'    =>     $absTol,
  936                          'format'       =>     $format
  937     );
  938 
  939     set_default_options (\%options,
  940                          'tolType'      =>     'absolute',
  941                          'tolerance'    =>     $absTol,
  942                          'mode'         =>     'strict',
  943                          'format'       =>     $numFormatDefault,
  944                          'zeroLevel'    =>     0,
  945                          'zeroLevelTol' =>     0,
  946                          'debug'        =>     0,
  947     );
  948 
  949     num_cmp(\@answerList, %options);
  950 }
  951 
  952 ## sub numerical_compare_with_units
  953 ## Compares a number with units
  954 ## Deprecated; use num_cmp()
  955 ##
  956 ## IN:  a string which includes the numerical answer and the units
  957 ##    a hash with the following keys (all optional):
  958 ##      mode    --  'std', 'frac', 'arith', or 'strict'
  959 ##      format    --  the format to use when displaying the answer
  960 ##      tol   --  an absolute tolerance, or
  961 ##      relTol    --  a relative tolerance
  962 ##      zeroLevel --  if the correct answer is this close to zero, then zeroLevelTol applies
  963 ##      zeroLevelTol  --  absolute tolerance to allow when correct answer is close to zero
  964 
  965 # This mode is depricated.  send input through num_cmp -- it can handle units.
  966 
  967 sub numerical_compare_with_units {
  968   my $correct_answer = shift;  # the answer is a string which includes both the numerical answer and the units.
  969   my %options = @_;    # all of the other inputs are (key value) pairs
  970 
  971   # Prepare the correct answer
  972   $correct_answer = str_filters( $correct_answer, 'trim_whitespace' );
  973 
  974   # it surprises me that the match below works since the first .* is greedy.
  975   my ($correct_num_answer, $correct_units) = $correct_answer =~ /^(.*)\s+([^\s]*)$/;
  976   $options{units} = $correct_units;
  977 
  978   num_cmp($correct_num_answer, %options);
  979 }
  980 
  981 
  982 =head3 std_num_str_cmp()
  983 
  984 NOTE: This function is maintained for compatibility. num_cmp() with the
  985     'strings' parameter is slightly preferred.
  986 
  987 std_num_str_cmp() is used when the correct answer could be either a number or a
  988 string. For example, if you wanted the student to evaluate a function at number
  989 of points, but write "Inf" or "Minf" if the function is unbounded. This routine
  990 will provide error messages that do not give a hint as to whether the correct
  991 answer is a string or a number. For numerical comparisons, std_num_cmp() is
  992 used internally; for string comparisons, std_str_cmp() is used.  String answers
  993 must consist entirely of letters except that an initial minus sign is allowed.
  994 E.g. "inf" and "-inf" are valid strings where as "too-big" is not.
  995 
  996  std_num_str_cmp( $correctAnswer ) OR
  997  std_num_str_cmp( $correctAnswer, $ra_legalStrings ) OR
  998  std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol ) OR
  999  std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol, $format ) OR
 1000  std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol, $format, $zeroLevel ) OR
 1001  std_num_str_cmp( $correctAnswer, $ra_legalStrings, $relPercentTol, $format,
 1002           $zeroLevel, $zeroLevelTol )
 1003 
 1004   $correctAnswer    --  the correct answer
 1005   $ra_legalStrings  --  a reference to an array of legal strings, e.g. ["str1", "str2"]
 1006   $relPercentTol    --  the error tolerance as a percentage
 1007   $format     --  the display format
 1008   $zeroLevel    --  if the correct answer is this close to zero, then zeroLevelTol applies
 1009   $zeroLevelTol   --  absolute tolerance to allow when correct answer is close to zero
 1010 
 1011 Examples:
 1012   ANS( std_num_str_cmp( $ans, ["Inf", "Minf", "NaN"] ) );
 1013   ANS( std_num_str_cmp( $ans, ["INF", "-INF"] ) );
 1014 
 1015 =cut
 1016 
 1017 sub std_num_str_cmp {
 1018   my ( $correctAnswer, $ra_legalStrings, $relpercentTol, $format, $zeroLevel, $zeroLevelTol ) = @_;
 1019   # warn ('This method is depreciated.  Use num_cmp instead.');
 1020   return num_cmp ($correctAnswer, strings=>$ra_legalStrings, relTol=>$relpercentTol, format=>$format,
 1021     zeroLevel=>$zeroLevel, zeroLevelTol=>$zeroLevelTol);
 1022 }
 1023 
 1024 sub NUM_CMP {                              # low level numeric compare (now uses Parser)
 1025   return ORIGINAL_NUM_CMP(@_)
 1026     if main::PG_restricted_eval(q!$main::useOldAnswerMacros!);
 1027 
 1028   my %num_params = @_;
 1029 
 1030   #
 1031   #  check for required parameters
 1032   #
 1033   my @keys = qw(correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug);
 1034   foreach my $key (@keys) {
 1035       warn "$key must be defined in options when calling NUM_CMP"
 1036         unless defined($num_params{$key});
 1037   }
 1038 
 1039   my $correctAnswer = $num_params{correctAnswer};
 1040   my $mode          = $num_params{mode};
 1041   my %options       = (debug => $num_params{debug});
 1042 
 1043   #
 1044   #  Hack to fix up exponential notation in correct answer
 1045   #  (e.g., perl will pass .0000001 as 1e-07).
 1046   #
 1047   $correctAnswer = uc($correctAnswer)
 1048     if $correctAnswer =~ m/e/ && Value::isNumber($correctAnswer);
 1049 
 1050   #
 1051   #  Get an apppropriate context based on the mode
 1052   #
 1053   my $context;
 1054   for ($mode) {
 1055     /^strict$/i    and do {
 1056       $context = $Parser::Context::Default::context{LimitedNumeric}->copy;
 1057       last;
 1058     };
 1059     /^arith$/i     and do {
 1060       $context = $Parser::Context::Default::context{LegacyNumeric}->copy;
 1061       $context->functions->disable('All');
 1062       last;
 1063     };
 1064     /^frac$/i  and do {
 1065       $context = $Parser::Context::Default::context{'LimitedNumeric-Fraction'}->copy;
 1066       last;
 1067     };
 1068 
 1069     # default
 1070     $context = $Parser::Context::Default::context{LegacyNumeric}->copy;
 1071   }
 1072   $context->{format}{number} = $num_params{'format'};
 1073   $context->strings->clear;
 1074   #  FIXME:  should clear variables as well? Copy them from the current context?
 1075 
 1076   #
 1077   #  Add the strings to the context
 1078   #
 1079   if ($num_params{strings}) {
 1080     foreach my $string (@{$num_params{strings}}) {
 1081       my %tex = ($string =~ m/(-?)inf(inity)?/i)? (TeX => "$1\\infty"): ();
 1082       $context->strings->add(uc($string) => {%tex});
 1083     }
 1084   }
 1085 
 1086   #
 1087   #  Set the tolerances
 1088   #
 1089   if ($num_params{tolType} eq 'absolute') {
 1090     $context->flags->set(
 1091       tolerance => $num_params{tolerance},
 1092       tolType => 'absolute',
 1093     );
 1094   } else {
 1095     $context->flags->set(
 1096       tolerance => .01*$num_params{tolerance},
 1097       tolType => 'relative',
 1098     );
 1099   }
 1100   $context->flags->set(
 1101     zeroLevel => $num_params{zeroLevel},
 1102     zeroLevelTol => $num_params{zeroLevelTol},
 1103   );
 1104 
 1105   #
 1106   #  Get the proper Parser object for the professor's answer
 1107   #  using the initialized context
 1108   #
 1109   my $oldContext = &$Context($context); my $r;
 1110   if ($num_params{units}) {
 1111     $r = new Parser::Legacy::NumberWithUnits($correctAnswer);
 1112           $options{rh_correct_units} = $num_params{units};
 1113   } else {
 1114     $r = Value::Formula->new($correctAnswer);
 1115     die "The professor's answer can't be a formula" unless $r->isConstant;
 1116     $r = $r->eval; $r = new Value::Real($r) unless Value::class($r) eq 'String';
 1117     $r->{correct_ans} = $correctAnswer;
 1118     if ($mode eq 'phase_pi') {
 1119       my $pi = 4*atan2(1,1);
 1120       while ($r >  $pi/2) {$r -= $pi}
 1121       while ($r < -$pi/2) {$r += $pi}
 1122     }
 1123   }
 1124   #
 1125   #  Get the answer checker from the parser object
 1126   #
 1127   my $cmp = $r->cmp(%options);
 1128   $cmp->install_pre_filter(sub {
 1129     my $rh_ans = shift;
 1130     $rh_ans->{original_student_ans} = $rh_ans->{student_ans};
 1131     $rh_ans->{original_correct_ans} = $rh_ans->{correct_ans};
 1132     return $rh_ans;
 1133   });
 1134   $cmp->install_post_filter(sub {
 1135     my $rh_ans = shift;
 1136     $rh_ans->{student_ans} = $rh_ans->{student_value}->string
 1137       if ref($rh_ans->{student_value});
 1138     return $rh_ans;
 1139   });
 1140   $cmp->{debug} = $num_params{debug};
 1141   &$Context($oldContext);
 1142 
 1143   return $cmp;
 1144 }
 1145 
 1146 #
 1147 #  The original version, for backward compatibility
 1148 #  (can be removed when the Parser-based version is more fully tested.)
 1149 #
 1150 sub ORIGINAL_NUM_CMP {    # low level numeric compare
 1151   my %num_params = @_;
 1152 
 1153   my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug );
 1154   foreach my $key (@keys) {
 1155       warn "$key must be defined in options when calling NUM_CMP" unless defined ($num_params{$key});
 1156   }
 1157 
 1158   my $correctAnswer = $num_params{'correctAnswer'};
 1159   my $format        = $num_params{'format'};
 1160   my $mode        = $num_params{'mode'};
 1161 
 1162   if( $num_params{tolType} eq 'relative' ) {
 1163     $num_params{'tolerance'} = .01*$num_params{'tolerance'};
 1164   }
 1165 
 1166   my $formattedCorrectAnswer;
 1167   my $correct_units;
 1168   my $correct_num_answer;
 1169   my %correct_units;
 1170   my $corrAnswerIsString = 0;
 1171 
 1172 
 1173   if (defined($num_params{units}) && $num_params{units}) {
 1174     $correctAnswer  = str_filters( $correctAnswer, 'trim_whitespace' );
 1175             # units are in form stuff space units where units contains no spaces.
 1176 
 1177     ($correct_num_answer, $correct_units) = $correctAnswer =~ /^(.*)\s+([^\s]*)$/;
 1178     %correct_units = Units::evaluate_units($correct_units);
 1179     if ( defined( $correct_units{'ERROR'} ) ) {
 1180        warn ("ERROR: The answer \"$correctAnswer\" in the problem definition cannot be parsed:\n" .
 1181         "$correct_units{'ERROR'}\n");
 1182     }
 1183     # $formattedCorrectAnswer = spf($correct_num_answer,$num_params{'format'}) . " $correct_units";
 1184     $formattedCorrectAnswer = prfmt($correct_num_answer,$num_params{'format'}) . " $correct_units";
 1185 
 1186   } elsif (defined($num_params{strings}) && $num_params{strings}) {
 1187     my $legalString = '';
 1188     my @legalStrings = @{$num_params{strings}};
 1189     $correct_num_answer = $correctAnswer;
 1190     $formattedCorrectAnswer = $correctAnswer;
 1191     foreach $legalString (@legalStrings) {
 1192       if ( uc($correctAnswer) eq uc($legalString) ) {
 1193         $corrAnswerIsString = 1;
 1194 
 1195         last;
 1196       }
 1197     }     ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
 1198   } else {
 1199     $correct_num_answer = $correctAnswer;
 1200     $formattedCorrectAnswer = prfmt( $correctAnswer, $num_params{'format'} );
 1201   }
 1202 
 1203   $correct_num_answer = math_constants($correct_num_answer);
 1204 
 1205   my $PGanswerMessage = '';
 1206 
 1207   my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
 1208 
 1209   if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
 1210       ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
 1211   } else { # case of a string answer
 1212     $PG_eval_errors = ' ';
 1213     $correctVal = $correctAnswer;
 1214   }
 1215 
 1216   if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal)) && $corrAnswerIsString == 0)) {
 1217         ##error message from eval or above
 1218     warn "Error in 'correct' answer: $PG_eval_errors<br>
 1219           The answer $correctAnswer evaluates to $correctVal,
 1220           which cannot be interpreted as a number.  ";
 1221 
 1222   }
 1223   #########################################################################
 1224 
 1225   #construct the answer evaluator
 1226       my $answer_evaluator = new AnswerEvaluator;
 1227       $answer_evaluator->{debug} = $num_params{debug};
 1228       $answer_evaluator->ans_hash(
 1229                 correct_ans       =>  $correctVal,
 1230                 type          =>  "${mode}_number",
 1231                 tolerance       =>  $num_params{tolerance},
 1232               tolType         =>  $num_params{tolType},
 1233               units         =>  $correct_units,
 1234                 original_correct_ans  =>  $formattedCorrectAnswer,
 1235                 rh_correct_units    =>      \%correct_units,
 1236                 answerIsString      =>  $corrAnswerIsString,
 1237       );
 1238       my ($in, $formattedSubmittedAnswer);
 1239   $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
 1240     $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;}
 1241   );
 1242 
 1243 
 1244 
 1245   if (defined($num_params{units}) && $num_params{units}) {
 1246       $answer_evaluator->install_pre_filter(\&check_units);
 1247   }
 1248   if (defined($num_params{strings}) && $num_params{strings}) {
 1249       $answer_evaluator->install_pre_filter(\&check_strings, %num_params);
 1250   }
 1251 
 1252   ## FIXME? - this pre filter was moved before check_units to allow
 1253   ##      for latex preview of answers with no units.
 1254   ##          seems to work but may have unintended side effects elsewhere.
 1255 
 1256   ##      Actually it caused trouble with the check strings package so it has been moved back
 1257   #       We'll try some other method  -- perhaps add code to fix_answer for display
 1258   $answer_evaluator->install_pre_filter(\&check_syntax);
 1259 
 1260   $answer_evaluator->install_pre_filter(\&math_constants);
 1261 
 1262   if ($mode eq 'std') {
 1263         # do nothing
 1264   } elsif ($mode eq 'strict') {
 1265     $answer_evaluator->install_pre_filter(\&is_a_number);
 1266   } elsif ($mode eq 'arith') {
 1267       $answer_evaluator->install_pre_filter(\&is_an_arithmetic_expression);
 1268     } elsif ($mode eq 'frac') {
 1269       $answer_evaluator->install_pre_filter(\&is_a_fraction);
 1270 
 1271     } elsif ($mode eq 'phase_pi') {
 1272       $answer_evaluator->install_pre_filter(\&phase_pi);
 1273 
 1274     } else {
 1275       $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
 1276       $formattedSubmittedAnswer = $in;
 1277     }
 1278 
 1279   if ($corrAnswerIsString == 0 ){   # avoiding running compare_numbers when correct answer is a string.
 1280     $answer_evaluator->install_evaluator(\&compare_numbers, %num_params);
 1281    }
 1282 
 1283 
 1284 ###############################################################################
 1285 # We'll leave these next lines out for now, so that the evaluated versions of the student's and professor's
 1286 # can be displayed in the answer message.  This may still cause a few anomolies when strings are used
 1287 #
 1288 ###############################################################################
 1289 
 1290   $answer_evaluator->install_post_filter(\&fix_answers_for_display);
 1291 
 1292       $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
 1293           return $rh_ans unless $rh_ans->catch_error('EVAL');
 1294           $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message};
 1295           $rh_ans->clear_error('EVAL'); } );
 1296       $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } );
 1297       $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('UNITS'); } );
 1298       $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('NUMBER'); } );
 1299       $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } );
 1300       $answer_evaluator;
 1301 }
 1302 
 1303 
 1304 
 1305 ##########################################################################
 1306 ##########################################################################
 1307 ## Function answer evaluators
 1308 
 1309 =head2 Function Answer Evaluators
 1310 
 1311 Function answer evaluators take in a function, compare it numerically to a
 1312 correct function, and return a score. They can require an exactly equivalent
 1313 function, or one that is equal up to a constant. They can accept or reject an
 1314 answer based on specified tolerances for numerical deviation.
 1315 
 1316 Function Comparison Options
 1317 
 1318   correctEqn  --  The correct equation, specified as a string. It may include
 1319           all basic arithmetic operations, as well as elementary
 1320           functions. Variable usage is described below.
 1321 
 1322   Variables --  The independent variable(s). When comparing the correct
 1323           equation to the student equation, each variable will be
 1324           replaced by a certain number of numerical values. If
 1325           the student equation agrees numerically with the correct
 1326           equation, they are considered equal. Note that all
 1327           comparison is numeric; it is possible (although highly
 1328           unlikely and never a practical concern) for two unequal
 1329           functions to yield the same numerical results.
 1330 
 1331   Limits    --  The limits of evaluation for the independent variables.
 1332           Each variable is evaluated only in the half-open interval
 1333           [lower_limit, upper_limit). This is useful if the function
 1334           has a singularity or is not defined in a certain range.
 1335           For example, the function "sqrt(-1-x)" could be evaluated
 1336           in [-2,-1).
 1337 
 1338   Tolerance --  Tolerance in function comparisons works exactly as in
 1339           numerical comparisons; see the numerical comparison
 1340           documentation for a complete description. Note that the
 1341           tolerance does applies to the function as a whole, not
 1342           each point individually.
 1343 
 1344   Number of --  Specifies how many points to evaluate each variable at. This
 1345   Points      is typically 3, but can be set higher if it is felt that
 1346           there is a strong possibility of "false positives."
 1347 
 1348   Maximum   --  Sets the maximum size of the constant of integration. For
 1349   Constant of   technical reasons concerning floating point arithmetic, if
 1350   Integration   the additive constant, i.e., the constant of integration, is
 1351           greater (in absolute value) than maxConstantOfIntegration
 1352           AND is greater than maxConstantOfIntegration times the
 1353           correct value, WeBWorK will give an error message saying
 1354           that it can not handle such a large constant of integration.
 1355           This is to prevent e.g. cos(x) + 1E20 or even 1E20 as being
 1356           accepted as a correct antiderivatives of sin(x) since
 1357           floating point arithmetic cannot tell the difference
 1358           between cos(x) + 1E20, 1E20, and -cos(x) + 1E20.
 1359 
 1360 Technical note: if you examine the code for the function routines, you will see
 1361 that most subroutines are simply doing some basic error-checking and then
 1362 passing the parameters on to the low-level FUNCTION_CMP(). Because this routine
 1363 is set up to handle multivariable functions, with single-variable functions as
 1364 a special case, it is possible to pass multivariable parameters to single-
 1365 variable functions. This usage is strongly discouraged as unnecessarily
 1366 confusing. Avoid it.
 1367 
 1368 Default Values (As of 7/24/2000) (Option -- Variable Name -- Value)
 1369 
 1370   Variable      --  $functVarDefault      --  'x'
 1371   Relative Tolerance    --  $functRelPercentTolDefault    --  .1
 1372   Absolute Tolerance    --  $functAbsTolDefault     --  .001
 1373   Lower Limit     --  $functLLimitDefault     --  .0000001
 1374   Upper Limit     --  $functULimitDefault     --  1
 1375   Number of Points    --  $functNumOfPoints     --  3
 1376   Zero Level      --  $functZeroLevelDefault      --  1E-14
 1377   Zero Level Tolerance    --  $functZeroLevelTolDefault   --  1E-12
 1378   Maximum Constant    --  $functMaxConstantOfIntegration    --  1E8
 1379     of Integration
 1380 
 1381 =cut
 1382 
 1383 
 1384 
 1385 =head3 fun_cmp()
 1386 
 1387 Compares a function or a list of functions, using a named hash of options to set
 1388 parameters. This can make for more readable code than using the function_cmp()
 1389 style, but some people find one or the other easier to remember.
 1390 
 1391 ANS( fun_cmp( answer or answer_array_ref, options_hash ) );
 1392 
 1393   1. a string containing the correct function, or a reference to an
 1394     array of correct functions
 1395   2. a hash containing the following items (all optional):
 1396     var           --  either the number of variables or a reference to an
 1397                       array of variable names (see below)
 1398     limits            --  reference to an array of arrays of limits (see below), or:
 1399     mode            --  'std' (default) (function must match exactly), or:
 1400                     'antider' (function must match up to a constant)
 1401     relTol            --  (default) a relative tolerance (as a percentage), or:
 1402     tol           --  an absolute tolerance for error
 1403     numPoints         --  the number of points to evaluate the function at
 1404     maxConstantOfIntegration      --  maximum size of the constant of integration
 1405     zeroLevel         --  if the correct answer is this close to zero, then
 1406                       zeroLevelTol applies
 1407     zeroLevelTol          --  absolute tolerance to allow when answer is close to zero
 1408     test_points    -- a list of points to use in checking the function, or a list of lists when there is more than one variable.
 1409     params                an array of "free" parameters which can be used to adapt
 1410                     the correct answer to the submitted answer. (e.g. ['c'] for
 1411                     a constant of integration in the answer x^3/3 + c.
 1412     debug           --  when set to 1 this provides extra information while checking the
 1413                         the answer.
 1414 
 1415   Returns an answer evaluator, or (if given a reference to an array
 1416   of answers), a list of answer evaluators
 1417 
 1418 ANSWER:
 1419 
 1420   The answer must be in the form of a string. The answer can contain
 1421   functions, pi, e, and arithmetic operations. However, the correct answer
 1422   string follows a slightly stricter syntax than student answers; specifically,
 1423   there is no implicit multiplication. So the correct answer must be "3*x" rather
 1424   than "3 x". Students can still enter "3 x".
 1425 
 1426 VARIABLES:
 1427 
 1428   The var parameter can contain either a number or a reference to an array of
 1429   variable names. If it contains a number, the variables are named automatically
 1430   as follows: 1 variable  --  x
 1431       2 variables --  x, y
 1432       3 variables --  x, y, z
 1433       4 or more --  x_1, x_2, x_3, etc.
 1434   If the var parameter contains a reference to an array of variable names, then
 1435   the number of variables is determined by the number of items in the array. A
 1436   reference to an array is created with brackets, e.g. "var => ['r', 's', 't']".
 1437   If only one variable is being used, you can write either "var => ['t']" for
 1438   consistency or "var => 't'" as a shortcut. The default is one variable, x.
 1439 
 1440 LIMITS:
 1441 
 1442   Limits are specified with the limits parameter. You may NOT use llimit/ulimit.
 1443   If you specify limits for one variable, you must specify them for all variables.
 1444   The limit parameter must be a reference to an array of arrays of the form
 1445   [lower_limit. upper_limit], each array corresponding to the lower and upper
 1446   endpoints of the (half-open) domain of one variable. For example,
 1447   "vars => 2, limits => [[0,2], [-3,8]]" would cause x to be evaluated in [0,2) and
 1448   y to be evaluated in [-3,8). If only one variable is being used, you can write
 1449   either "limits => [[0,3]]" for consistency or "limits => [0,3]" as a shortcut.
 1450 
 1451 TEST POINTS:
 1452 
 1453   In some cases, the problem writer may want to specify the points
 1454   used to check a particular function.  For example, if you want to
 1455   use only integer values, they can be specified.  With one variable,
 1456   you can specify "test_points => [1,4,5,6]" or "test_points => [[1,4,5,6]]".
 1457   With more variables, specify the list for the first variable, then the
 1458   second, and so on: "vars=>['x','y'], test_points => [[1,4,5],[7,14,29]]".
 1459 
 1460   If the problem writer wants random values which need to meet some special
 1461   restrictions (such as being integers), they can be generated in the problem:
 1462   "test_points=>[random(1,50), random(1,50), random(1,50), random(1,50)]".
 1463 
 1464   Note that test_points should not be used for function checks which involve
 1465   parameters  (either explicitly given by "params", or as antiderivatives).
 1466 
 1467 EXAMPLES:
 1468 
 1469   fun_cmp( "3*x" )  --  standard compare, variable is x
 1470   fun_cmp( ["3*x", "4*x+3", "3*x**2"] ) --  standard compare, defaults used for all three functions
 1471   fun_cmp( "3*t", var => 't' )  --  standard compare, variable is t
 1472   fun_cmp( "5*x*y*z", var => 3 )  --  x, y and z are the variables
 1473   fun_cmp( "5*x", mode => 'antider' ) --  student answer must match up to constant (i.e., 5x+C)
 1474   fun_cmp( ["3*x*y", "4*x*y"], limits => [[0,2], [5,7]] ) --  x evaluated in [0,2)
 1475                                 y evaluated in [5,7)
 1476 
 1477 =cut
 1478 
 1479 sub fun_cmp {
 1480   my $correctAnswer = shift @_;
 1481   my %opt           = @_;
 1482 
 1483     assign_option_aliases( \%opt,
 1484         'vars'    =>  'var',    # set the standard option 'var' to the one specified as vars
 1485           'domain'  =>  'limits', # set the standard option 'limits' to the one specified as domain
 1486           'reltol'    =>  'relTol',
 1487           'param'   =>  'params',
 1488     );
 1489 
 1490     set_default_options(  \%opt,
 1491         'var'         =>  $functVarDefault,
 1492             'params'        =>  [],
 1493         'limits'        =>  [[$functLLimitDefault, $functULimitDefault]],
 1494         'test_points'   => undef,
 1495         'mode'          =>  'std',
 1496         'tolType'       =>    (defined($opt{tol}) ) ? 'absolute' : 'relative',
 1497         'tol'         =>  .01, # default mode should be relative, to obtain this tol must not be defined
 1498             'relTol'        =>  $functRelPercentTolDefault,
 1499         'numPoints'       =>  $functNumOfPoints,
 1500         'maxConstantOfIntegration'  =>  $functMaxConstantOfIntegration,
 1501         'zeroLevel'       =>  $functZeroLevelDefault,
 1502         'zeroLevelTol'      =>  $functZeroLevelTolDefault,
 1503             'debug'         =>  0,
 1504      );
 1505 
 1506     # allow var => 'x' as an abbreviation for var => ['x']
 1507   my %out_options = %opt;
 1508   unless ( ref($out_options{var}) eq 'ARRAY' || $out_options{var} =~ m/^\d+$/) {
 1509     $out_options{var} = [$out_options{var}];
 1510   }
 1511   # allow params => 'c' as an abbreviation for params => ['c']
 1512   unless ( ref($out_options{params}) eq 'ARRAY' ) {
 1513     $out_options{params} = [$out_options{params}];
 1514   }
 1515   my ($tolType, $tol);
 1516     if ($out_options{tolType} eq 'absolute') {
 1517     $tolType = 'absolute';
 1518     $tol = $out_options{'tol'};
 1519     delete($out_options{'relTol'}) if exists( $out_options{'relTol'} );
 1520   } else {
 1521     $tolType = 'relative';
 1522     $tol = $out_options{'relTol'};
 1523     delete($out_options{'tol'}) if exists( $out_options{'tol'} );
 1524   }
 1525 
 1526   my @output_list = ();
 1527   # thread over lists
 1528   my @ans_list = ();
 1529 
 1530   if ( ref($correctAnswer) eq 'ARRAY' ) {
 1531     @ans_list = @{$correctAnswer};
 1532   }
 1533   else {
 1534     push( @ans_list, $correctAnswer );
 1535   }
 1536 
 1537   # produce answer evaluators
 1538   foreach my $ans (@ans_list) {
 1539     push(@output_list,
 1540       FUNCTION_CMP(
 1541           'correctEqn'    =>  $ans,
 1542           'var'       =>  $out_options{'var'},
 1543           'limits'      =>  $out_options{'limits'},
 1544           'tolerance'     =>  $tol,
 1545           'tolType'     =>  $tolType,
 1546           'numPoints'     =>  $out_options{'numPoints'},
 1547           'test_points' =>  $out_options{'test_points'},
 1548           'mode'        =>  $out_options{'mode'},
 1549           'maxConstantOfIntegration'  =>  $out_options{'maxConstantOfIntegration'},
 1550           'zeroLevel'     =>  $out_options{'zeroLevel'},
 1551           'zeroLevelTol'    =>  $out_options{'zeroLevelTol'},
 1552           'params'      =>  $out_options{'params'},
 1553           'debug'       =>  $out_options{'debug'},
 1554       ),
 1555     );
 1556   }
 1557 
 1558   return (wantarray) ? @output_list : $output_list[0];
 1559 }
 1560 
 1561 =head3 Single-variable Function Comparisons
 1562 
 1563 There are four single-variable function answer evaluators: "normal," absolute
 1564 tolerance, antiderivative, and antiderivative with absolute tolerance. All
 1565 parameters (other than the correct equation) are optional.
 1566 
 1567  function_cmp( $correctEqn ) OR
 1568  function_cmp( $correctEqn, $var ) OR
 1569  function_cmp( $correctEqn, $var, $llimit, $ulimit ) OR
 1570  function_cmp( $correctEqn, $var, $llimit, $ulimit, $relPercentTol ) OR
 1571  function_cmp( $correctEqn, $var, $llimit, $ulimit,
 1572         $relPercentTol, $numPoints ) OR
 1573  function_cmp( $correctEqn, $var, $llimit, $ulimit,
 1574         $relPercentTol, $numPoints, $zeroLevel ) OR
 1575  function_cmp( $correctEqn, $var, $llimit, $ulimit, $relPercentTol, $numPoints,
 1576         $zeroLevel,$zeroLevelTol )
 1577 
 1578   $correctEqn   --  the correct equation, as a string
 1579   $var      --  the string representing the variable (optional)
 1580   $llimit     --  the lower limit of the interval to evaluate the
 1581               variable in (optional)
 1582   $ulimit     --  the upper limit of the interval to evaluate the
 1583               variable in (optional)
 1584   $relPercentTol  --  the error tolerance as a percentage (optional)
 1585   $numPoints    --  the number of points at which to evaluate the
 1586               variable (optional)
 1587   $zeroLevel    --  if the correct answer is this close to zero, then
 1588               zeroLevelTol applies (optional)
 1589   $zeroLevelTol --  absolute tolerance to allow when answer is close to zero
 1590 
 1591   function_cmp() uses standard comparison and relative tolerance. It takes a
 1592   string representing a single-variable function and compares the student
 1593   answer to that function numerically.
 1594 
 1595  function_cmp_up_to_constant( $correctEqn ) OR
 1596  function_cmp_up_to_constant( $correctEqn, $var ) OR
 1597  function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit ) OR
 1598  function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
 1599                 $relpercentTol ) OR
 1600  function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
 1601                 $relpercentTol, $numOfPoints ) OR
 1602  function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
 1603                 $relpercentTol, $numOfPoints,
 1604                 $maxConstantOfIntegration ) OR
 1605  function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
 1606                 $relpercentTol, $numOfPoints,
 1607                 $maxConstantOfIntegration, $zeroLevel)  OR
 1608  function_cmp_up_to_constant( $correctEqn, $var, $llimit, $ulimit,
 1609                 $relpercentTol, $numOfPoints,
 1610                 $maxConstantOfIntegration,
 1611                 $zeroLevel, $zeroLevelTol )
 1612 
 1613   $maxConstantOfIntegration --  the maximum size of the constant of
 1614                   integration
 1615 
 1616   function_cmp_up_to_constant() uses antiderivative compare and relative
 1617   tolerance. All options work exactly like function_cmp(), except of course
 1618   $maxConstantOfIntegration. It will accept as correct any function which
 1619   differs from $correctEqn by at most a constant; that is, if
 1620     $studentEqn = $correctEqn + C
 1621   the answer is correct.
 1622 
 1623  function_cmp_abs( $correctFunction ) OR
 1624  function_cmp_abs( $correctFunction, $var ) OR
 1625  function_cmp_abs( $correctFunction, $var, $llimit, $ulimit ) OR
 1626  function_cmp_abs( $correctFunction, $var, $llimit, $ulimit, $absTol ) OR
 1627  function_cmp_abs( $correctFunction, $var, $llimit, $ulimit, $absTol,
 1628           $numOfPoints )
 1629 
 1630   $absTol --  the tolerance as an absolute value
 1631 
 1632   function_cmp_abs() uses standard compare and absolute tolerance. All
 1633   other options work exactly as for function_cmp().
 1634 
 1635  function_cmp_up_to_constant_abs( $correctFunction ) OR
 1636  function_cmp_up_to_constant_abs( $correctFunction, $var ) OR
 1637  function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit ) OR
 1638  function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit,
 1639                   $absTol ) OR
 1640  function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit,
 1641                   $absTol, $numOfPoints ) OR
 1642  function_cmp_up_to_constant_abs( $correctFunction, $var, $llimit, $ulimit,
 1643                   $absTol, $numOfPoints,
 1644                   $maxConstantOfIntegration )
 1645 
 1646   function_cmp_up_to_constant_abs() uses antiderivative compare
 1647   and absolute tolerance. All other options work exactly as with
 1648   function_cmp_up_to_constant().
 1649 
 1650 Examples:
 1651 
 1652   ANS( function_cmp( "cos(x)" ) ) --  Accepts cos(x), sin(x+pi/2),
 1653     sin(x)^2 + cos(x) + cos(x)^2 -1, etc. This assumes
 1654     $functVarDefault has been set to "x".
 1655   ANS( function_cmp( $answer, "t" ) ) --  Assuming $answer is "cos(t)",
 1656     accepts cos(t), etc.
 1657   ANS( function_cmp_up_to_constant( "cos(x)" ) )  --  Accepts any
 1658     antiderivative of sin(x), e.g. cos(x) + 5.
 1659   ANS( function_cmp_up_to_constant( "cos(z)", "z" ) ) --  Accepts any
 1660     antiderivative of sin(z), e.g. sin(z+pi/2) + 5.
 1661 
 1662 =cut
 1663 
 1664 sub adaptive_function_cmp {
 1665   my $correctEqn = shift;
 1666   my %options = @_;
 1667   set_default_options(  \%options,
 1668       'vars'      =>  [qw( x y )],
 1669                   'params'    =>  [],
 1670                   'limits'    =>  [ [0,1], [0,1]],
 1671                   'reltol'    =>  $functRelPercentTolDefault,
 1672                   'numPoints'   =>  $functNumOfPoints,
 1673                   'zeroLevel'   =>  $functZeroLevelDefault,
 1674                   'zeroLevelTol'  =>  $functZeroLevelTolDefault,
 1675                   'debug'     =>  0,
 1676   );
 1677 
 1678     my $var_ref = $options{'vars'};
 1679     my $ra_params = $options{ 'params'};
 1680     my $limit_ref = $options{'limits'};
 1681     my $relPercentTol= $options{'reltol'};
 1682     my $numPoints = $options{'numPoints'};
 1683     my $zeroLevel = $options{'zeroLevel'};
 1684     my $zeroLevelTol = $options{'zeroLevelTol'};
 1685 
 1686   FUNCTION_CMP( 'correctEqn'          =>  $correctEqn,
 1687       'var'           =>  $var_ref,
 1688       'limits'          =>  $limit_ref,
 1689       'tolerance'         =>  $relPercentTol,
 1690       'tolType'         =>  'relative',
 1691       'numPoints'         =>  $numPoints,
 1692       'mode'            =>  'std',
 1693       'maxConstantOfIntegration'      =>  10**100,
 1694       'zeroLevel'         =>  $zeroLevel,
 1695       'zeroLevelTol'          =>  $zeroLevelTol,
 1696       'scale_norm'                      =>    1,
 1697       'params'                          =>    $ra_params,
 1698       'debug'               =>  $options{debug} ,
 1699   );
 1700 }
 1701 
 1702 sub function_cmp {
 1703   my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$zeroLevel,$zeroLevelTol) = @_;
 1704 
 1705   if ( (scalar(@_) == 3) or (scalar(@_) > 8) or (scalar(@_) == 0) ) {
 1706     function_invalid_params( $correctEqn );
 1707   }
 1708   else {
 1709     FUNCTION_CMP( 'correctEqn'          =>  $correctEqn,
 1710         'var'           =>  $var,
 1711         'limits'          =>  [$llimit, $ulimit],
 1712         'tolerance'         =>  $relPercentTol,
 1713         'tolType'         =>  'relative',
 1714         'numPoints'         =>  $numPoints,
 1715         'mode'            =>  'std',
 1716         'maxConstantOfIntegration'      =>  0,
 1717         'zeroLevel'         =>  $zeroLevel,
 1718         'zeroLevelTol'          =>  $zeroLevelTol
 1719           );
 1720   }
 1721 }
 1722 
 1723 sub function_cmp_up_to_constant { ## for antiderivative problems
 1724   my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$maxConstantOfIntegration,$zeroLevel,$zeroLevelTol) = @_;
 1725 
 1726   if ( (scalar(@_) == 3) or (scalar(@_) > 9) or (scalar(@_) == 0) ) {
 1727     function_invalid_params( $correctEqn );
 1728   }
 1729   else {
 1730     FUNCTION_CMP( 'correctEqn'          =>  $correctEqn,
 1731         'var'           =>  $var,
 1732         'limits'          =>  [$llimit, $ulimit],
 1733         'tolerance'         =>  $relPercentTol,
 1734         'tolType'         =>  'relative',
 1735         'numPoints'         =>  $numPoints,
 1736         'mode'            =>  'antider',
 1737         'maxConstantOfIntegration'      =>  $maxConstantOfIntegration,
 1738         'zeroLevel'         =>  $zeroLevel,
 1739         'zeroLevelTol'          =>  $zeroLevelTol
 1740           );
 1741   }
 1742 }
 1743 
 1744 sub function_cmp_abs {      ## similar to function_cmp but uses absolute tolerance
 1745   my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints) = @_;
 1746 
 1747   if ( (scalar(@_) == 3) or (scalar(@_) > 6) or (scalar(@_) == 0) ) {
 1748     function_invalid_params( $correctEqn );
 1749   }
 1750   else {
 1751     FUNCTION_CMP( 'correctEqn'      =>  $correctEqn,
 1752         'var'       =>  $var,
 1753         'limits'      =>  [$llimit, $ulimit],
 1754         'tolerance'     =>  $absTol,
 1755         'tolType'     =>  'absolute',
 1756         'numPoints'     =>  $numPoints,
 1757         'mode'        =>  'std',
 1758         'maxConstantOfIntegration'  =>  0,
 1759         'zeroLevel'     =>  0,
 1760         'zeroLevelTol'      =>  0
 1761     );
 1762   }
 1763 }
 1764 
 1765 
 1766 sub function_cmp_up_to_constant_abs  {  ## for antiderivative problems
 1767                     ## similar to function_cmp_up_to_constant
 1768                     ## but uses absolute tolerance
 1769   my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints,$maxConstantOfIntegration) = @_;
 1770 
 1771   if ( (scalar(@_) == 3) or (scalar(@_) > 7) or (scalar(@_) == 0) ) {
 1772     function_invalid_params( $correctEqn );
 1773   }
 1774 
 1775   else {
 1776     FUNCTION_CMP( 'correctEqn'          =>  $correctEqn,
 1777         'var'           =>  $var,
 1778         'limits'          =>  [$llimit, $ulimit],
 1779         'tolerance'         =>  $absTol,
 1780         'tolType'         =>  'absolute',
 1781         'numPoints'         =>  $numPoints,
 1782         'mode'            =>  'antider',
 1783         'maxConstantOfIntegration'      =>  $maxConstantOfIntegration,
 1784         'zeroLevel'         =>  0,
 1785         'zeroLevelTol'          =>  0
 1786     );
 1787   }
 1788 }
 1789 
 1790 ## The following answer evaluator for comparing multivarable functions was
 1791 ## contributed by Professor William K. Ziemer
 1792 ## (Note: most of the multivariable functionality provided by Professor Ziemer
 1793 ## has now been integrated into fun_cmp and FUNCTION_CMP)
 1794 ############################
 1795 # W.K. Ziemer, Sep. 1999
 1796 # Math Dept. CSULB
 1797 # email: wziemer@csulb.edu
 1798 ############################
 1799 
 1800 =head3 multivar_function_cmp
 1801 
 1802 NOTE: this function is maintained for compatibility. fun_cmp() is
 1803     slightly preferred.
 1804 
 1805 usage:
 1806 
 1807   multivar_function_cmp( $answer, $var_reference, options)
 1808     $answer       --  string, represents function of several variables
 1809     $var_reference    --  number (of variables), or list reference (e.g. ["var1","var2"] )
 1810   options:
 1811     $limit_reference  --  reference to list of lists (e.g. [[1,2],[3,4]])
 1812     $relPercentTol    --  relative percent tolerance in answer
 1813     $numPoints      --  number of points to sample in for each variable
 1814     $zeroLevel      --  if the correct answer is this close to zero, then zeroLevelTol applies
 1815     $zeroLevelTol   --  absolute tolerance to allow when answer is close to zero
 1816 
 1817 =cut
 1818 
 1819 sub multivar_function_cmp {
 1820   my ($correctEqn,$var_ref,$limit_ref,$relPercentTol,$numPoints,$zeroLevel,$zeroLevelTol) = @_;
 1821 
 1822   if ( (scalar(@_) > 7) or (scalar(@_) < 2) ) {
 1823     function_invalid_params( $correctEqn );
 1824   }
 1825 
 1826   FUNCTION_CMP( 'correctEqn'      =>  $correctEqn,
 1827       'var'       =>  $var_ref,
 1828       'limits'      =>  $limit_ref,
 1829       'tolerance'     =>  $relPercentTol,
 1830       'tolType'     =>  'relative',
 1831       'numPoints'     =>  $numPoints,
 1832       'mode'        =>  'std',
 1833       'maxConstantOfIntegration'  =>  0,
 1834       'zeroLevel'     =>  $zeroLevel,
 1835       'zeroLevelTol'      =>  $zeroLevelTol
 1836   );
 1837 }
 1838 
 1839 ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
 1840 ## NOTE: PG_answer_eval is used instead of PG_restricted_eval in order to insure that the answer
 1841 ## evaluated within the context of the package the problem was originally defined in.
 1842 ## Includes multivariable modifications contributed by Professor William K. Ziemer
 1843 ##
 1844 ## IN:  a hash consisting of the following keys (error checking to be added later?)
 1845 ##      correctEqn      --  the correct equation as a string
 1846 ##      var       --  the variable name as a string,
 1847 ##                or a reference to an array of variables
 1848 ##      limits        --  reference to an array of arrays of type [lower,upper]
 1849 ##      tolerance     --  the allowable margin of error
 1850 ##      tolType       --  'relative' or 'absolute'
 1851 ##      numPoints     --  the number of points to evaluate the function at
 1852 ##      mode        --  'std' or 'antider'
 1853 ##      maxConstantOfIntegration  --  maximum size of the constant of integration
 1854 ##      zeroLevel     --  if the correct answer is this close to zero,
 1855 ##                        then zeroLevelTol applies
 1856 ##      zeroLevelTol      --  absolute tolerance to allow when answer is close to zero
 1857 ##      test_points     --  user supplied points to use for testing the
 1858 ##                          function, either array of arrays, or optionally
 1859 ##                          reference to single array (for one variable)
 1860 
 1861 
 1862 sub FUNCTION_CMP {
 1863   return ORIGINAL_FUNCTION_CMP(@_)
 1864     if main::PG_restricted_eval(q!$main::useOldAnswerMacros!);
 1865 
 1866   my %func_params = @_;
 1867 
 1868   my $correctEqn               = $func_params{'correctEqn'};
 1869   my $var                      = $func_params{'var'};
 1870   my $ra_limits                = $func_params{'limits'};
 1871   my $tol                      = $func_params{'tolerance'};
 1872   my $tolType                  = $func_params{'tolType'};
 1873   my $numPoints                = $func_params{'numPoints'};
 1874   my $mode                     = $func_params{'mode'};
 1875   my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'};
 1876   my $zeroLevel                = $func_params{'zeroLevel'};
 1877   my $zeroLevelTol             = $func_params{'zeroLevelTol'};
 1878   my $testPoints               = $func_params{'test_points'};
 1879 
 1880   #
 1881   #  Check that everything is defined:
 1882   #
 1883   $func_params{debug} = 0 unless defined $func_params{debug};
 1884   $mode = 'std' unless defined $mode;
 1885   my @VARS   = get_var_array($var);
 1886   my @limits = get_limits_array($ra_limits);
 1887   my @PARAMS = @{$func_params{'params'} || []};
 1888 
 1889   if($tolType eq 'relative') {
 1890     $tol = $functRelPercentTolDefault unless defined $tol;
 1891     $tol *= .01;
 1892   } else {
 1893     $tol = $functAbsTolDefault unless defined $tol;
 1894   }
 1895 
 1896   #
 1897   #  Ensure that the number of limits matches number of variables
 1898   #
 1899   foreach my $i (0..scalar(@VARS)-1) {
 1900     $limits[$i][0] = $functLLimitDefault unless defined $limits[$i][0];
 1901     $limits[$i][1] = $functULimitDefault unless defined $limits[$i][1];
 1902   }
 1903 
 1904   #
 1905   #  Check that the test points are array references with the right number of coordinates
 1906   #
 1907   if ($testPoints) {
 1908     my $n = scalar(@VARS); my $s = ($n != 1)? "s": "";
 1909     foreach my $p (@{$testPoints}) {
 1910       $p = [$p] unless ref($p) eq 'ARRAY';
 1911       warn "Test point (".join(',',@{$p}).") should have $n coordiante$s"
 1912         unless scalar(@{$p}) == $n;
 1913     }
 1914   }
 1915 
 1916   $numPoints                = $functNumOfPoints              unless defined $numPoints;
 1917   $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration;
 1918   $zeroLevel                = $functZeroLevelDefault         unless defined $zeroLevel;
 1919   $zeroLevelTol             = $functZeroLevelTolDefault      unless defined $zeroLevelTol;
 1920 
 1921   $func_params{'var'}                      = \@VARS;
 1922         $func_params{'params'}                   = \@PARAMS;
 1923   $func_params{'limits'}                   = \@limits;
 1924   $func_params{'tolerance'}                = $tol;
 1925   $func_params{'tolType'}                  = $tolType;
 1926   $func_params{'numPoints'}                = $numPoints;
 1927   $func_params{'mode'}                     = $mode;
 1928   $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration;
 1929   $func_params{'zeroLevel'}                = $zeroLevel;
 1930   $func_params{'zeroLevelTol'}             = $zeroLevelTol;
 1931 
 1932   ########################################################
 1933   #   End of cleanup of calling parameters
 1934   ########################################################
 1935 
 1936         my %options = (debug => $func_params{'debug'});
 1937 
 1938   #
 1939   #  Initialize the context for the formula
 1940   #
 1941   my $context = $Parser::Context::Default::context{"LegacyNumeric"}->copy;
 1942   $context->flags->set(
 1943     tolerance    => $func_params{'tolerance'},
 1944     tolType      => $func_params{'tolType'},
 1945     zeroLevel    => $func_params{'zeroLevel'},
 1946     zeroLevelTol => $func_params{'zeroLevelTol'},
 1947     num_points   => $func_params{'numPoints'},
 1948   );
 1949   if ($func_params{'mode'} eq 'antider') {
 1950     $context->flags->set(max_adapt => $func_params{'maxConstantOfIntegration'});
 1951     $options{upToConstant} = 1;
 1952   }
 1953 
 1954   #
 1955   #  Add the variables and parameters to the context
 1956   #
 1957   my %variables; my $x;
 1958   foreach $x (@{$func_params{'var'}}) {
 1959     if (length($x) > 1) {
 1960       $context->{_variables}->{pattern} = $context->{_variables}->{namePattern} =
 1961         $x . '|' . $context->{_variables}->{pattern};
 1962       $context->update;
 1963     }
 1964     $variables{$x} = 'Real';
 1965   }
 1966   foreach $x (@{$func_params{'params'}}) {$variables{$x} = 'Parameter'}
 1967   $context->variables->are(%variables);
 1968 
 1969   #
 1970   #  Create the Formula object and get its answer checker
 1971   #
 1972   my $oldContext = &$Context($context);
 1973   my $f = new Value::Formula($correctEqn);
 1974   $f->{limits}      = $func_params{'limits'};
 1975   $f->{test_points} = $func_params{'test_points'};
 1976   my $cmp = $f->cmp(%options);
 1977   $cmp->{debug} = 1 if $func_params{'debug'};
 1978   &$Context($oldContext);
 1979 
 1980   #
 1981   #  Get previous answer from hidden field of form
 1982   #
 1983   $cmp->install_pre_filter(
 1984     sub {
 1985       my $rh_ans = shift;
 1986       $rh_ans->{_filter_name} = "fetch_previous_answer";
 1987       my $prev_ans_label = "previous_".$rh_ans->{ans_label};
 1988       $rh_ans->{prev_ans} =
 1989         (defined $inputs_ref->{$prev_ans_label} and
 1990          $inputs_ref->{$prev_ans_label} =~/\S/) ? $inputs_ref->{$prev_ans_label} : undef;
 1991       $rh_ans;
 1992     }
 1993   );
 1994 
 1995   #
 1996   #  Parse the previous answer, if any
 1997   #
 1998   $cmp->install_pre_filter(
 1999     sub {
 2000       my $rh_ans = shift;
 2001       $rh_ans->{_filter_name} = "parse_previous_answer";
 2002       return $rh_ans unless defined $rh_ans->{prev_ans};
 2003       $rh_ans->{prev_formula} = Parser::Formula($rh_ans->{prev_ans});
 2004       $rh_ans;
 2005     }
 2006   );
 2007 
 2008   #
 2009   #  Check if previous answer equals this current one
 2010   #
 2011   $cmp->install_evaluator(
 2012     sub {
 2013       my $rh_ans = shift;
 2014       $rh_ans->{_filter_name} = "compare_to_previous_answer";
 2015       return $rh_ans unless defined($rh_ans->{prev_formula}) && defined($rh_ans->{student_formula});
 2016       $rh_ans->{prev_equals_current} =
 2017         Value::cmp_compare($rh_ans->{student_formula},$rh_ans->{prev_formula},{});
 2018       $rh_ans;
 2019     }
 2020   );
 2021 
 2022   #
 2023   #  Produce a message if the previous answer equals this one
 2024   #  (and is not correct, and is not specified the same way)
 2025   #
 2026   $cmp->install_post_filter(
 2027     sub {
 2028       my $rh_ans = shift;
 2029       $rh_ans->{_filter_name} = "produce_equivalence_message";
 2030       return $rh_ans unless $rh_ans->{prev_equals_current} && $rh_ans->{score} == 0;
 2031       return $rh_ans if $rh_ans->{prev_ans} eq $rh_ans->{original_student_ans};
 2032       $rh_ans->{ans_message} = "This answer is equivalent to the one you just submitted or previewed.";
 2033       $rh_ans;
 2034     }
 2035   );
 2036 
 2037   return $cmp;
 2038 }
 2039 
 2040 #
 2041 #  The original version, for backward compatibility
 2042 #  (can be removed when the Parser-based version is more fully tested.)
 2043 #
 2044 sub ORIGINAL_FUNCTION_CMP {
 2045   my %func_params = @_;
 2046 
 2047   my $correctEqn               = $func_params{'correctEqn'};
 2048   my $var                      = $func_params{'var'};
 2049   my $ra_limits                = $func_params{'limits'};
 2050   my $tol                      = $func_params{'tolerance'};
 2051   my $tolType                  = $func_params{'tolType'};
 2052   my $numPoints                = $func_params{'numPoints'};
 2053   my $mode                     = $func_params{'mode'};
 2054   my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'};
 2055   my $zeroLevel                = $func_params{'zeroLevel'};
 2056   my $zeroLevelTol             = $func_params{'zeroLevelTol'};
 2057   my $ra_test_points           = $func_params{'test_points'};
 2058 
 2059     # Check that everything is defined:
 2060     $func_params{debug} = 0 unless defined $func_params{debug};
 2061     $mode = 'std' unless defined $mode;
 2062     my @VARS = get_var_array($var);
 2063   my @limits = get_limits_array($ra_limits);
 2064   my @PARAMS = ();
 2065   @PARAMS = @{$func_params{'params'}} if defined $func_params{'params'};
 2066 
 2067   my @evaluation_points;
 2068   if(defined $ra_test_points) {
 2069     # see if this is the standard format
 2070     if(ref $ra_test_points->[0] eq 'ARRAY') {
 2071       $numPoints = scalar @{$ra_test_points->[0]};
 2072       # now a little sanity check
 2073       my $j;
 2074       for $j (@{$ra_test_points}) {
 2075         warn "Test points do not give the same number of values for each variable"
 2076           unless(scalar(@{$j}) == $numPoints);
 2077       }
 2078       warn "Test points do not match the number of variables"
 2079         unless scalar @{$ra_test_points} == scalar @VARS;
 2080     } else { # we are got the one-variable format
 2081       $ra_test_points = [$ra_test_points];
 2082       $numPoints = scalar $ra_test_points->[0];
 2083     }
 2084     # The input format for test points is the transpose of what is used
 2085     # internally below, so take care of that now.
 2086     my ($j1, $j2);
 2087     for ($j1 = 0; $j1 < scalar @{$ra_test_points}; $j1++) {
 2088       for ($j2 = 0; $j2 < scalar @{$ra_test_points->[$j1]}; $j2++) {
 2089         $evaluation_points[$j2][$j1] = $ra_test_points->[$j1][$j2];
 2090       }
 2091     }
 2092   } # end of handling of user supplied evaluation points
 2093 
 2094   if ($mode eq 'antider') {
 2095     # doctor the equation to allow addition of a constant
 2096     my $CONSTANT_PARAM = 'Q'; # unfortunately parameters must be single letters.
 2097                               # There is the possibility of conflict here.
 2098                               #  'Q' seemed less dangerous than  'C'.
 2099     $correctEqn = "( $correctEqn ) + $CONSTANT_PARAM";
 2100     push @PARAMS, $CONSTANT_PARAM;
 2101   }
 2102     my $dim_of_param_space = @PARAMS;      # dimension of equivalence space
 2103 
 2104   if($tolType eq 'relative') {
 2105     $tol = $functRelPercentTolDefault unless defined $tol;
 2106     $tol *= .01;
 2107   } else {
 2108     $tol = $functAbsTolDefault unless defined $tol;
 2109   }
 2110 
 2111   #loop ensures that number of limits matches number of variables
 2112   for(my $i = 0; $i < scalar @VARS; $i++) {
 2113     $limits[$i][0] = $functLLimitDefault unless defined $limits[$i][0];
 2114     $limits[$i][1] = $functULimitDefault unless defined $limits[$i][1];
 2115   }
 2116   $numPoints                = $functNumOfPoints              unless defined $numPoints;
 2117   $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration;
 2118   $zeroLevel                = $functZeroLevelDefault         unless defined $zeroLevel;
 2119   $zeroLevelTol             = $functZeroLevelTolDefault      unless defined $zeroLevelTol;
 2120 
 2121   $func_params{'var'}                      = $var;
 2122   $func_params{'limits'}                   = \@limits;
 2123   $func_params{'tolerance'}                = $tol;
 2124   $func_params{'tolType'}                  = $tolType;
 2125   $func_params{'numPoints'}                = $numPoints;
 2126   $func_params{'mode'}                     = $mode;
 2127   $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration;
 2128   $func_params{'zeroLevel'}                = $zeroLevel;
 2129   $func_params{'zeroLevelTol'}             = $zeroLevelTol;
 2130 
 2131   ########################################################
 2132   #   End of cleanup of calling parameters
 2133   ########################################################
 2134 
 2135   my $i; # for use with loops
 2136   my $PGanswerMessage = "";
 2137   my $originalCorrEqn = $correctEqn;
 2138 
 2139   ######################################################################
 2140   # prepare the correct answer and check its syntax
 2141   ######################################################################
 2142 
 2143     my $rh_correct_ans = new AnswerHash;
 2144   $rh_correct_ans->input($correctEqn);
 2145   $rh_correct_ans = check_syntax($rh_correct_ans);
 2146   warn  $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
 2147   $rh_correct_ans->clear_error();
 2148   $rh_correct_ans = function_from_string2($rh_correct_ans,
 2149     ra_vars => [ @VARS, @PARAMS ],
 2150     stdout  => 'rf_correct_ans',
 2151     debug   => $func_params{debug}
 2152   );
 2153   my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans};
 2154   warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
 2155 
 2156   ######################################################################
 2157   # define the points at which the functions are to be evaluated
 2158   ######################################################################
 2159 
 2160   if(not defined $ra_test_points) {
 2161     #create the evaluation points
 2162     my $random_for_answers = new PGrandom($main::PG_original_problemSeed);
 2163     my $NUMBER_OF_STEPS_IN_RANDOM = 1000; # determines the granularity of the random_for_answers number generator
 2164     for(my $count = 0; $count < @PARAMS+1+$numPoints; $count++) {
 2165         my (@vars,$iteration_limit);
 2166       for(my $i = 0; $i < @VARS; $i++) {
 2167         my $iteration_limit = 10;
 2168         while (0 < --$iteration_limit) {  # make sure that the endpoints of the interval are not included
 2169             $vars[$i] = $random_for_answers->random($limits[$i][0], $limits[$i][1], abs($limits[$i][1] - $limits[$i][0])/$NUMBER_OF_STEPS_IN_RANDOM);
 2170             last if $vars[$i]!=$limits[$i][0] and $vars[$i]!=$limits[$i][1];
 2171         }
 2172         warn "Unable to properly choose  evaluation points for this function in the interval ( $limits[$i][0] , $limits[$i][1] )"
 2173           if $iteration_limit == 0;
 2174       }
 2175 
 2176       push @evaluation_points, \@vars;
 2177     }
 2178   }
 2179   my $evaluation_points = Matrix->new_from_array_ref(\@evaluation_points);
 2180 
 2181   #my $COEFFS = determine_param_coeffs($correct_eqn_sub,$evaluation_points[0],$numOfParameters);
 2182   #warn "coeff", join(" | ", @{$COEFFS});
 2183 
 2184   #construct the answer evaluator
 2185     my $answer_evaluator = new AnswerEvaluator;
 2186     $answer_evaluator->{debug} = $func_params{debug};
 2187     $answer_evaluator->ans_hash(
 2188     correct_ans       => $originalCorrEqn,
 2189     rf_correct_ans    => $rh_correct_ans->{rf_correct_ans},
 2190     evaluation_points => \@evaluation_points,
 2191     ra_param_vars     => \@PARAMS,
 2192     ra_vars           => \@VARS,
 2193     type              => 'function',
 2194     score             => 0,
 2195     );
 2196 
 2197     #########################################################
 2198     # Prepare the previous answer for evaluation, discard errors
 2199     #########################################################
 2200 
 2201   $answer_evaluator->install_pre_filter(
 2202     sub {
 2203       my $rh_ans = shift;
 2204       $rh_ans->{_filter_name} = "fetch_previous_answer";
 2205       my $prev_ans_label = "previous_".$rh_ans->{ans_label};
 2206       $rh_ans->{prev_ans} = (defined $inputs_ref->{$prev_ans_label} and $inputs_ref->{$prev_ans_label} =~/\S/)
 2207         ? $inputs_ref->{$prev_ans_label}
 2208         : undef;
 2209       $rh_ans;
 2210     }
 2211   );
 2212 
 2213   $answer_evaluator->install_pre_filter(
 2214     sub {
 2215       my $rh_ans = shift;
 2216       return $rh_ans unless defined $rh_ans->{prev_ans};
 2217       check_syntax($rh_ans,
 2218         stdin          => 'prev_ans',
 2219         stdout         => 'prev_ans',
 2220         error_msg_flag => 0
 2221       );
 2222       $rh_ans->{_filter_name} = "check_syntax_of_previous_answer";
 2223       $rh_ans;
 2224     }
 2225   );
 2226 
 2227   $answer_evaluator->install_pre_filter(
 2228     sub {
 2229       my $rh_ans = shift;
 2230       return $rh_ans unless defined $rh_ans->{prev_ans};
 2231       function_from_string2($rh_ans,
 2232         stdin   => 'prev_ans',
 2233         stdout  => 'rf_prev_ans',
 2234         ra_vars => \@VARS,
 2235         debug   => $func_params{debug}
 2236       );
 2237       $rh_ans->{_filter_name} = "compile_previous_answer";
 2238       $rh_ans;
 2239     }
 2240   );
 2241 
 2242     #########################################################
 2243     # Prepare the current answer for evaluation
 2244     #########################################################
 2245 
 2246   $answer_evaluator->install_pre_filter(\&check_syntax);
 2247   $answer_evaluator->install_pre_filter(\&function_from_string2,
 2248     ra_vars => \@VARS,
 2249     debug   => $func_params{debug}
 2250     ); # @VARS has been guaranteed to be an array, $var might be a single string.
 2251 
 2252     #########################################################
 2253     # Compare the previous and current answer.  Discard errors
 2254     #########################################################
 2255 
 2256   $answer_evaluator->install_evaluator(
 2257     sub {
 2258       my $rh_ans = shift;
 2259       return $rh_ans unless defined $rh_ans->{rf_prev_ans};
 2260       calculate_difference_vector($rh_ans,
 2261         %func_params,
 2262         stdin1         => 'rf_student_ans',
 2263         stdin2         => 'rf_prev_ans',
 2264         stdout         => 'ra_diff_with_prev_ans',
 2265         error_msg_flag => 0,
 2266       );
 2267       $rh_ans->{_filter_name} = "calculate_difference_vector_of_previous_answer";
 2268       $rh_ans;
 2269     }
 2270   );
 2271 
 2272   $answer_evaluator->install_evaluator(
 2273     sub {
 2274       my $rh_ans = shift;
 2275       return $rh_ans unless defined $rh_ans->{ra_diff_with_prev_ans};
 2276       ##
 2277       ## DPVC -- only give the message if the answer is specified differently
 2278       ##
 2279       return $rh_ans if $rh_ans->{prev_ans} eq $rh_ans->{student_ans};
 2280       ##
 2281       ## /DPVC
 2282       ##
 2283       is_zero_array($rh_ans,
 2284         stdin  => 'ra_diff_with_prev_ans',
 2285         stdout => 'ans_equals_prev_ans'
 2286       );
 2287     }
 2288   );
 2289 
 2290     #########################################################
 2291     # Calculate values for approximation parameters and
 2292     # compare the current answer with the correct answer.  Keep errors this time.
 2293     #########################################################
 2294 
 2295     $answer_evaluator->install_pre_filter(\&best_approx_parameters, %func_params, param_vars => \@PARAMS);
 2296     $answer_evaluator->install_evaluator(\&calculate_difference_vector, %func_params);
 2297     $answer_evaluator->install_evaluator(\&is_zero_array, tolerance => $tol );
 2298 
 2299     $answer_evaluator->install_post_filter(
 2300       sub {
 2301         my $rh_ans = shift;
 2302         $rh_ans->clear_error('SYNTAX');
 2303         $rh_ans;
 2304       }
 2305     );
 2306 
 2307   $answer_evaluator->install_post_filter(
 2308     sub {
 2309       my $rh_ans = shift;
 2310       if ($rh_ans->catch_error('EVAL')) {
 2311         $rh_ans->{ans_message} = $rh_ans->{error_message};
 2312         $rh_ans->clear_error('EVAL');
 2313       }
 2314       $rh_ans;
 2315     }
 2316   );
 2317 
 2318   $answer_evaluator->install_post_filter(
 2319     sub {
 2320       my $rh_ans = shift;
 2321       if ( defined($rh_ans->{'ans_equals_prev_ans'}) and $rh_ans->{'ans_equals_prev_ans'} and $rh_ans->{score}==0) {
 2322 ##        $rh_ans->{ans_message} = "This answer is the same as the one you just submitted or previewed.";
 2323         $rh_ans->{ans_message} = "This answer is equivalent to the one you just submitted or previewed."; ## DPVC
 2324       }
 2325       $rh_ans;
 2326     }
 2327   );
 2328 
 2329   $answer_evaluator;
 2330 }
 2331 
 2332 
 2333 ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
 2334 ##
 2335 ## IN:  a hash containing the following items (error-checking to be added later?):
 2336 ##      correctAnswer --  the correct answer
 2337 ##      tolerance   --  the allowable margin of error
 2338 ##      tolType     --  'relative' or 'absolute'
 2339 ##      format      --  the display format of the answer
 2340 ##      mode      --  one of 'std', 'strict', 'arith', or 'frac';
 2341 ##                  determines allowable formats for the input
 2342 ##      zeroLevel   --  if the correct answer is this close to zero, then zeroLevelTol applies
 2343 ##      zeroLevelTol  --  absolute tolerance to allow when answer is close to zero
 2344 
 2345 
 2346 ##########################################################################
 2347 ##########################################################################
 2348 ## String answer evaluators
 2349 
 2350 =head2 String Answer Evaluators
 2351 
 2352 String answer evaluators compare a student string to the correct string.
 2353 Different filters can be applied to allow various degrees of variation.
 2354 Both the student and correct answers are subject to the same filters, to
 2355 ensure that there are no unexpected matches or rejections.
 2356 
 2357 String Filters
 2358 
 2359   remove_whitespace --  Removes all whitespace from the string.
 2360             It applies the following substitution
 2361             to the string:
 2362               $filteredAnswer =~ s/\s+//g;
 2363 
 2364   compress_whitespace --  Removes leading and trailing whitespace, and
 2365             replaces all other blocks of whitespace by a
 2366             single space. Applies the following substitutions:
 2367               $filteredAnswer =~ s/^\s*//;
 2368               $filteredAnswer =~ s/\s*$//;
 2369               $filteredAnswer =~ s/\s+/ /g;
 2370 
 2371   trim_whitespace   --  Removes leading and trailing whitespace.
 2372             Applies the following substitutions:
 2373               $filteredAnswer =~ s/^\s*//;
 2374               $filteredAnswer =~ s/\s*$//;
 2375 
 2376   ignore_case     --  Ignores the case of the string. More accurately,
 2377             it converts the string to uppercase (by convention).
 2378             Applies the following function:
 2379               $filteredAnswer = uc $filteredAnswer;
 2380 
 2381   ignore_order    --  Ignores the order of the letters in the string.
 2382             This is used for problems of the form "Choose all
 2383             that apply." Specifically, it removes all
 2384             whitespace and lexically sorts the letters in
 2385             ascending alphabetical order. Applies the following
 2386             functions:
 2387               $filteredAnswer = join( "", lex_sort(
 2388                 split( /\s*/, $filteredAnswer ) ) );
 2389 
 2390 =cut
 2391 
 2392 ################################
 2393 ## STRING ANSWER FILTERS
 2394 
 2395 ## IN:  --the string to be filtered
 2396 ##    --a list of the filters to use
 2397 ##
 2398 ## OUT: --the modified string
 2399 ##
 2400 ## Use this subroutine instead of the
 2401 ## individual filters below it
 2402 
 2403 sub str_filters {
 2404   my $stringToFilter = shift @_;
 2405   # filters now take an answer hash, so encapsulate the string
 2406   # in the answer hash.
 2407   my $rh_ans = new AnswerHash;
 2408   $rh_ans->{student_ans} = $stringToFilter;
 2409   $rh_ans->{correct_ans}='';
 2410   my @filters_to_use = @_;
 2411   my %known_filters = (
 2412               'remove_whitespace'   =>  \&remove_whitespace,
 2413         'compress_whitespace' =>  \&compress_whitespace,
 2414         'trim_whitespace'   =>  \&trim_whitespace,
 2415         'ignore_case'     =>  \&ignore_case,
 2416         'ignore_order'      =>  \&ignore_order,
 2417   );
 2418 
 2419   #test for unknown filters
 2420   foreach my $filter ( @filters_to_use ) {
 2421     #check that filter is known
 2422     die "Unknown string filter $filter (try checking the parameters to str_cmp() )"
 2423                 unless exists $known_filters{$filter};
 2424     $rh_ans = $known_filters{$filter}($rh_ans);  # apply filter.
 2425   }
 2426 #   foreach $filter (@filters_to_use) {
 2427 #     die "Unknown string filter $filter (try checking the parameters to str_cmp() )"
 2428 #                 unless exists $known_filters{$filter};
 2429 #   }
 2430 #
 2431 #   if( grep( /remove_whitespace/i, @filters_to_use ) ) {
 2432 #     $rh_ans = remove_whitespace( $rh_ans );
 2433 #   }
 2434 #   if( grep( /compress_whitespace/i, @filters_to_use ) ) {
 2435 #     $rh_ans = compress_whitespace( $rh_ans );
 2436 #   }
 2437 #   if( grep( /trim_whitespace/i, @filters_to_use ) ) {
 2438 #     $rh_ans = trim_whitespace( $rh_ans );
 2439 #   }
 2440 #   if( grep( /ignore_case/i, @filters_to_use ) ) {
 2441 #     $rh_ans = ignore_case( $rh_ans );
 2442 #   }
 2443 #   if( grep( /ignore_order/i, @filters_to_use ) ) {
 2444 #     $rh_ans = ignore_order( $rh_ans );
 2445 #   }
 2446 
 2447   return $rh_ans->{student_ans};
 2448 }
 2449 sub remove_whitespace {
 2450   my $rh_ans = shift;
 2451   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
 2452   $rh_ans->{_filter_name} = 'remove_whitespace';
 2453   $rh_ans->{student_ans} =~ s/\s+//g;   # remove all whitespace
 2454   $rh_ans->{correct_ans} =~ s/\s+//g;   # remove all whitespace
 2455   return $rh_ans;
 2456 }
 2457 
 2458 sub compress_whitespace {
 2459   my $rh_ans = shift;
 2460   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
 2461   $rh_ans->{_filter_name} = 'compress_whitespace';
 2462   $rh_ans->{student_ans} =~ s/^\s*//;   # remove initial whitespace
 2463   $rh_ans->{student_ans} =~ s/\s*$//;   # remove trailing whitespace
 2464   $rh_ans->{student_ans} =~ s/\s+/ /g;    # replace spaces by single space
 2465   $rh_ans->{correct_ans} =~ s/^\s*//;   # remove initial whitespace
 2466   $rh_ans->{correct_ans} =~ s/\s*$//;   # remove trailing whitespace
 2467   $rh_ans->{correct_ans} =~ s/\s+/ /g;    # replace spaces by single space
 2468 
 2469   return $rh_ans;
 2470 }
 2471 
 2472 sub trim_whitespace {
 2473   my $rh_ans = shift;
 2474   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
 2475   $rh_ans->{_filter_name} = 'trim_whitespace';
 2476   $rh_ans->{student_ans} =~ s/^\s*//;   # remove initial whitespace
 2477   $rh_ans->{student_ans} =~ s/\s*$//;   # remove trailing whitespace
 2478   $rh_ans->{correct_ans} =~ s/^\s*//;   # remove initial whitespace
 2479   $rh_ans->{correct_ans} =~ s/\s*$//;   # remove trailing whitespace
 2480 
 2481   return $rh_ans;
 2482 }
 2483 
 2484 sub ignore_case {
 2485   my $rh_ans = shift;
 2486   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
 2487   $rh_ans->{_filter_name} = 'ignore_case';
 2488   $rh_ans->{student_ans} =~ tr/a-z/A-Z/;
 2489   $rh_ans->{correct_ans} =~ tr/a-z/A-Z/;
 2490   return $rh_ans;
 2491 }
 2492 
 2493 sub ignore_order {
 2494   my $rh_ans = shift;
 2495   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
 2496   $rh_ans->{_filter_name} = 'ignore_order';
 2497   $rh_ans->{student_ans} = join( "", lex_sort( split( /\s*/, $rh_ans->{student_ans} ) ) );
 2498   $rh_ans->{correct_ans} = join( "", lex_sort( split( /\s*/, $rh_ans->{correct_ans} ) ) );
 2499 
 2500   return $rh_ans;
 2501 }
 2502 # sub remove_whitespace {
 2503 #   my $filteredAnswer = shift;
 2504 #
 2505 #   $filteredAnswer =~ s/\s+//g;    # remove all whitespace
 2506 #
 2507 #   return $filteredAnswer;
 2508 # }
 2509 #
 2510 # sub compress_whitespace {
 2511 #   my $filteredAnswer = shift;
 2512 #
 2513 #   $filteredAnswer =~ s/^\s*//;    # remove initial whitespace
 2514 #   $filteredAnswer =~ s/\s*$//;    # remove trailing whitespace
 2515 #   $filteredAnswer =~ s/\s+/ /g;   # replace spaces by single space
 2516 #
 2517 #   return $filteredAnswer;
 2518 # }
 2519 #
 2520 # sub trim_whitespace {
 2521 #   my $filteredAnswer = shift;
 2522 #
 2523 #   $filteredAnswer =~ s/^\s*//;    # remove initial whitespace
 2524 #   $filteredAnswer =~ s/\s*$//;    # remove trailing whitespace
 2525 #
 2526 #   return $filteredAnswer;
 2527 # }
 2528 #
 2529 # sub ignore_case {
 2530 #   my $filteredAnswer = shift;
 2531 #   #warn "filtered answer is ", $filteredAnswer;
 2532 #   #$filteredAnswer = uc $filteredAnswer;  # this didn't work on webwork xmlrpc, but does elsewhere ????
 2533 #   $filteredAnswer =~ tr/a-z/A-Z/;
 2534 #
 2535 #   return $filteredAnswer;
 2536 # }
 2537 #
 2538 # sub ignore_order {
 2539 #   my $filteredAnswer = shift;
 2540 #
 2541 #   $filteredAnswer = join( "", lex_sort( split( /\s*/, $filteredAnswer ) ) );
 2542 #
 2543 #   return $filteredAnswer;
 2544 # }
 2545 ################################
 2546 ## END STRING ANSWER FILTERS
 2547 
 2548 
 2549 =head3 str_cmp()
 2550 
 2551 Compares a string or a list of strings, using a named hash of options to set
 2552 parameters. This can make for more readable code than using the "mode"_str_cmp()
 2553 style, but some people find one or the other easier to remember.
 2554 
 2555 ANS( str_cmp( answer or answer_array_ref, options_hash ) );
 2556 
 2557   1. the correct answer or a reference to an array of answers
 2558   2. either a list of filters, or:
 2559      a hash consisting of
 2560     filters - a reference to an array of filters
 2561 
 2562   Returns an answer evaluator, or (if given a reference to an array of answers),
 2563   a list of answer evaluators
 2564 
 2565 FILTERS:
 2566 
 2567   remove_whitespace --  removes all whitespace
 2568   compress_whitespace --  removes whitespace from the beginning and end of the string,
 2569               and treats one or more whitespace characters in a row as a
 2570               single space (true by default)
 2571   trim_whitespace   --  removes whitespace from the beginning and end of the string
 2572   ignore_case   --  ignores the case of the letters (true by default)
 2573   ignore_order    --  ignores the order in which letters are entered
 2574 
 2575 EXAMPLES:
 2576 
 2577   str_cmp( "Hello" )  --  matches "Hello", "  hello" (same as std_str_cmp() )
 2578   str_cmp( ["Hello", "Goodbye"] ) --  same as std_str_cmp_list()
 2579   str_cmp( " hello ", trim_whitespace ) --  matches "hello", " hello  "
 2580   str_cmp( "ABC", filters => 'ignore_order' ) --  matches "ACB", "A B C", but not "abc"
 2581   str_cmp( "D E F", remove_whitespace, ignore_case )  --  matches "def" and "d e f" but not "fed"
 2582 
 2583 
 2584 =cut
 2585 
 2586 sub str_cmp {
 2587   my $correctAnswer = shift @_;
 2588   $correctAnswer = '' unless defined($correctAnswer);
 2589   my @options = @_;
 2590   my %options = ();
 2591   # backward compatibility
 2592   if (grep /filters|debug|filter/, @options) { # see whether we have hash keys in the input.
 2593     %options = @options;
 2594   } elsif (@options) {     # all options are names of filters.
 2595     $options{filters} = [@options];
 2596   }
 2597   my $ra_filters;
 2598   assign_option_aliases( \%options,
 2599         'filter'               =>  'filters',
 2600      );
 2601     set_default_options(  \%options,
 2602           'filters'               =>  [qw(trim_whitespace compress_whitespace ignore_case)],
 2603             'debug'         =>  0,
 2604             'type'                  =>  'str_cmp',
 2605     );
 2606   $options{filters} = (ref($options{filters}))?$options{filters}:[$options{filters}];
 2607   # make sure this is a reference to an array.
 2608   # error-checking for filters occurs in the filters() subroutine
 2609 #   if( not defined( $options[0] ) ) {    # used with no filters as alias for std_str_cmp()
 2610 #     @options = ( 'compress_whitespace', 'ignore_case' );
 2611 #   }
 2612 #
 2613 #   if( $options[0] eq 'filters' ) {    # using filters => [f1, f2, ...] notation
 2614 #     $ra_filters = $options[1];
 2615 #   }
 2616 #   else {            # using a list of filters
 2617 #     $ra_filters = \@options;
 2618 #   }
 2619 
 2620   # thread over lists
 2621   my @ans_list = ();
 2622 
 2623   if ( ref($correctAnswer) eq 'ARRAY' ) {
 2624     @ans_list = @{$correctAnswer};
 2625   }
 2626   else {
 2627     push( @ans_list, $correctAnswer );
 2628   }
 2629 
 2630   # final_answer;
 2631   my @output_list = ();
 2632 
 2633   foreach my $ans (@ans_list) {
 2634     push(@output_list, STR_CMP(
 2635                   'correct_ans' =>  $ans,
 2636             'filters'   =>  $options{filters},
 2637             'type'      =>  $options{type},
 2638             'debug'         =>  $options{debug},
 2639          )
 2640     );
 2641   }
 2642 
 2643   return (wantarray) ? @output_list : $output_list[0] ;
 2644 }
 2645 
 2646 =head3 "mode"_str_cmp functions
 2647 
 2648 The functions of the the form "mode"_str_cmp() use different functions to
 2649 specify which filters to apply. They take no options except the correct
 2650 string. There are also versions which accept a list of strings.
 2651 
 2652  std_str_cmp( $correctString )
 2653  std_str_cmp_list( @correctStringList )
 2654   Filters: compress_whitespace, ignore_case
 2655 
 2656  std_cs_str_cmp( $correctString )
 2657  std_cs_str_cmp_list( @correctStringList )
 2658   Filters: compress_whitespace
 2659 
 2660  strict_str_cmp( $correctString )
 2661  strict_str_cmp_list( @correctStringList )
 2662   Filters: trim_whitespace
 2663 
 2664  unordered_str_cmp( $correctString )
 2665  unordered_str_cmp_list( @correctStringList )
 2666   Filters: ignore_order, ignore_case
 2667 
 2668  unordered_cs_str_cmp( $correctString )
 2669  unordered_cs_str_cmp_list( @correctStringList )
 2670   Filters: ignore_order
 2671 
 2672  ordered_str_cmp( $correctString )
 2673  ordered_str_cmp_list( @correctStringList )
 2674   Filters: remove_whitespace, ignore_case
 2675 
 2676  ordered_cs_str_cmp( $correctString )
 2677  ordered_cs_str_cmp_list( @correctStringList )
 2678   Filters: remove_whitespace
 2679 
 2680 Examples
 2681 
 2682   ANS( std_str_cmp( "W. Mozart" ) ) --  Accepts "W. Mozart", "W. MOZarT",
 2683     and so forth. Case insensitive. All internal spaces treated
 2684     as single spaces.
 2685   ANS( std_cs_str_cmp( "Mozart" ) ) --  Rejects "mozart". Same as
 2686     std_str_cmp() but case sensitive.
 2687   ANS( strict_str_cmp( "W. Mozart" ) )  --  Accepts only the exact string.
 2688   ANS( unordered_str_cmp( "ABC" ) ) --  Accepts "a c B", "CBA" and so forth.
 2689     Unordered, case insensitive, spaces ignored.
 2690   ANS( unordered_cs_str_cmp( "ABC" ) )  --  Rejects "abc". Same as
 2691     unordered_str_cmp() but case sensitive.
 2692   ANS( ordered_str_cmp( "ABC" ) ) --  Accepts "a b C", "A B C" and so forth.
 2693     Ordered, case insensitive, spaces ignored.
 2694   ANS( ordered_cs_str_cmp( "ABC" ) )  --  Rejects "abc", accepts "A BC" and
 2695     so forth. Same as ordered_str_cmp() but case sensitive.
 2696 
 2697 =cut
 2698 
 2699 sub std_str_cmp {         # compare strings
 2700   my $correctAnswer = shift @_;
 2701   my @filters = ( 'compress_whitespace', 'ignore_case' );
 2702   my $type = 'std_str_cmp';
 2703   STR_CMP('correct_ans' =>  $correctAnswer,
 2704       'filters' =>  \@filters,
 2705       'type'    =>  $type
 2706   );
 2707 }
 2708 
 2709 sub std_str_cmp_list {        # alias for std_str_cmp
 2710   my @answerList = @_;
 2711   my @output;
 2712   while (@answerList) {
 2713     push( @output, std_str_cmp(shift @answerList) );
 2714   }
 2715   @output;
 2716 }
 2717 
 2718 sub std_cs_str_cmp {        # compare strings case sensitive
 2719   my $correctAnswer = shift @_;
 2720   my @filters = ( 'compress_whitespace' );
 2721   my $type = 'std_cs_str_cmp';
 2722   STR_CMP(  'correct_ans' =>  $correctAnswer,
 2723       'filters' =>  \@filters,
 2724       'type'    =>  $type
 2725   );
 2726 }
 2727 
 2728 sub std_cs_str_cmp_list {     # alias for std_cs_str_cmp
 2729   my @answerList = @_;
 2730   my @output;
 2731   while (@answerList) {
 2732     push( @output, std_cs_str_cmp(shift @answerList) );
 2733   }
 2734   @output;
 2735 }
 2736 
 2737 sub strict_str_cmp {        # strict string compare
 2738   my $correctAnswer = shift @_;
 2739   my @filters = ( 'trim_whitespace' );
 2740   my $type = 'strict_str_cmp';
 2741   STR_CMP(  'correct_ans' =>  $correctAnswer,
 2742       'filters' =>  \@filters,
 2743       'type'    =>  $type
 2744   );
 2745 }
 2746 
 2747 sub strict_str_cmp_list {     # alias for strict_str_cmp
 2748   my @answerList = @_;
 2749   my @output;
 2750   while (@answerList) {
 2751     push( @output, strict_str_cmp(shift @answerList) );
 2752   }
 2753   @output;
 2754 }
 2755 
 2756 sub unordered_str_cmp {       # unordered, case insensitive, spaces ignored
 2757   my $correctAnswer = shift @_;
 2758   my @filters = ( 'ignore_order', 'ignore_case' );
 2759   my $type = 'unordered_str_cmp';
 2760   STR_CMP(  'correct_ans'   =>  $correctAnswer,
 2761       'filters'   =>  \@filters,
 2762       'type'      =>  $type
 2763   );
 2764 }
 2765 
 2766 sub unordered_str_cmp_list {    # alias for unordered_str_cmp
 2767   my @answerList = @_;
 2768   my @output;
 2769   while (@answerList) {
 2770     push( @output, unordered_str_cmp(shift @answerList) );
 2771   }
 2772   @output;
 2773 }
 2774 
 2775 sub unordered_cs_str_cmp {      # unordered, case sensitive, spaces ignored
 2776   my $correctAnswer = shift @_;
 2777   my @filters = ( 'ignore_order' );
 2778   my $type = 'unordered_cs_str_cmp';
 2779   STR_CMP(  'correct_ans'   =>  $correctAnswer,
 2780       'filters'   =>  \@filters,
 2781       'type'      =>  $type
 2782   );
 2783 }
 2784 
 2785 sub unordered_cs_str_cmp_list {   # alias for unordered_cs_str_cmp
 2786   my @answerList = @_;
 2787   my @output;
 2788   while (@answerList) {
 2789     push( @output, unordered_cs_str_cmp(shift @answerList) );
 2790   }
 2791   @output;
 2792 }
 2793 
 2794 sub ordered_str_cmp {       # ordered, case insensitive, spaces ignored
 2795   my $correctAnswer = shift @_;
 2796   my @filters = ( 'remove_whitespace', 'ignore_case' );
 2797   my $type = 'ordered_str_cmp';
 2798   STR_CMP(  'correct_ans' =>  $correctAnswer,
 2799       'filters' =>  \@filters,
 2800       'type'    =>  $type
 2801   );
 2802 }
 2803 
 2804 sub ordered_str_cmp_list {      # alias for ordered_str_cmp
 2805   my @answerList = @_;
 2806   my @output;
 2807   while (@answerList) {
 2808     push( @output, ordered_str_cmp(shift @answerList) );
 2809   }
 2810   @output;
 2811 }
 2812 
 2813 sub ordered_cs_str_cmp {      # ordered,  case sensitive, spaces ignored
 2814   my $correctAnswer = shift @_;
 2815   my @filters = ( 'remove_whitespace' );
 2816   my $type = 'ordered_cs_str_cmp';
 2817   STR_CMP(  'correct_ans' =>  $correctAnswer,
 2818       'filters' =>  \@filters,
 2819       'type'    =>  $type
 2820   );
 2821 }
 2822 
 2823 sub ordered_cs_str_cmp_list {   # alias for ordered_cs_str_cmp
 2824   my @answerList = @_;
 2825   my @output;
 2826   while (@answerList) {
 2827     push( @output, ordered_cs_str_cmp(shift @answerList) );
 2828   }
 2829   @output;
 2830 }
 2831 
 2832 
 2833 ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
 2834 ##
 2835 ## IN:  a hashtable with the following entries (error-checking to be added later?):
 2836 ##      correctAnswer --  the correct answer, before filtering
 2837 ##      filters     --  reference to an array containing the filters to be applied
 2838 ##      type      --  a string containing the type of answer evaluator in use
 2839 ## OUT: a reference to an answer evaluator subroutine
 2840 sub STR_CMP {
 2841   my %str_params = @_;
 2842   #my $correctAnswer =  str_filters( $str_params{'correct_ans'}, @{$str_params{'filters'}} );
 2843   my $answer_evaluator = new AnswerEvaluator;
 2844   $answer_evaluator->{debug} = $str_params{debug};
 2845   $answer_evaluator->ans_hash(
 2846     correct_ans       => $str_params{correct_ans}||'',
 2847     type              => $str_params{type}||'str_cmp',
 2848     score             => 0,
 2849 
 2850     );
 2851   my %known_filters = (
 2852               'remove_whitespace'   =>  \&remove_whitespace,
 2853         'compress_whitespace' =>  \&compress_whitespace,
 2854         'trim_whitespace'   =>  \&trim_whitespace,
 2855         'ignore_case'     =>  \&ignore_case,
 2856         'ignore_order'      =>  \&ignore_order,
 2857   );
 2858 
 2859   foreach my $filter ( @{$str_params{filters}} ) {
 2860     #check that filter is known
 2861     die "Unknown string filter |$filter|. Known filters are ".
 2862          join(" ", keys %known_filters) .
 2863          "(try checking the parameters to str_cmp() )"
 2864                 unless exists $known_filters{$filter};
 2865     # install related pre_filter
 2866     $answer_evaluator->install_pre_filter( $known_filters{$filter} );
 2867   }
 2868   $answer_evaluator->install_evaluator(sub {
 2869       my $rh_ans = shift;
 2870       $rh_ans->{_filter_name} = "Evaluator: Compare string answers with eq";
 2871       $rh_ans->{score} = ($rh_ans->{student_ans} eq $rh_ans->{correct_ans})?1:0  ;
 2872       $rh_ans;
 2873   });
 2874   $answer_evaluator->install_post_filter(sub {
 2875     my $rh_hash = shift;
 2876     $rh_hash->{_filter_name} = "clean up preview strings";
 2877     $rh_hash->{'preview_text_string'} = $rh_hash->{student_ans};
 2878     $rh_hash->{'preview_latex_string'} = "\\text{ ".$rh_hash->{student_ans}." }";
 2879     $rh_hash;
 2880   });
 2881   return $answer_evaluator;
 2882 }
 2883 
 2884 # sub STR_CMP_old {
 2885 #   my %str_params = @_;
 2886 #   $str_params{'correct_ans'} = str_filters( $str_params{'correct_ans'}, @{$str_params{'filters'}} );
 2887 #   my $answer_evaluator = sub {
 2888 #     my $in = shift @_;
 2889 #     $in = '' unless defined $in;
 2890 #     my $original_student_ans = $in;
 2891 #     $in = str_filters( $in, @{$str_params{'filters'}} );
 2892 #     my $correctQ = ( $in eq $str_params{'correct_ans'} ) ? 1: 0;
 2893 #     my $ans_hash = new AnswerHash(    'score'       =>  $correctQ,
 2894 #               'correct_ans'     =>  $str_params{'correctAnswer'},
 2895 #               'student_ans'     =>  $in,
 2896 #               'ans_message'     =>  '',
 2897 #               'type'        =>  $str_params{'type'},
 2898 #               'preview_text_string'   =>  $in,
 2899 #               'preview_latex_string'    =>  $in,
 2900 #               'original_student_ans'    =>  $original_student_ans
 2901 #     );
 2902 #     return $ans_hash;
 2903 #   };
 2904 #   return $answer_evaluator;
 2905 # }
 2906 
 2907 ##########################################################################
 2908 ##########################################################################
 2909 ## Miscellaneous answer evaluators
 2910 
 2911 =head2 Miscellaneous Answer Evaluators (Checkboxes and Radio Buttons)
 2912 
 2913 These evaluators do not fit any of the other categories.
 2914 
 2915 checkbox_cmp( $correctAnswer )
 2916 
 2917   $correctAnswer  --  a string containing the names of the correct boxes,
 2918             e.g. "ACD". Note that this means that individual
 2919             checkbox names can only be one character. Internally,
 2920             this is largely the same as unordered_cs_str_cmp().
 2921 
 2922 radio_cmp( $correctAnswer )
 2923 
 2924   $correctAnswer  --  a string containing the name of the correct radio
 2925             button, e.g. "Choice1". This is case sensitive and
 2926             whitespace sensitive, so the correct answer must match
 2927             the name of the radio button exactly.
 2928 
 2929 =cut
 2930 
 2931 # added 6/14/2000 by David Etlinger
 2932 # because of the conversion of the answer
 2933 # string to an array, I thought it better not
 2934 # to force STR_CMP() to work with this
 2935 
 2936 #added 2/26/2003 by Mike Gage
 2937 # handled the case where multiple answers are passed as an array reference
 2938 # rather than as a \0 delimited string.
 2939 sub checkbox_cmp {
 2940   my  $correctAnswer = shift @_;
 2941   my %options = @_;
 2942   assign_option_aliases( \%options,
 2943      );
 2944     set_default_options(  \%options,
 2945           'debug'         =>  0,
 2946             'type'                  =>  'checkbox_cmp',
 2947     );
 2948   my $answer_evaluator = new AnswerEvaluator(
 2949     correct_ans      => $correctAnswer,
 2950     type             => $options{type},
 2951   );
 2952   # pass along debug requests
 2953   $answer_evaluator->{debug} = $options{debug};
 2954 
 2955   # join student answer array into a single string if necessary
 2956   $answer_evaluator->install_pre_filter(sub {
 2957     my $rh_ans = shift;
 2958     $rh_ans->{_filter_name} = 'convert student_ans to string';
 2959     $rh_ans->{student_ans} = join("", @{$rh_ans->{student_ans}})
 2960              if ref($rh_ans->{student_ans}) =~/ARRAY/i;
 2961     $rh_ans;
 2962   });
 2963   # ignore order of check boxes
 2964   $answer_evaluator->install_pre_filter(\&ignore_order);
 2965   # compare as strings
 2966   $answer_evaluator->install_evaluator(sub {
 2967     my $rh_ans     = shift;
 2968     $rh_ans->{_filter_name} = 'compare strings generated by checked boxes';
 2969     $rh_ans->{score} = ($rh_ans->{student_ans} eq $rh_ans->{correct_ans}) ? 1 : 0;
 2970     $rh_ans;
 2971   });
 2972   # fix up preview displays
 2973   $answer_evaluator->install_post_filter( sub {
 2974     my $rh_ans      = shift;
 2975     $rh_ans->{_filter_name} = 'adjust preview strings';
 2976     $rh_ans->{type} = $options{type};
 2977     $rh_ans->{preview_text_string}  = '\\text{'.$rh_ans->{student_ans}.'}',
 2978     $rh_ans->{preview_latex_string} = '\\text{'.$rh_ans->{student_ans}.'}',
 2979     $rh_ans;
 2980 
 2981 
 2982   });
 2983 
 2984 #   my  $answer_evaluator = sub {
 2985 #     my $in = shift @_;
 2986 #     $in = '' unless defined $in;      #in case no boxes checked
 2987 #                         # multiple answers could come in two forms
 2988 #                         # either a \0 delimited string or
 2989 #                         # an array reference.  We handle both.
 2990 #         if (ref($in) eq 'ARRAY')   {
 2991 #           $in = join("",@{$in});              # convert array to single no-delimiter string
 2992 #         } else {
 2993 #       my @temp = split( "\0", $in );    #convert "\0"-delimited string to array...
 2994 #       $in = join( "", @temp );      #and then to a single no-delimiter string
 2995 #     }
 2996 #     my $original_student_ans = $in;     #well, almost original
 2997 #     $in = str_filters( $in, 'ignore_order' );
 2998 #
 2999 #     my $correctQ = ($in eq $correctAnswer) ? 1: 0;
 3000 #
 3001 #     my $ans_hash = new AnswerHash(
 3002 #       'score'             =>  $correctQ,
 3003 #       'correct_ans'       =>  "$correctAnswer",
 3004 #       'student_ans'       =>  $in,
 3005 #       'ans_message'       =>  "",
 3006 #       'type'              =>  "checkbox_cmp",
 3007 #       'preview_text_string' =>  $in,
 3008 #       'preview_latex_string'  =>  $in,
 3009 #       'original_student_ans'  =>  $original_student_ans
 3010 #     );
 3011 #     return $ans_hash;
 3012 #
 3013 #   };
 3014   return $answer_evaluator;
 3015 }
 3016 # sub checkbox_cmp {
 3017 #   my  $correctAnswer = shift @_;
 3018 #   $correctAnswer = str_filters( $correctAnswer, 'ignore_order' );
 3019 #
 3020 #   my  $answer_evaluator = sub {
 3021 #     my $in = shift @_;
 3022 #     $in = '' unless defined $in;      #in case no boxes checked
 3023 #                         # multiple answers could come in two forms
 3024 #                         # either a \0 delimited string or
 3025 #                         # an array reference.  We handle both.
 3026 #         if (ref($in) eq 'ARRAY')   {
 3027 #           $in = join("",@{$in});              # convert array to single no-delimiter string
 3028 #         } else {
 3029 #       my @temp = split( "\0", $in );    #convert "\0"-delimited string to array...
 3030 #       $in = join( "", @temp );      #and then to a single no-delimiter string
 3031 #     }
 3032 #     my $original_student_ans = $in;     #well, almost original
 3033 #     $in = str_filters( $in, 'ignore_order' );
 3034 #
 3035 #     my $correctQ = ($in eq $correctAnswer) ? 1: 0;
 3036 #
 3037 #     my $ans_hash = new AnswerHash(
 3038 #       'score'             =>  $correctQ,
 3039 #       'correct_ans'       =>  "$correctAnswer",
 3040 #       'student_ans'       =>  $in,
 3041 #       'ans_message'       =>  "",
 3042 #       'type'              =>  "checkbox_cmp",
 3043 #       'preview_text_string' =>  $in,
 3044 #       'preview_latex_string'  =>  $in,
 3045 #       'original_student_ans'  =>  $original_student_ans
 3046 #     );
 3047 #     return $ans_hash;
 3048 #
 3049 #   };
 3050 #   return $answer_evaluator;
 3051 # }
 3052 
 3053 #added 6/28/2000 by David Etlinger
 3054 #exactly the same as strict_str_cmp,
 3055 #but more intuitive to the user
 3056 
 3057 # check that answer is really a string and not an array
 3058 # also use ordinary string compare
 3059 sub radio_cmp {
 3060   #strict_str_cmp( @_ );
 3061   my $response = shift;  # there should be only one item.
 3062   warn "Multiple choices -- this should not happen with radio buttons. Have
 3063   you used checkboxes perhaps?" if ref($response); #triggered if an ARRAY is passed
 3064   str_cmp($response);
 3065 }
 3066 
 3067 ##########################################################################
 3068 ##########################################################################
 3069 ## Text and e-mail routines
 3070 
 3071 sub store_ans_at {
 3072   my $answerStringRef = shift;
 3073   my %options = @_;
 3074   my $ans_eval= '';
 3075   if ( ref($answerStringRef) eq 'SCALAR' ) {
 3076     $ans_eval= sub {
 3077       my $text = shift;
 3078       $text = '' unless defined($text);
 3079       $$answerStringRef = $$answerStringRef  . $text;
 3080       my $ans_hash = new AnswerHash(
 3081                'score'      =>  1,
 3082                'correct_ans'      =>  '',
 3083                'student_ans'      =>  $text,
 3084                'ans_message'      =>  '',
 3085                'type'       =>  'store_ans_at',
 3086                'original_student_ans'   =>  $text,
 3087                'preview_text_string'    =>  ''
 3088       );
 3089 
 3090     return $ans_hash;
 3091     };
 3092   }
 3093   else {
 3094     die "Syntax error: \n The argument to store_ans_at() must be a pointer to a scalar.\n(e.g.  store_ans_at(~~\$MSG) )\n\n";
 3095   }
 3096 
 3097   return $ans_eval;
 3098 }
 3099 
 3100 #### subroutines used in producing a questionnaire
 3101 #### these are at least good models for other answers of this type
 3102 
 3103 # my $QUESTIONNAIRE_ANSWERS=''; #  stores the answers until it is time to send them
 3104        #  this must be initialized before the answer evaluators are run
 3105        #  but that happens long after all of the text in the problem is
 3106        #  evaluated.
 3107 # this is a utility script for cleaning up the answer output for display in
 3108 #the answers.
 3109 
 3110 sub DUMMY_ANSWER {
 3111   my $num = shift;
 3112   qq{<INPUT TYPE="HIDDEN" NAME="answer$num" VALUE="">}
 3113 }
 3114 
 3115 sub escapeHTML {
 3116   my $string = shift;
 3117   $string =~ s/\n/$BR/ge;
 3118   $string;
 3119 }
 3120 
 3121 # these next three subroutines show how to modify the "store_ans_at()" answer
 3122 # evaluator to add extra information before storing the info
 3123 # They provide a good model for how to tweak answer evaluators in special cases.
 3124 
 3125 sub anstext {
 3126   my $num = shift;
 3127   my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
 3128   my $psvnNumber  = PG_restricted_eval(q!$main::psvnNumber!);
 3129   my $probNum     = PG_restricted_eval(q!$main::probNum!);
 3130   my $ans_eval    = sub {
 3131          my $text = shift;
 3132          $text = '' unless defined($text);
 3133          my $new_text = "\n$psvnNumber-Problem-$probNum-Question-$num:\n $text "; # modify entered text
 3134          my $out = &$ans_eval_template($new_text);       # standard evaluator
 3135          #warn "$QUESTIONNAIRE_ANSWERS";
 3136          $out->{student_ans} = escapeHTML($text);  #  restore original entered text
 3137          $out->{correct_ans} = "Question  $num answered";
 3138          $out->{original_student_ans} = escapeHTML($text);
 3139          $out;
 3140     };
 3141    $ans_eval;
 3142 }
 3143 
 3144 
 3145 sub ansradio {
 3146   my $num = shift;
 3147   my $psvnNumber  = PG_restricted_eval(q!$main::psvnNumber!);
 3148   my $probNum  = PG_restricted_eval(q!$main::probNum!);
 3149 
 3150   my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
 3151   my $ans_eval = sub {
 3152          my $text = shift;
 3153          $text = '' unless defined($text);
 3154          my $new_text = "\n$psvnNumber-Problem-$probNum-RADIO-$num:\n $text ";       # modify entered text
 3155          my $out = $ans_eval_template->($new_text);       # standard evaluator
 3156          $out->{student_ans} =escapeHTML($text);  # restore original entered text
 3157          $out->{original_student_ans} = escapeHTML($text);
 3158          $out;
 3159    };
 3160 
 3161    $ans_eval;
 3162 }
 3163 
 3164 sub anstext_non_anonymous {
 3165   ## this emails identifying information
 3166   my $num          = shift;
 3167     my $psvnNumber   = PG_restricted_eval(q!$main::psvnNumber!);
 3168   my $probNum      = PG_restricted_eval(q!$main::probNum!);
 3169     my $studentLogin = PG_restricted_eval(q!$main::studentLogin!);
 3170   my $studentID    = PG_restricted_eval(q!$main::studentID!);
 3171     my $studentName  = PG_restricted_eval(q!$main::studentName!);
 3172 
 3173 
 3174   my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
 3175   my $ans_eval = sub {
 3176          my $text = shift;
 3177          $text = '' unless defined($text);
 3178          my $new_text = "\n$psvnNumber-Problem-$probNum-Question-$num:\n$studentLogin $main::studentID $studentName\n$text "; # modify entered text
 3179          my $out = &$ans_eval_template($new_text);       # standard evaluator
 3180          #warn "$QUESTIONNAIRE_ANSWERS";
 3181          $out->{student_ans} = escapeHTML($text);  #  restore original entered text
 3182          $out->{correct_ans} = "Question  $num answered";
 3183          $out->{original_student_ans} = escapeHTML($text);
 3184          $out;
 3185     };
 3186    $ans_eval;
 3187 }
 3188 
 3189 
 3190 #  This is another example of how to modify an  answer evaluator to obtain
 3191 #  the desired behavior in a special case.  Here the object is to have
 3192 #  have the last answer trigger the send_mail_to subroutine which mails
 3193 #  all of the answers to the designated address.
 3194 #  (This address must be listed in PG_environment{'ALLOW_MAIL_TO'} or an error occurs.)
 3195 
 3196 # Fix me?? why is the body hard wired to the string QUESTIONNAIRE_ANSWERS?
 3197 
 3198 sub mail_answers_to {  #accepts the last answer and mails off the result
 3199   my $user_address = shift;
 3200   my $ans_eval = sub {
 3201 
 3202     # then mail out all of the answers, including this last one.
 3203 
 3204     send_mail_to( $user_address,
 3205           'subject'       =>  "$main::courseName WeBWorK questionnaire",
 3206           'body'          =>  $QUESTIONNAIRE_ANSWERS,
 3207           'ALLOW_MAIL_TO'   =>  $rh_envir->{ALLOW_MAIL_TO}
 3208     );
 3209 
 3210     my $ans_hash = new AnswerHash(  'score'   =>  1,
 3211             'correct_ans' =>  '',
 3212             'student_ans' =>  'Answer recorded',
 3213             'ans_message' =>  '',
 3214             'type'    =>  'send_mail_to',
 3215     );
 3216 
 3217     return $ans_hash;
 3218   };
 3219 
 3220   return $ans_eval;
 3221 }
 3222 
 3223 sub save_answer_to_file {  #accepts the last answer and mails off the result
 3224   my $fileID = shift;
 3225   my $ans_eval = new AnswerEvaluator;
 3226   $ans_eval->install_evaluator(
 3227       sub {
 3228          my $rh_ans = shift;
 3229 
 3230              unless ( defined( $rh_ans->{student_ans} ) ) {
 3231               $rh_ans->throw_error("save_answers_to_file","{student_ans} field not defined");
 3232               return $rh_ans;
 3233             }
 3234 
 3235         my $error;
 3236         my $string = '';
 3237         $string = qq![[<$main::studentLogin> $main::studentName /!. time() . qq!/]]\n!.
 3238           $rh_ans->{student_ans}. qq!\n\n============================\n\n!;
 3239 
 3240         if ($error = AnswerIO::saveAnswerToFile('preflight',$string) ) {
 3241           $rh_ans->throw_error("save_answers_to_file","Error:  $error");
 3242         } else {
 3243           $rh_ans->{'student_ans'} = 'Answer saved';
 3244           $rh_ans->{'score'} = 1;
 3245         }
 3246         $rh_ans;
 3247       }
 3248   );
 3249 
 3250   return $ans_eval;
 3251 }
 3252 
 3253 sub mail_answers_to2 {  #accepts the last answer and mails off the result
 3254   my $user_address         = shift;
 3255   my $subject              = shift;
 3256   my $ra_allow_mail_to     = shift;
 3257   $subject = "$main::courseName WeBWorK questionnaire" unless defined $subject;
 3258   send_mail_to($user_address,
 3259       'subject'     => $subject,
 3260       'body'        => $QUESTIONNAIRE_ANSWERS,
 3261       'ALLOW_MAIL_TO'   => $rh_envir->{ALLOW_MAIL_TO},
 3262   );
 3263 }
 3264 
 3265 ##########################################################################
 3266 ##########################################################################
 3267 
 3268 
 3269 ###########################################################################
 3270 ### THE FOLLOWING ARE LOCAL SUBROUTINES THAT ARE MEANT TO BE CALLED ONLY FROM THIS SCRIPT.
 3271 
 3272 ## Internal routine that converts variables into the standard array format
 3273 ##
 3274 ## IN:  one of the following:
 3275 ##      an undefined value (i.e., no variable was specified)
 3276 ##      a reference to an array of variable names -- [var1, var2]
 3277 ##      a number (the number of variables desired) -- 3
 3278 ##      one or more variable names -- (var1, var2)
 3279 ## OUT: an array of variable names
 3280 
 3281 sub get_var_array {
 3282   my $in = shift @_;
 3283   my @out;
 3284 
 3285   if( not defined($in) ) {      #if nothing defined, build default array and return
 3286     @out = ( $functVarDefault );
 3287     return @out;
 3288   }
 3289   elsif( ref( $in ) eq 'ARRAY' ) {  #if given an array ref, dereference and return
 3290     return @{$in};
 3291   }
 3292   elsif( $in =~ /^\d+/ ) {      #if given a number, set up the array and return
 3293     if( $in == 1 ) {
 3294       $out[0] = 'x';
 3295     }
 3296     elsif( $in == 2 ) {
 3297       $out[0] = 'x';
 3298       $out[1] = 'y';
 3299     }
 3300     elsif( $in == 3 ) {
 3301       $out[0] = 'x';
 3302       $out[1] = 'y';
 3303       $out[2] = 'z';
 3304     }
 3305     else {  #default to the x_1, x_2, ... convention
 3306       my ($i, $tag);
 3307       for($i = 0; $i < $in; $i++) {$out[$i] = "${functVarDefault}_".($i+1)}
 3308     }
 3309     return @out;
 3310   }
 3311   else {            #if given one or more names, return as an array
 3312     unshift( @_, $in );
 3313     return @_;
 3314   }
 3315 }
 3316 
 3317 ## Internal routine that converts limits into the standard array of arrays format
 3318 ##  Some of the cases are probably unneccessary, but better safe than sorry
 3319 ##
 3320 ## IN:  one of the following:
 3321 ##      an undefined value (i.e., no limits were specified)
 3322 ##      a reference to an array of arrays of limits -- [[llim,ulim], [llim,ulim]]
 3323 ##      a reference to an array of limits -- [llim, ulim]
 3324 ##      an array of array references -- ([llim,ulim], [llim,ulim])
 3325 ##      an array of limits -- (llim,ulim)
 3326 ## OUT: an array of array references -- ([llim,ulim], [llim,ulim]) or ([llim,ulim])
 3327 
 3328 sub get_limits_array {
 3329   my $in = shift @_;
 3330   my @out;
 3331 
 3332   if( not defined($in) ) {        #if nothing defined, build default array and return
 3333     @out = ( [$functLLimitDefault, $functULimitDefault] );
 3334     return @out;
 3335   }
 3336   elsif( ref($in) eq 'ARRAY' ) {        #$in is either ref to array, or ref to array of refs
 3337     my @deref = @{$in};
 3338 
 3339     if( ref( $in->[0] ) eq 'ARRAY' ) {    #$in is a ref to an array of array refs
 3340       return @deref;
 3341     }
 3342     else {            #$in was just a ref to an array of numbers
 3343       @out = ( $in );
 3344       return @out;
 3345     }
 3346   }
 3347   else {              #$in was an array of references or numbers
 3348     unshift( @_, $in );
 3349 
 3350     if( ref($_[0]) eq 'ARRAY' ) {     #$in was an array of references, so just return it
 3351       return @_;
 3352     }
 3353     else {            #$in was an array of numbers
 3354       @out = ( \@_ );
 3355       return @out;
 3356     }
 3357   }
 3358 }
 3359 
 3360 #sub check_option_list {
 3361 # my $size = scalar(@_);
 3362 # if( ( $size % 2 ) != 0 ) {
 3363 #   warn "ERROR in answer evaluator generator:\n" .
 3364 #     "Usage: <CODE>str_cmp([\$ans1,  \$ans2],%options)</CODE>
 3365 #     or <CODE> num_cmp([\$num1, \$num2], %options)</CODE><BR>
 3366 #     A list of inputs must be inclosed in square brackets <CODE>[\$ans1, \$ans2]</CODE>";
 3367 # }
 3368 #}
 3369 
 3370 # simple subroutine to display an error message when
 3371 # function compares are called with invalid parameters
 3372 sub function_invalid_params {
 3373   my $correctEqn = shift @_;
 3374   my $error_response = sub {
 3375     my $PGanswerMessage = "Tell your professor that there is an error with the parameters " .
 3376             "to the function answer evaluator";
 3377     return ( 0, $correctEqn, "", $PGanswerMessage );
 3378   };
 3379   return $error_response;
 3380 }
 3381 
 3382 sub clean_up_error_msg {
 3383   my $msg = $_[0];
 3384   $msg =~ s/^\[[^\]]*\][^:]*://;
 3385   $msg =~ s/Unquoted string//g;
 3386   $msg =~ s/may\s+clash.*/does not make sense here/;
 3387   $msg =~ s/\sat.*line [\d]*//g;
 3388   $msg = 'Error: '. $msg;
 3389 
 3390   return $msg;
 3391 }
 3392 
 3393 #formats the student and correct answer as specified
 3394 #format must be of a form suitable for sprintf (e.g. '%0.5g'),
 3395 #with the exception that a '#' at the end of the string
 3396 #will cause trailing zeros in the decimal part to be removed
 3397 sub prfmt {
 3398   my($number,$format) = @_;  # attention, the order of format and number are reversed
 3399   my $out;
 3400   if ($format) {
 3401     warn "Incorrect format used: $format. <BR> Format should look something like %4.5g<BR>"
 3402                 unless $format =~ /^\s*%\d*\.?\d*\w#?\s*$/;
 3403 
 3404     if( $format =~ s/#\s*$// ) {  # remove trailing zeros in the decimal
 3405       $out = sprintf( $format, $number );
 3406       $out =~ s/(\.\d*?)0+$/$1/;
 3407       $out =~ s/\.$//;      # in case all decimal digits were zero, remove the decimal
 3408       $out =~ s/e/E/g;        # only use capital E's for exponents. Little e is for 2.71828...
 3409     } elsif (is_a_number($number) ){
 3410       $out = sprintf( $format, $number );
 3411       $out =~ s/e/E/g;        # only use capital E's for exponents. Little e is for 2.71828...
 3412     } else { # number is probably a string representing an arithmetic expression
 3413       $out = $number;
 3414     }
 3415 
 3416   } else {
 3417     if (is_a_number($number)) {# only use capital E's for exponents. Little e is for 2.71828...
 3418       $out = $number;
 3419       $out =~ s/e/E/g;
 3420     } else { # number is probably a string representing an arithmetic expression
 3421       $out = $number;
 3422     }
 3423   }
 3424   return $out;
 3425 }
 3426 #########################################################################
 3427 # Filters for answer evaluators
 3428 #########################################################################
 3429 
 3430 =head2 Filters
 3431 
 3432 =pod
 3433 
 3434 A filter is a short subroutine with the following structure.  It accepts an
 3435 AnswerHash, followed by a hash of options.  It returns an AnswerHash
 3436 
 3437   $ans_hash = filter($ans_hash, %options);
 3438 
 3439 See the AnswerHash.pm file for a list of entries which can be expected to be found
 3440 in an AnswerHash, such as 'student_ans', 'score' and so forth.  Other entries
 3441 may be present for specialized answer evaluators.
 3442 
 3443 The hope is that a well designed set of filters can easily be combined to form
 3444 a new answer_evaluator and that this method will produce answer evaluators which are
 3445 are more robust than the method of copying existing answer evaluators and modifying them.
 3446 
 3447 Here is an outline of how a filter is constructed:
 3448 
 3449   sub filter{
 3450     my $rh_ans = shift;
 3451     my %options = @_;
 3452     assign_option_aliases(\%options,
 3453         'alias1'  => 'option5'
 3454         'alias2'  => 'option7'
 3455     );
 3456     set_default_options(\%options,
 3457         '_filter_name'  =>  'filter',
 3458         'option5'   =>  .0001,
 3459         'option7'   =>  'ascii',
 3460         'allow_unknown_options  =>  0,
 3461     }
 3462     .... body code of filter .......
 3463       if ($error) {
 3464         $rh_ans->throw_error("FILTER_ERROR", "Something went wrong");
 3465         # see AnswerHash.pm for details on using the throw_error method.
 3466 
 3467     $rh_ans;  #reference to an AnswerHash object is returned.
 3468   }
 3469 
 3470 =cut
 3471 
 3472 =head4 compare_numbers
 3473 
 3474 
 3475 =cut
 3476 
 3477 
 3478 sub compare_numbers {
 3479   my ($rh_ans, %options) = @_;
 3480   my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
 3481   if ($PG_eval_errors) {
 3482     $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
 3483     $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
 3484     # return $rh_ans;
 3485   } else {
 3486     $rh_ans->{student_ans} = prfmt($inVal,$options{format});
 3487   }
 3488 
 3489   my $permitted_error;
 3490 
 3491   if ($rh_ans->{tolType} eq 'absolute') {
 3492     $permitted_error = $rh_ans->{tolerance};
 3493   }
 3494   elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) {
 3495       $permitted_error = $options{zeroLevelTol};  ## want $tol to be non zero
 3496   }
 3497   else {
 3498     $permitted_error = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans});
 3499   }
 3500 
 3501   my $is_a_number = is_a_number($inVal);
 3502   $rh_ans->{score} = 1 if ( ($is_a_number) and
 3503       (abs( $inVal - $rh_ans->{correct_ans} ) <= $permitted_error) );
 3504   if (not $is_a_number) {
 3505     $rh_ans->{error_message} = "$rh_ans->{error_message}". 'Your answer does not evaluate to a number ';
 3506   }
 3507 
 3508   $rh_ans;
 3509 }
 3510 
 3511 =head4 std_num_filter
 3512 
 3513   std_num_filter($rh_ans, %options)
 3514   returns $rh_ans
 3515 
 3516 Replaces some constants using math_constants, then evaluates a perl expression.
 3517 
 3518 
 3519 =cut
 3520 
 3521 sub std_num_filter {
 3522   my $rh_ans = shift;
 3523   my %options = @_;
 3524   my $in = $rh_ans->input();
 3525   $in = math_constants($in);
 3526   $rh_ans->{type} = 'std_number';
 3527   my ($inVal,$PG_eval_errors,$PG_full_error_report);
 3528   if ($in =~ /\S/) {
 3529     ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($in);
 3530   } else {
 3531     $PG_eval_errors = '';
 3532   }
 3533 
 3534   if ($PG_eval_errors) {        ##error message from eval or above
 3535     $rh_ans->{ans_message} = 'There is a syntax error in your answer';
 3536     $rh_ans->{student_ans} =
 3537     clean_up_error_msg($PG_eval_errors);
 3538   } else {
 3539     $rh_ans->{student_ans} = $inVal;
 3540   }
 3541   $rh_ans;
 3542 }
 3543 
 3544 =head std_num_array_filter
 3545 
 3546   std_num_array_filter($rh_ans, %options)
 3547   returns $rh_ans
 3548 
 3549 Assumes the {student_ans} field is a numerical  array, and applies BOTH check_syntax and std_num_filter
 3550 to each element of the array.  Does it's best to generate sensible error messages for syntax errors.
 3551 A typical error message displayed in {studnet_ans} might be ( 56, error message, -4).
 3552 
 3553 =cut
 3554 
 3555 sub std_num_array_filter {
 3556   my $rh_ans= shift;
 3557   my %options = @_;
 3558   set_default_options(  \%options,
 3559         '_filter_name'  =>  'std_num_array_filter',
 3560     );
 3561   my @in = @{$rh_ans->{student_ans}};
 3562   my $temp_hash = new AnswerHash;
 3563   my @out=();
 3564   my $PGanswerMessage = '';
 3565   foreach my $item (@in)   {  # evaluate each number in the vector
 3566     $temp_hash->input($item);
 3567     $temp_hash = check_syntax($temp_hash);
 3568     if (defined($temp_hash->{error_flag}) and $temp_hash->{error_flag} eq 'SYNTAX') {
 3569       $PGanswerMessage .= $temp_hash->{ans_message};
 3570       $temp_hash->{ans_message} = undef;
 3571     } else {
 3572       #continue processing
 3573       $temp_hash = std_num_filter($temp_hash);
 3574       if (defined($temp_hash->{ans_message}) and $temp_hash->{ans_message} ) {
 3575         $PGanswerMessage .= $temp_hash->{ans_message};
 3576         $temp_hash->{ans_message} = undef;
 3577       }
 3578     }
 3579     push(@out, $temp_hash->input());
 3580 
 3581   }
 3582   if ($PGanswerMessage) {
 3583     $rh_ans->input( "( " . join(", ", @out ) . " )" );
 3584         $rh_ans->throw_error('SYNTAX', 'There is a syntax error in your answer.');
 3585   } else {
 3586     $rh_ans->input( [@out] );
 3587   }
 3588   $rh_ans;
 3589 }
 3590 
 3591 =head4 function_from_string2
 3592 
 3593 
 3594 
 3595 =cut
 3596 
 3597 sub function_from_string2 {
 3598     my $rh_ans = shift;
 3599     my %options = @_;
 3600   assign_option_aliases(\%options,
 3601         'vars'      => 'ra_vars',
 3602         'var'           => 'ra_vars',
 3603         'store_in'      => 'stdout',
 3604   );
 3605   set_default_options(  \%options,
 3606         'stdin'         =>  'student_ans',
 3607               'stdout'    =>  'rf_student_ans',
 3608           'ra_vars'   =>  [qw( x y )],
 3609           'debug'     =>  0,
 3610           '_filter_name'  =>  'function_from_string2',
 3611     );
 3612     # initialize
 3613     $rh_ans->{_filter_name} = $options{_filter_name};
 3614 
 3615     my $eqn         = $rh_ans->{ $options{stdin} };
 3616     my @VARS        = @{ $options{ 'ra_vars'}    };
 3617     #warn "VARS = ", join("<>", @VARS) if defined($options{debug}) and $options{debug} ==1;
 3618     my $originalEqn = $eqn;
 3619     $eqn            = &math_constants($eqn);
 3620     for( my $i = 0; $i < @VARS; $i++ ) {
 3621         #  This next line is a hack required for 5.6.0 -- it doesn't appear to be needed in 5.6.1
 3622         my ($temp,$er1,$er2) = PG_restricted_eval('"'. $VARS[$i] . '"');
 3623     #$eqn =~ s/\b$VARS[$i]\b/\$VARS[$i]/g;
 3624         $eqn  =~ s/\b$temp\b/\$VARS[$i]/g;
 3625 
 3626   }
 3627   #warn "equation evaluated = $eqn",$rh_ans->pretty_print(), "<br>\noptions<br>\n",
 3628   #     pretty_print(\%options)
 3629   #     if defined($options{debug}) and $options{debug} ==1;
 3630     my ($function_sub,$PG_eval_errors, $PG_full_errors) = PG_answer_eval( q!
 3631       sub {
 3632         my @VARS = @_;
 3633         my $input_str = '';
 3634         for( my $i=0; $i<@VARS; $i++ ) {
 3635           $input_str .= "\$VARS[$i] = $VARS[$i]; ";
 3636         }
 3637         my $PGanswerMessage;
 3638         $input_str .= '! . $eqn . q!';  # need the single quotes to keep the contents of $eqn from being
 3639                                         # evaluated when it is assigned to $input_str;
 3640         my ($out, $PG_eval_errors, $PG_full_errors) = PG_answer_eval($input_str); #Finally evaluated
 3641 
 3642         if ( defined($PG_eval_errors) and $PG_eval_errors =~ /\S/ ) {
 3643             $PGanswerMessage  = clean_up_error_msg($PG_eval_errors);
 3644 # This message seemed too verbose, but it does give extra information, we'll see if it is needed.
 3645 #                    "<br> There was an error in evaluating your function <br>
 3646 #           !. $originalEqn . q! <br>
 3647 #           at ( " . join(', ', @VARS) . " ) <br>
 3648 #            $PG_eval_errors
 3649 #           ";   # this message appears in the answer section which is not process by Latex2HTML so it must
 3650 #                # be in HTML.  That is why $BR is NOT used.
 3651 
 3652       }
 3653       (wantarray) ? ($out, $PGanswerMessage): $out;   # PGanswerMessage may be undefined.
 3654       };
 3655   !);
 3656 
 3657   if (defined($PG_eval_errors) and $PG_eval_errors =~/\S/ ) {
 3658         $PG_eval_errors = clean_up_error_msg($PG_eval_errors);
 3659 
 3660     my $PGanswerMessage = "There was an error in converting the expression
 3661       $BR $originalEqn $BR into a function.
 3662       $BR $PG_eval_errors.";
 3663     $rh_ans->{rf_student_ans} = $function_sub;
 3664     $rh_ans->{ans_message} = $PGanswerMessage;
 3665     $rh_ans->{error_message} = $PGanswerMessage;
 3666     $rh_ans->{error_flag} = 1;
 3667      # we couldn't compile the equation, we'll return an error message.
 3668   } else {
 3669 #     if (defined($options{stdout} )) {
 3670 #       $rh_ans ->{$options{stdout}} = $function_sub;
 3671 #     } else {
 3672 #         $rh_ans->{rf_student_ans} = $function_sub;
 3673 #       }
 3674       $rh_ans ->{$options{stdout}} = $function_sub;
 3675   }
 3676 
 3677     $rh_ans;
 3678 }
 3679 
 3680 =head4 is_zero_array
 3681 
 3682 
 3683 =cut
 3684 
 3685 
 3686 sub is_zero_array {
 3687     my $rh_ans = shift;
 3688     my %options = @_;
 3689     set_default_options(  \%options,
 3690         '_filter_name'  =>  'is_zero_array',
 3691         'tolerance'     =>  0.000001,
 3692         'stdin'         => 'ra_differences',
 3693         'stdout'        => 'score',
 3694     );
 3695     #intialize
 3696     $rh_ans->{_filter_name} = $options{_filter_name};
 3697 
 3698     my $array = $rh_ans -> {$options{stdin}};  # default ra_differences
 3699   my $num = @$array;
 3700   my $i;
 3701   my $max = 0; my $mm;
 3702   for ($i=0; $i< $num; $i++) {
 3703     $mm = $array->[$i] ;
 3704     if  (not is_a_number($mm) ) {
 3705       $max = $mm;  # break out if one of the elements is not a number
 3706       last;
 3707     }
 3708     $max = abs($mm) if abs($mm) > $max;
 3709   }
 3710   if (not is_a_number($max)) {
 3711     $rh_ans->{score} = 0;
 3712       my $error = "WeBWorK was unable evaluate your function. Please check that your
 3713                 expression doesn't take roots of negative numbers, or divide by zero.";
 3714     $rh_ans->throw_error('EVAL',$error);
 3715   } else {
 3716       $rh_ans->{$options{stdout}} = ($max < $options{tolerance} ) ? 1: 0;       # set 'score' to 1 if the array is close to 0;
 3717   }
 3718   $rh_ans;
 3719 }
 3720 
 3721 =head4 best_approx_parameters
 3722 
 3723   best_approx_parameters($rh_ans,%options);   #requires the following fields in $rh_ans
 3724                         {rf_student_ans}      # reference to the test answer
 3725                         {rf_correct_ans}      # reference to the comparison answer
 3726                         {evaluation_points},  # an array of row vectors indicating the points
 3727                                       # to evaluate when comparing the functions
 3728 
 3729                          %options       # debug => 1   gives more error answers
 3730                                     # param_vars => ['']  additional parameters used to adapt to function
 3731                          )
 3732 
 3733 
 3734 The parameters for the comparison function which best approximates the test_function are stored
 3735 in the field {ra_parameters}.
 3736 
 3737 
 3738 The last $dim_of_parms_space variables are assumed to be parameters, and it is also
 3739 assumed that the function \&comparison_fun
 3740 depends linearly on these variables.  This function finds the  values for these parameters which minimizes the
 3741 Euclidean distance (L2 distance) between the test function and the comparison function and the test points specified
 3742 by the array reference  \@rows_of_test_points.  This is assumed to be an array of arrays, with the inner arrays
 3743 determining a test point.
 3744 
 3745 The comparison function should have $dim_of_params_space more input variables than the test function.
 3746 
 3747 
 3748 
 3749 
 3750 
 3751 =cut
 3752 
 3753 # Used internally:
 3754 #
 3755 #   &$determine_param_coeff( $rf_comparison_function # a reference to the correct answer function
 3756 #                    $ra_variables                   # an array of the active input variables to the functions
 3757 #                    $dim_of_params_space            # indicates the number of parameters upon which the
 3758 #                                                    # the comparison function depends linearly.  These are assumed to
 3759 #                                                    # be the last group of inputs to the comparison function.
 3760 #
 3761 #                    %options                        # $options{debug} gives more error messages
 3762 #
 3763 #                                                    # A typical function might look like
 3764 #                                                    # f(x,y,z,a,b) = x^2+a*cos(xz) + b*sin(x) with a parameter
 3765 #                                                    # space of dimension 2 and a variable space of dimension 3.
 3766 #                   )
 3767 #         # returns a list of coefficients
 3768 
 3769 sub best_approx_parameters {
 3770     my $rh_ans = shift;
 3771     my %options = @_;
 3772     set_default_options(\%options,
 3773         '_filter_name'      =>  'best_approx_paramters',
 3774         'allow_unknown_options' =>  1,
 3775     );
 3776     my $errors = undef;
 3777     # This subroutine for the determining the coefficents of the parameters at a given point
 3778     # is pretty specialized, so it is included here as a sub-subroutine.
 3779     my $determine_param_coeffs  = sub {
 3780     my ($rf_fun, $ra_variables, $dim_of_params_space, %options) =@_;
 3781     my @zero_params=();
 3782     for(my $i=1;$i<=$dim_of_params_space;$i++){push(@zero_params,0); }
 3783     my @vars = @$ra_variables;
 3784     my @coeff = ();
 3785     my @inputs = (@vars,@zero_params);
 3786     my ($f0, $f1, $err);
 3787     ($f0, $err) = &{$rf_fun}(@inputs);
 3788     if (defined($err) ) {
 3789       $errors .= "$err ";
 3790     } else {
 3791       for (my $i=@vars;$i<@inputs;$i++) {
 3792         $inputs[$i]=1;  # set one parameter to 1;
 3793         my($f1,$err) = &$rf_fun(@inputs);
 3794         if (defined($err) ) {
 3795           $errors .= " $err ";
 3796         } else {
 3797           push(@coeff, $f1-$f0);
 3798         }
 3799         $inputs[$i]=0;  # set it back
 3800       }
 3801     }
 3802     (\@coeff, $errors);
 3803   };
 3804     my $rf_fun = $rh_ans->{rf_student_ans};
 3805     my $rf_correct_fun = $rh_ans->{rf_correct_ans};
 3806     my $ra_vars_matrix = $rh_ans->{evaluation_points};
 3807     my $dim_of_param_space = @{$options{param_vars}};
 3808     # Short cut.  Bail if there are no param_vars
 3809     unless ($dim_of_param_space >0) {
 3810     $rh_ans ->{ra_parameters} = [];
 3811     return $rh_ans;
 3812     }
 3813     # inputs are row arrays in this case.
 3814     my @zero_params=();
 3815 
 3816     for(my $i=1;$i<=$dim_of_param_space;$i++){push(@zero_params,0); }
 3817     my @rows_of_vars = @$ra_vars_matrix;
 3818     warn "input rows ", pretty_print(\@rows_of_vars) if defined($options{debug}) and $options{debug};
 3819     my $rows = @rows_of_vars;
 3820     my $matrix =new Matrix($rows,$dim_of_param_space);
 3821     my $rhs_vec = new Matrix($rows, 1);
 3822     my $row_num = 1;
 3823     my ($ra_coeff,$val2, $val1, $err1,$err2,@inputs,@vars);
 3824     my $number_of_data_points = $dim_of_param_space +2;
 3825     while (@rows_of_vars and $row_num <= $number_of_data_points) {
 3826      # get one set of data points from the test function;
 3827       @vars = @{ shift(@rows_of_vars) };
 3828       ($val2, $err1) = &{$rf_fun}(@vars);
 3829       $errors .= " $err1 "  if defined($err1);
 3830       @inputs = (@vars,@zero_params);
 3831       ($val1, $err2) = &{$rf_correct_fun}(@inputs);
 3832       $errors .= " $err2 " if defined($err2);
 3833 
 3834       unless (defined($err1) or defined($err2) ) {
 3835           $rhs_vec->assign($row_num,1, $val2-$val1 );
 3836 
 3837     # warn "rhs data  val1=$val1, val2=$val2, val2 - val1 = ", $val2 - $val1 if $options{debug};
 3838     # warn "vars ", join(" | ", @vars) if $options{debug};
 3839 
 3840       ($ra_coeff, $err1) = &{$determine_param_coeffs}($rf_correct_fun,\@vars,$dim_of_param_space,%options);
 3841       if (defined($err1) ) {
 3842         $errors .= " $err1 ";
 3843       } else {
 3844         my @coeff = @$ra_coeff;
 3845         my $col_num=1;
 3846           while(@coeff) {
 3847             $matrix->assign($row_num,$col_num, shift(@coeff) );
 3848             $col_num++;
 3849           }
 3850         }
 3851       }
 3852       $row_num++;
 3853       last if $errors;  # break if there are any errors.
 3854                       # This cuts down on the size of error messages.
 3855                       # However it impossible to check for equivalence at 95% of points
 3856             # which might be useful for functions that are not defined at some points.
 3857   }
 3858     warn "<br> best_approx_parameters: matrix1 <br>  ", " $matrix " if $options{debug};
 3859     warn "<br> best_approx_parameters: vector <br>  ", " $rhs_vec " if $options{debug};
 3860 
 3861    # we have   Matrix * parameter = data_vec + perpendicular vector
 3862    # where the matrix has column vectors defining the span of the parameter space
 3863    # multiply both sides by Matrix_transpose and solve for the parameters
 3864    # This is exactly what the method proj_coeff method does.
 3865    my @array;
 3866    if (defined($errors) ) {
 3867     @array = ();   #     new Matrix($dim_of_param_space,1);
 3868    } else {
 3869     @array = $matrix->proj_coeff($rhs_vec)->list();
 3870    }
 3871   # check size (hack)
 3872   my $max = 0;
 3873   foreach my $val (@array ) {
 3874     $max = abs($val) if  $max < abs($val);
 3875     if (not is_a_number($val) ) {
 3876       $max = "NaN: $val";
 3877       last;
 3878     }
 3879   }
 3880   if ($max =~/NaN/) {
 3881     $errors .= "WeBWorK was unable evaluate your function. Please check that your
 3882                 expression doesn't take roots of negative numbers, or divide by zero.";
 3883   } elsif ($max > $options{maxConstantOfIntegration} ) {
 3884     $errors .= "At least one of the adapting parameters
 3885              (perhaps the constant of integration) is too large: $max,
 3886              ( the maximum allowed is $options{maxConstantOfIntegration} )";
 3887   }
 3888 
 3889     $rh_ans->{ra_parameters} = \@array;
 3890     $rh_ans->throw_error('EVAL', $errors) if defined($errors);
 3891     $rh_ans;
 3892 }
 3893 
 3894 =head4 calculate_difference_vector
 3895 
 3896   calculate_difference_vector( $ans_hash, %options);
 3897 
 3898                 {rf_student_ans},     # a reference to the test function
 3899                                {rf_correct_ans},      # a reference to the correct answer function
 3900                                {evaluation_points},   # an array of row vectors indicating the points
 3901                                           # to evaluate when comparing the functions
 3902                                {ra_parameters}        # these are the (optional) additional inputs to
 3903                                                       # the comparison function which adapt it properly
 3904                                                       # to the problem at hand.
 3905 
 3906                                %options               # mode => 'rel'  specifies that each element in the
 3907                                                       # difference matrix is divided by the correct answer.
 3908                                                       # unless the correct answer is nearly 0.
 3909                               )
 3910 
 3911 =cut
 3912 
 3913 sub calculate_difference_vector {
 3914   my $rh_ans = shift;
 3915   my %options = @_;
 3916   assign_option_aliases( \%options,
 3917     );
 3918     set_default_options(  \%options,
 3919         allow_unknown_options  =>  1,
 3920       stdin1               => 'rf_student_ans',
 3921       stdin2                 => 'rf_correct_ans',
 3922       stdout                 => 'ra_differences',
 3923     debug                  =>  0,
 3924     tolType                => 'absolute',
 3925     error_msg_flag         =>  1,
 3926      );
 3927   # initialize
 3928   $rh_ans->{_filter_name} = 'calculate_difference_vector';
 3929   my $rf_fun              = $rh_ans -> {$options{stdin1}};        # rf_student_ans by default
 3930   my $rf_correct_fun      = $rh_ans -> {$options{stdin2}};        # rf_correct_ans by default
 3931   my $ra_parameters       = $rh_ans -> {ra_parameters};
 3932   my @evaluation_points   = @{$rh_ans->{evaluation_points} };
 3933   my @parameters          = ();
 3934   @parameters             = @$ra_parameters if defined($ra_parameters) and ref($ra_parameters) eq 'ARRAY';
 3935   my $errors              = undef;
 3936   my @zero_params         = ();
 3937   for (my $i=1;$i<=@{$ra_parameters};$i++) {
 3938     push(@zero_params,0);
 3939   }
 3940   my @differences         = ();
 3941   my @student_values;
 3942   my @adjusted_student_values;
 3943   my @instructorVals;
 3944   my ($diff,$instructorVal);
 3945   # calculate the vector of differences between the test function and the comparison function.
 3946   while (@evaluation_points) {
 3947     my ($err1, $err2,$err3);
 3948     my @vars = @{ shift(@evaluation_points) };
 3949     my @inputs = (@vars, @parameters);
 3950     my ($inVal,  $correctVal);
 3951     ($inVal, $err1) = &{$rf_fun}(@vars);
 3952     $errors .= " $err1 "  if defined($err1);
 3953     $errors .= " Error detected evaluating student input at (".join(' , ',@vars) ." ) " if  defined($options{debug}) and $options{debug}==1 and defined($err1);
 3954     ($correctVal, $err2) =&{$rf_correct_fun}(@inputs);
 3955     $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err2 " if defined($err2);
 3956     $errors .= " Error detected evaluating correct adapted answer  at (".join(' , ',@inputs) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err2);
 3957     ($instructorVal,$err3)= &$rf_correct_fun(@vars, @zero_params);
 3958     $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err3 " if defined($err3);
 3959     $errors .= " Error detected evaluating instructor answer  at (".join(' , ',@vars, @zero_params) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err3);
 3960     unless (defined($err1) or defined($err2) or defined($err3) ) {
 3961       $diff = ( $inVal - ($correctVal -$instructorVal ) ) - $instructorVal;  #prevents entering too high a number?
 3962       #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff;
 3963       if ( $options{tolType} eq 'relative' ) {  #relative tolerance
 3964         #warn "diff = $diff";
 3965         #$diff = ( $inVal - ($correctVal-$instructorVal ) )/abs($instructorVal) -1    if abs($instructorVal) > $options{zeroLevel};
 3966         $diff = ( $inVal - ($correctVal-$instructorVal ) )/$instructorVal -1    if abs($instructorVal) > $options{zeroLevel};
 3967         #$diff = ( $inVal - ($correctVal-$instructorVal- $instructorVal ) )/abs($instructorVal)    if abs($instructorVal) > $options{zeroLevel};
 3968         #warn "diff = $diff,   ", abs( &$rf_correct_fun(@inputs) ) , "-- $correctVal";
 3969       }
 3970     }
 3971     last if $errors;  # break if there are any errors.
 3972                   # This cuts down on the size of error messages.
 3973                   # However it impossible to check for equivalence at 95% of points
 3974                   # which might be useful for functions that are not defined at some points.
 3975         push(@student_values,$inVal);
 3976         push(@adjusted_student_values,(  $inVal - ($correctVal -$instructorVal) ) );
 3977     push(@differences, $diff);
 3978     push(@instructorVals,$instructorVal);
 3979   }
 3980   if (( not defined($errors) )  or $errors eq '' or $options{error_msg_flag} ) {
 3981       $rh_ans ->{$options{stdout}} = \@differences;
 3982     $rh_ans ->{ra_student_values} = \@student_values;
 3983     $rh_ans ->{ra_adjusted_student_values} = \@adjusted_student_values;
 3984     $rh_ans->{ra_instructor_values}=\@instructorVals;
 3985     $rh_ans->throw_error('EVAL', $errors) if defined($errors);
 3986   } else {
 3987 
 3988   }      # no output if error_msg_flag is set to 0.
 3989 
 3990   $rh_ans;
 3991 }
 3992 
 3993 =head4 fix_answer_for_display
 3994 
 3995 =cut
 3996 
 3997 sub fix_answers_for_display {
 3998   my ($rh_ans, %options) = @_;
 3999   if ( $rh_ans->{answerIsString} ==1) {
 4000     $rh_ans = evaluatesToNumber ($rh_ans, %options);
 4001   }
 4002   if (defined ($rh_ans->{student_units})) {
 4003     $rh_ans->{student_ans} = $rh_ans->{student_ans}. ' '. $rh_ans->{student_units};
 4004 
 4005   }
 4006   if ( $rh_ans->catch_error('UNITS')  ) {  # create preview latex string for expressions even if the units are incorrect
 4007       my $rh_temp = new AnswerHash;
 4008       $rh_temp->{student_ans} = $rh_ans->{student_ans};
 4009       $rh_temp = check_syntax($rh_temp);
 4010       $rh_ans->{preview_latex_string} = $rh_temp->{preview_latex_string};
 4011   }
 4012   $rh_ans->{correct_ans} = $rh_ans->{original_correct_ans};
 4013 
 4014   $rh_ans;
 4015 }
 4016 
 4017 =head4 evaluatesToNumber
 4018 
 4019 =cut
 4020 
 4021 sub evaluatesToNumber {
 4022   my ($rh_ans, %options) = @_;
 4023   if (is_a_numeric_expression($rh_ans->{student_ans})) {
 4024     my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
 4025     if ($PG_eval_errors) { # this if statement should never be run
 4026       # change nothing
 4027     } else {
 4028       # change this
 4029       $rh_ans->{student_ans} = prfmt($inVal,$options{format});
 4030     }
 4031   }
 4032   $rh_ans;
 4033 }
 4034 
 4035 =head4 is_numeric_expression
 4036 
 4037 =cut
 4038 
 4039 sub is_a_numeric_expression {
 4040   my $testString = shift;
 4041   my $is_a_numeric_expression = 0;
 4042   my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($testString);
 4043   if ($PG_eval_errors) {
 4044     $is_a_numeric_expression = 0;
 4045   } else {
 4046     $is_a_numeric_expression = 1;
 4047   }
 4048   $is_a_numeric_expression;
 4049 }
 4050 
 4051 =head4 is_a_number
 4052 
 4053 =cut
 4054 
 4055 sub is_a_number {
 4056   my ($num,%options) =  @_;
 4057   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
 4058   my ($rh_ans);
 4059   if ($process_ans_hash) {
 4060     $rh_ans = $num;
 4061     $num = $rh_ans->{student_ans};
 4062   }
 4063 
 4064   my $is_a_number = 0;
 4065   return $is_a_number unless defined($num);
 4066   $num =~ s/^\s*//; ## remove initial spaces
 4067   $num =~ s/\s*$//; ## remove trailing spaces
 4068 
 4069   ## the following is copied from the online perl manual
 4070   if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){
 4071     $is_a_number = 1;
 4072   }
 4073 
 4074   if ($process_ans_hash)   {
 4075         if ($is_a_number == 1 ) {
 4076           $rh_ans->{student_ans}=$num;
 4077           return $rh_ans;
 4078         } else {
 4079           $rh_ans->{student_ans} = "Incorrect number format:  You must enter a number, e.g. -6, 5.3, or 6.12E-3";
 4080           $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
 4081           return $rh_ans;
 4082         }
 4083   } else {
 4084     return $is_a_number;
 4085   }
 4086 }
 4087 
 4088 =head4 is_a_fraction
 4089 
 4090 =cut
 4091 
 4092 sub is_a_fraction {
 4093   my ($num,%options) =  @_;
 4094   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
 4095   my ($rh_ans);
 4096   if ($process_ans_hash) {
 4097     $rh_ans = $num;
 4098     $num = $rh_ans->{student_ans};
 4099   }
 4100 
 4101   my $is_a_fraction = 0;
 4102   return $is_a_fraction unless defined($num);
 4103   $num =~ s/^\s*//; ## remove initial spaces
 4104   $num =~ s/\s*$//; ## remove trailing spaces
 4105 
 4106   if ($num =~ /^\s*\-?\s*[\/\d\.Ee\s]*$/) {
 4107     $is_a_fraction = 1;
 4108   }
 4109 
 4110     if ($process_ans_hash)   {
 4111       if ($is_a_fraction == 1 ) {
 4112         $rh_ans->{student_ans}=$num;
 4113         return $rh_ans;
 4114       } else {
 4115         $rh_ans->{student_ans} = "Not a number of fraction: You must enter a number or fraction, e.g. -6 or 7/13";
 4116         $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
 4117         return $rh_ans;
 4118       }
 4119 
 4120       } else {
 4121     return $is_a_fraction;
 4122   }
 4123 }
 4124 
 4125 =head4 phase_pi
 4126   I often discovered that the answers I was getting, when using the arctan function would be off by phases of
 4127   pi, which for the tangent function, were equivalent values. This method allows for this.
 4128 =cut
 4129 
 4130 sub phase_pi {
 4131   my ($num,%options) =  @_;
 4132   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
 4133   my ($rh_ans);
 4134   if ($process_ans_hash) {
 4135     $rh_ans = $num;
 4136     $num = $rh_ans->{correct_ans};
 4137   }
 4138   while( ($rh_ans->{correct_ans}) >  3.14159265358979/2 ){
 4139     $rh_ans->{correct_ans} -= 3.14159265358979;
 4140   }
 4141   while( ($rh_ans->{correct_ans}) <= -3.14159265358979/2 ){
 4142     $rh_ans->{correct_ans} += 3.14159265358979;
 4143   }
 4144   $rh_ans;
 4145 }
 4146 
 4147 =head4 is_an_arithemetic_expression
 4148 
 4149 =cut
 4150 
 4151 sub is_an_arithmetic_expression {
 4152   my ($num,%options) =  @_;
 4153   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
 4154   my ($rh_ans);
 4155   if ($process_ans_hash) {
 4156     $rh_ans = $num;
 4157     $num = $rh_ans->{student_ans};
 4158   }
 4159 
 4160   my $is_an_arithmetic_expression = 0;
 4161   return $is_an_arithmetic_expression unless defined($num);
 4162   $num =~ s/^\s*//; ## remove initial spaces
 4163   $num =~ s/\s*$//; ## remove trailing spaces
 4164 
 4165   if ($num =~ /^[+\-*\/\^\(\)\[\]\{\}\s\d\.Ee]*$/) {
 4166     $is_an_arithmetic_expression =  1;
 4167   }
 4168 
 4169     if ($process_ans_hash)   {
 4170       if ($is_an_arithmetic_expression == 1 ) {
 4171         $rh_ans->{student_ans}=$num;
 4172         return $rh_ans;
 4173       } else {
 4174 
 4175     $rh_ans->{student_ans} = "Not an arithmetic expression: You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2";
 4176         $rh_ans->throw_error('NUMBER', 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2');
 4177         return $rh_ans;
 4178       }
 4179 
 4180       } else {
 4181     return $is_an_arithmetic_expression;
 4182   }
 4183 }
 4184 
 4185 #
 4186 
 4187 =head4 math_constants
 4188 
 4189 replaces pi, e, and ^ with their Perl equivalents
 4190 if useBaseTenLog is non-zero, convert log to logten
 4191 
 4192 =cut
 4193 
 4194 sub math_constants {
 4195   my($in,%options) = @_;
 4196   my $rh_ans;
 4197   my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ;
 4198   if ($process_ans_hash) {
 4199     $rh_ans = $in;
 4200     $in = $rh_ans->{student_ans};
 4201   }
 4202   # The code fragment above allows this filter to be used when the input is simply a string
 4203   # as well as when the input is an AnswerHash, and options.
 4204   $in =~s/\bpi\b/(4*atan2(1,1))/ge;
 4205   $in =~s/\be\b/(exp(1))/ge;
 4206   $in =~s/\^/**/g;
 4207   if($useBaseTenLog) {
 4208     $in =~ s/\blog\b/logten/g;
 4209   }
 4210 
 4211   if ($process_ans_hash)   {
 4212       $rh_ans->{student_ans}=$in;
 4213       return $rh_ans;
 4214     } else {
 4215     return $in;
 4216   }
 4217 }
 4218 
 4219 
 4220 
 4221 =head4 is_array
 4222 
 4223   is_array($rh_ans)
 4224     returns: $rh_ans.   Throws error "NOTARRAY" if this is not an array
 4225 
 4226 =cut
 4227 
 4228 sub is_array  {
 4229   my $rh_ans = shift;
 4230     # return if the result is an array
 4231   return($rh_ans) if  ref($rh_ans->{student_ans}) eq 'ARRAY' ;
 4232   $rh_ans->throw_error("NOTARRAY","The answer is not an array");
 4233   $rh_ans;
 4234 }
 4235 
 4236 =head4 check_syntax
 4237 
 4238   check_syntax( $rh_ans, %options)
 4239     returns an answer hash.
 4240 
 4241 latex2html preview code are installed in the answer hash.
 4242 The input has been transformed, changing 7pi to 7*pi  or 7x to 7*x.
 4243 Syntax error messages may be generated and stored in student_ans
 4244 Additional syntax error messages are stored in {ans_message} and duplicated in {error_message}
 4245 
 4246 
 4247 =cut
 4248 
 4249 sub check_syntax {
 4250         my $rh_ans = shift;
 4251         my %options = @_;
 4252         assign_option_aliases(\%options,
 4253     );
 4254     set_default_options(  \%options,
 4255           'stdin'         =>  'student_ans',
 4256           'stdout'    =>  'student_ans',
 4257           'ra_vars'   =>  [qw( x y )],
 4258           'debug'     =>  0,
 4259           '_filter_name'  =>  'check_syntax',
 4260           error_msg_flag  =>  1,
 4261     );
 4262     #initialize
 4263     $rh_ans->{_filter_name}     = $options{_filter_name};
 4264         unless ( defined( $rh_ans->{$options{stdin}} ) ) {
 4265           warn "Check_syntax requires an equation in the field '$options{stdin}' or input";
 4266           $rh_ans->throw_error("1","'$options{stdin}' field not defined");
 4267           return $rh_ans;
 4268         }
 4269         my $in     = $rh_ans->{$options{stdin}};
 4270     my $parser = new AlgParserWithImplicitExpand;
 4271     my $ret    = $parser -> parse($in);     #for use with loops
 4272 
 4273     if ( ref($ret) )  {   ## parsed successfully
 4274       # $parser -> tostring();   # FIXME?  was this needed for some reason?????
 4275       $parser -> normalize();
 4276       $rh_ans -> {$options{stdout}}     = $parser -> tostring();
 4277       $rh_ans -> {preview_text_string}  = $in;
 4278       $rh_ans -> {preview_latex_string} = $parser -> tolatex();
 4279 
 4280     } elsif ($options{error_msg_flag} ) {         ## error in parsing
 4281 
 4282       $rh_ans->{$options{stdout}}     = 'syntax error:'. $parser->{htmlerror},
 4283       $rh_ans->{'ans_message'}      = $parser -> {error_msg},
 4284       $rh_ans->{'preview_text_string'}  = '',
 4285       $rh_ans->{'preview_latex_string'} = '',
 4286       $rh_ans->throw_error('SYNTAX',  'syntax error in answer:'. $parser->{htmlerror} . "$BR" .$parser -> {error_msg});
 4287     }   # no output is produced if there is an error and the error_msg_flag is set to zero
 4288        $rh_ans;
 4289 
 4290 }
 4291 
 4292 =head4 check_strings
 4293 
 4294   check_strings ($rh_ans, %options)
 4295     returns $rh_ans
 4296 
 4297 =cut
 4298 
 4299 sub check_strings {
 4300   my ($rh_ans, %options) = @_;
 4301 
 4302   # if the student's answer is a number, simply return the answer hash (unchanged).
 4303 
 4304   #  we allow constructions like -INF to be treated as a string. Thus we ignore an initial
 4305   # - in deciding whether the student's answer is a number or string
 4306 
 4307   my $temp_ans = $rh_ans->{student_ans};
 4308   $temp_ans =~ s/^\s*\-//;   # remove an initial -
 4309 
 4310   if  ( $temp_ans =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/)   {
 4311   # if ( $rh_ans->{answerIsString} == 1) {
 4312   #     #$rh_ans->throw_error('STRING','Incorrect Answer'); # student's answer is a number
 4313   # }
 4314     return $rh_ans;
 4315   }
 4316   # the student's answer is recognized as a string
 4317   my $ans = $rh_ans->{student_ans};
 4318 
 4319 # OVERVIEW of reminder of function:
 4320 # if answer is correct, return correct.  (adjust score to 1)
 4321 # if answer is incorect:
 4322 # 1) determine if the answer is sensible.  if it is, return incorrect.
 4323 # 2) if the answer is not sensible (and incorrect), then return an error message indicating so.
 4324 # no matter what:  throw a 'STRING' error to skip numerical evaluations.  (error flag skips remainder of pre_filters and evaluators)
 4325 # last: 'STRING' post_filter will clear the error (avoiding pink screen.)
 4326 
 4327   my $sensibleAnswer = 0;
 4328   $ans = str_filters( $ans, 'compress_whitespace' );  # remove trailing, leading, and double spaces.
 4329   my ($ans_eval) = str_cmp($rh_ans->{correct_ans});
 4330   my $temp_ans_hash = $ans_eval->evaluate($ans);
 4331   $rh_ans->{test} = $temp_ans_hash;
 4332 
 4333   if ($temp_ans_hash->{score} ==1 ) {     # students answer matches the correct answer.
 4334     $rh_ans->{score} = 1;
 4335     $sensibleAnswer = 1;
 4336   } else {            # students answer does not match the correct answer.
 4337     my $legalString = '';       # find out if string makes sense
 4338     my @legalStrings = @{$options{strings}};
 4339     foreach $legalString (@legalStrings) {
 4340       if ( uc($ans) eq uc($legalString) ) {
 4341         $sensibleAnswer = 1;
 4342         last;
 4343         }
 4344       }
 4345     $sensibleAnswer = 1 unless $ans =~ /\S/;  ## empty answers are sensible
 4346     $rh_ans->throw_error('EVAL', "Your answer is not a recognized answer") unless ($sensibleAnswer);
 4347     # $temp_ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' ) unless ($sensibleAnswer);
 4348     # $temp_ans_hash -> setKeys( 'student_ans' => uc($ans) );
 4349   }
 4350 
 4351   $rh_ans->{student_ans} = $ans;
 4352 
 4353   if ($sensibleAnswer) {
 4354     $rh_ans->throw_error('STRING', "The student's answer $rh_ans->{student_ans} is interpreted as a string.");
 4355   }
 4356 
 4357   $rh_ans->{'preview_text_string'}  = $ans,
 4358   $rh_ans->{'preview_latex_string'} = $ans,
 4359 
 4360   # warn ("\$rh_ans->{answerIsString} = $rh_ans->{answerIsString}");
 4361   $rh_ans;
 4362 }
 4363 
 4364 =head4 check_units
 4365 
 4366   check_strings ($rh_ans, %options)
 4367     returns $rh_ans
 4368 
 4369 
 4370 =cut
 4371 
 4372 sub check_units {
 4373   my ($rh_ans, %options) = @_;
 4374   my %correct_units = %{$rh_ans-> {rh_correct_units}};
 4375   my $ans = $rh_ans->{student_ans};
 4376   # $ans = '' unless defined ($ans);
 4377   $ans = str_filters ($ans, 'trim_whitespace');
 4378   my $original_student_ans = $ans;
 4379   $rh_ans->{original_student_ans} = $original_student_ans;
 4380 
 4381   # it surprises me that the match below works since the first .* is greedy.
 4382   my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/;
 4383 
 4384   unless ( defined($num_answer) && $units ) {
 4385     # there is an error reading the input
 4386     if ( $ans =~ /\S/ )  {  # the answer is not blank
 4387       $rh_ans -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " .
 4388         "as a number or an arithmetic expression followed by a unit specification. " .
 4389         "Your answer must contain units." );
 4390       $rh_ans->throw_error('UNITS', "The answer \"$ans\" could not be interpreted " .
 4391         "as a number or an arithmetic expression followed by a unit specification. " .
 4392         "Your answer must contain units." );
 4393     }
 4394     return $rh_ans;
 4395   }
 4396 
 4397   # we have been able to parse the answer into a numerical part and a unit part
 4398 
 4399   # $num_answer = $1;   #$1 and $2 from the regular expression above
 4400   # $units    = $2;
 4401 
 4402   my %units = Units::evaluate_units($units);
 4403   if ( defined( $units{'ERROR'} ) ) {
 4404      # handle error condition
 4405           $units{'ERROR'} = clean_up_error_msg($units{'ERROR'});
 4406     $rh_ans -> setKeys( 'ans_message' => "$units{'ERROR'}" );
 4407     $rh_ans -> throw_error('UNITS', "$units{'ERROR'}");
 4408     return $rh_ans;
 4409   }
 4410 
 4411   my $units_match = 1;
 4412   my $fund_unit;
 4413   foreach $fund_unit (keys %correct_units) {
 4414     next if $fund_unit eq 'factor';
 4415     $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit};
 4416   }
 4417 
 4418   if ( $units_match ) {
 4419         # units are ok.  Evaluate the numerical part of the answer
 4420     $rh_ans->{'tolerance'} = $rh_ans->{'tolerance'}* $correct_units{'factor'}/$units{'factor'}  if
 4421           $rh_ans->{'tolType'} eq 'absolute'; # the tolerance is in the units specified by the instructor.
 4422     $rh_ans->{correct_ans} =  prfmt($rh_ans->{correct_ans}*$correct_units{'factor'}/$units{'factor'});
 4423     $rh_ans->{student_units} = $units;
 4424     $rh_ans->{student_ans} = $num_answer;
 4425 
 4426   } else {
 4427         $rh_ans -> setKeys( ans_message => 'There is an error in the units for this answer.' );
 4428         $rh_ans -> throw_error ( 'UNITS', 'There is an error in the units for this answer.' );
 4429   }
 4430 
 4431   return $rh_ans;
 4432 }
 4433 
 4434 
 4435 
 4436 =head2 Filter utilities
 4437 
 4438 These two subroutines can be used in filters to set default options.  They
 4439 help make filters perform in uniform, predictable ways, and also make it
 4440 easy to recognize from the code which options a given filter expects.
 4441 
 4442 
 4443 =head4 assign_option_aliases
 4444 
 4445 Use this to assign aliases for the standard options.  It must come before set_default_options
 4446 within the subroutine.
 4447 
 4448     assign_option_aliases(\%options,
 4449         'alias1'  => 'option5'
 4450         'alias2'  => 'option7'
 4451     );
 4452 
 4453 
 4454 If the subroutine is called with an option  " alias1 => 23 " it will behave as if it had been
 4455 called with the option " option5 => 23 "
 4456 
 4457 =cut
 4458 
 4459 
 4460 
 4461 sub assign_option_aliases {
 4462   my $rh_options = shift;
 4463   warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
 4464   my @option_aliases = @_;
 4465   while (@option_aliases) {
 4466     my $alias = shift @option_aliases;
 4467     my $option_key = shift @option_aliases;
 4468 
 4469     if (defined($rh_options->{$alias} )) {                       # if the alias appears in the option list
 4470       if (not defined($rh_options->{$option_key}) ) {          # and the option itself is not defined,
 4471         $rh_options->{$option_key} = $rh_options->{$alias};  # insert the value defined by the alias into the option value
 4472                                                              # the FIRST alias for a given option takes precedence
 4473                                                              # (after the option itself)
 4474       } else {
 4475         warn "option $option_key is already defined as", $rh_options->{$option_key}, "<br>\n",
 4476              "The attempt to override this option with the alias $alias with value ", $rh_options->{$alias},
 4477              " was ignored.";
 4478       }
 4479     }
 4480     delete($rh_options->{$alias});                               # remove the alias from the initial list
 4481   }
 4482 
 4483 }
 4484 
 4485 =head4 set_default_options
 4486 
 4487     set_default_options(\%options,
 4488         '_filter_name'  =>  'filter',
 4489         'option5'   =>  .0001,
 4490         'option7'   =>  'ascii',
 4491         'allow_unknown_options  =>  0,
 4492     }
 4493 
 4494 Note that the first entry is a reference to the options with which the filter was called.
 4495 
 4496 The option5 is set to .0001 unless the option is explicitly set when the subroutine is called.
 4497 
 4498 The B<'_filter_name'> option should always be set, although there is no error if it is missing.
 4499 It is used mainly for debugging answer evaluators and allows
 4500 you to keep track of which filter is currently processing the answer.
 4501 
 4502 If B<'allow_unknown_options'> is set to 0 then if the filter is called with options which do NOT appear in the
 4503 set_default_options list an error will be signaled and a warning message will be printed out.  This provides
 4504 error checking against misspelling an option and is generally what is desired for most filters.
 4505 
 4506 Occasionally one wants to write a filter which accepts a long list of options, not all of which are known in advance,
 4507 but only uses a subset of the options
 4508 provided.  In this case, setting 'allow_unkown_options' to 1 prevents the error from being signaled.
 4509 
 4510 =cut
 4511 
 4512 sub set_default_options {
 4513   my $rh_options = shift;
 4514   warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
 4515   my %default_options = @_;
 4516   unless ( defined($default_options{allow_unknown_options}) and $default_options{allow_unknown_options} == 1 ) {
 4517     foreach  my $key1 (keys %$rh_options) {
 4518       warn "This option |$key1| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key1});
 4519     }
 4520   }
 4521   foreach my $key (keys %default_options) {
 4522     if  ( not defined($rh_options->{$key} ) and defined( $default_options{$key} )  ) {
 4523       $rh_options->{$key} = $default_options{$key};  #this allows     tol   => undef to allow the tol option, but doesn't define
 4524                                                      # this key unless tol is explicitly defined.
 4525     }
 4526   }
 4527 }
 4528 
 4529 =head2 Problem Grader Subroutines
 4530 
 4531 =cut
 4532 
 4533 ## Problem Grader Subroutines
 4534 
 4535 #####################################
 4536 # This is a model for plug-in problem graders
 4537 #####################################
 4538 sub install_problem_grader {
 4539   my $rf_problem_grader = shift;
 4540   my $rh_flags = PG_restricted_eval(q!\\%main::PG_FLAGS!);
 4541   $rh_flags->{PROBLEM_GRADER_TO_USE} = $rf_problem_grader;
 4542 }
 4543 
 4544 =head4 std_problem_grader
 4545 
 4546 This is an all-or-nothing grader.  A student must get all parts of the problem write
 4547 before receiving credit.  You should make sure to use this grader on multiple choice
 4548 and true-false questions, otherwise students will be able to deduce how many
 4549 answers are correct by the grade reported by webwork.
 4550 
 4551 
 4552   install_problem_grader(~~&std_problem_grader);
 4553 
 4554 =cut
 4555 
 4556 sub std_problem_grader {
 4557   my $rh_evaluated_answers = shift;
 4558   my $rh_problem_state = shift;
 4559   my %form_options = @_;
 4560   my %evaluated_answers = %{$rh_evaluated_answers};
 4561   #  The hash $rh_evaluated_answers typically contains:
 4562   #    'answer1' => 34, 'answer2'=> 'Mozart', etc.
 4563 
 4564   # By default the  old problem state is simply passed back out again.
 4565   my %problem_state = %$rh_problem_state;
 4566 
 4567   # %form_options might include
 4568   # The user login name
 4569   # The permission level of the user
 4570   # The studentLogin name for this psvn.
 4571   # Whether the form is asking for a refresh or is submitting a new answer.
 4572 
 4573   # initial setup of the answer
 4574   my %problem_result = ( score    => 0,
 4575                errors   => '',
 4576              type   => 'std_problem_grader',
 4577              msg    => '',
 4578   );
 4579   # Checks
 4580 
 4581   my $ansCount = keys %evaluated_answers;  # get the number of answers
 4582 
 4583   unless ($ansCount > 0 ) {
 4584 
 4585     $problem_result{msg} = "This problem did not ask any questions.";
 4586     return(\%problem_result,\%problem_state);
 4587   }
 4588 
 4589   if ($ansCount > 1 ) {
 4590     $problem_result{msg} = 'In order to get credit for this problem all answers must be correct.' ;
 4591   }
 4592 
 4593   unless ($form_options{answers_submitted} == 1) {
 4594     return(\%problem_result,\%problem_state);
 4595   }
 4596 
 4597   my $allAnswersCorrectQ=1;
 4598   foreach my $ans_name (keys %evaluated_answers) {
 4599   # I'm not sure if this check is really useful.
 4600     if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) )  {
 4601       $allAnswersCorrectQ = 0 unless( 1 == $evaluated_answers{$ans_name}->{score} );
 4602     }
 4603     else {
 4604       die "Error at file ",__FILE__,"line ", __LINE__,":  Answer |$ans_name| is not a hash reference\n".
 4605          $evaluated_answers{$ans_name} .
 4606          "This probably means that the answer evaluator for this answer\n" .
 4607          "is not working correctly.";
 4608       $problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}";
 4609     }
 4610   }
 4611   # report the results
 4612   $problem_result{score} = $allAnswersCorrectQ;
 4613 
 4614   # I don't like to put in this bit of code.
 4615   # It makes it hard to construct error free problem graders
 4616   # I would prefer to know that the problem score was numeric.
 4617   unless (defined($problem_state{recorded_score}) and $problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) {
 4618     $problem_state{recorded_score} = 0;  # This gets rid of non-numeric scores
 4619   }
 4620   #
 4621   if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) {
 4622     $problem_state{recorded_score} = 1;
 4623   }
 4624   else {
 4625     $problem_state{recorded_score} = 0;
 4626   }
 4627 
 4628   $problem_state{num_of_correct_ans}++ if $allAnswersCorrectQ == 1;
 4629   $problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0;
 4630 
 4631   $problem_state{state_summary_msg} = '';  # an HTML formatted message printed at the bottom of the problem page
 4632 
 4633   (\%problem_result, \%problem_state);
 4634 }
 4635 
 4636 =head4 std_problem_grader2
 4637 
 4638 This is an all-or-nothing grader.  A student must get all parts of the problem write
 4639 before receiving credit.  You should make sure to use this grader on multiple choice
 4640 and true-false questions, otherwise students will be able to deduce how many
 4641 answers are correct by the grade reported by webwork.
 4642 
 4643 
 4644   install_problem_grader(~~&std_problem_grader2);
 4645 
 4646 The only difference between the two versions
 4647 is at the end of the subroutine, where std_problem_grader2
 4648 records the attempt only if there have been no syntax errors,
 4649 whereas std_problem_grader records it regardless.
 4650 
 4651 =cut
 4652 
 4653 
 4654 
 4655 sub std_problem_grader2 {
 4656   my $rh_evaluated_answers = shift;
 4657   my $rh_problem_state = shift;
 4658   my %form_options = @_;
 4659   my %evaluated_answers = %{$rh_evaluated_answers};
 4660   #  The hash $rh_evaluated_answers typically contains:
 4661   #    'answer1' => 34, 'answer2'=> 'Mozart', etc.
 4662 
 4663   # By default the  old problem state is simply passed back out again.
 4664   my %problem_state = %$rh_problem_state;
 4665 
 4666   # %form_options might include
 4667   # The user login name
 4668   # The permission level of the user
 4669   # The studentLogin name for this psvn.
 4670   # Whether the form is asking for a refresh or is submitting a new answer.
 4671 
 4672   # initial setup of the answer
 4673   my %problem_result = ( score        => 0,
 4674              errors       => '',
 4675              type       => 'std_problem_grader',
 4676              msg        => '',
 4677   );
 4678 
 4679   # syntax errors are not counted.
 4680   my $record_problem_attempt = 1;
 4681   # Checks
 4682 
 4683   my $ansCount = keys %evaluated_answers;  # get the number of answers
 4684   unless ($ansCount > 0 ) {
 4685     $problem_result{msg} = "This problem did not ask any questions.";
 4686     return(\%problem_result,\%problem_state);
 4687   }
 4688 
 4689   if ($ansCount > 1 ) {
 4690     $problem_result{msg} = 'In order to get credit for this problem all answers must be correct.' ;
 4691   }
 4692 
 4693   unless ($form_options{answers_submitted} == 1) {
 4694     return(\%problem_result,\%problem_state);
 4695   }
 4696 
 4697   my  $allAnswersCorrectQ=1;
 4698   foreach my $ans_name (keys %evaluated_answers) {
 4699   # I'm not sure if this check is really useful.
 4700     if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) )  {
 4701       $allAnswersCorrectQ = 0 unless( 1 == $evaluated_answers{$ans_name}->{score} );
 4702     }
 4703     else {
 4704       die "Error at file ",__FILE__,"line ", __LINE__,":  Answer |$ans_name| is not a hash reference\n".
 4705          $evaluated_answers{$ans_name} .
 4706          "This probably means that the answer evaluator for this answer\n" .
 4707          "is not working correctly.";
 4708       $problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}";
 4709     }
 4710   }
 4711   # report the results
 4712   $problem_result{score} = $allAnswersCorrectQ;
 4713 
 4714   # I don't like to put in this bit of code.
 4715   # It makes it hard to construct error free problem graders
 4716   # I would prefer to know that the problem score was numeric.
 4717   unless ($problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) {
 4718     $problem_state{recorded_score} = 0;  # This gets rid of non-numeric scores
 4719   }
 4720   #
 4721   if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) {
 4722     $problem_state{recorded_score} = 1;
 4723   }
 4724   else {
 4725     $problem_state{recorded_score} = 0;
 4726   }
 4727   # record attempt only if there have been no syntax errors.
 4728 
 4729   if ($record_problem_attempt == 1) {
 4730     $problem_state{num_of_correct_ans}++ if $allAnswersCorrectQ == 1;
 4731     $problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0;
 4732     $problem_state{state_summary_msg} = '';  # an HTML formatted message printed at the bottom of the problem page
 4733 
 4734   }
 4735   else {
 4736     $problem_result{show_partial_correct_answers} = 0 ;  # prevent partial correct answers from being shown for syntax errors.
 4737   }
 4738   (\%problem_result, \%problem_state);
 4739 }
 4740 
 4741 =head4 avg_problem_grader
 4742 
 4743 This grader gives a grade depending on how many questions from the problem are correct.  (The highest
 4744 grade is the one that is kept.  One can never lower the recorded grade on a problem by repeating it.)
 4745 Many professors (and almost all students :-)  ) prefer this grader.
 4746 
 4747 
 4748   install_problem_grader(~~&avg_problem_grader);
 4749 
 4750 =cut
 4751 
 4752 
 4753 sub avg_problem_grader {
 4754     my $rh_evaluated_answers = shift;
 4755   my $rh_problem_state = shift;
 4756   my %form_options = @_;
 4757   my %evaluated_answers = %{$rh_evaluated_answers};
 4758   #  The hash $rh_evaluated_answers typically contains:
 4759   #    'answer1' => 34, 'answer2'=> 'Mozart', etc.
 4760 
 4761   # By default the  old problem state is simply passed back out again.
 4762   my %problem_state = %$rh_problem_state;
 4763 
 4764 
 4765   # %form_options might include
 4766   # The user login name
 4767   # The permission level of the user
 4768   # The studentLogin name for this psvn.
 4769   # Whether the form is asking for a refresh or is submitting a new answer.
 4770 
 4771   # initial setup of the answer
 4772   my  $total=0;
 4773   my %problem_result = ( score        => 0,
 4774              errors       => '',
 4775              type       => 'avg_problem_grader',
 4776              msg        => '',
 4777   );
 4778   my $count = keys %evaluated_answers;
 4779   $problem_result{msg} = 'You can earn partial credit on this problem.' if $count >1;
 4780   # Return unless answers have been submitted
 4781   unless ($form_options{answers_submitted} == 1) {
 4782     return(\%problem_result,\%problem_state);
 4783   }
 4784 
 4785   # Answers have been submitted -- process them.
 4786   foreach my $ans_name (keys %evaluated_answers) {
 4787     # I'm not sure if this check is really useful.
 4788     if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) )  {
 4789       $total += $evaluated_answers{$ans_name}->{score};
 4790     }
 4791     else {
 4792       die "Error: Answer |$ans_name| is not a hash reference\n".
 4793          $evaluated_answers{$ans_name} .
 4794          "This probably means that the answer evaluator for this answer\n" .
 4795          "is not working correctly.";
 4796       $problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}";
 4797     }
 4798   }
 4799   # Calculate score rounded to three places to avoid roundoff problems
 4800   $problem_result{score} = $total/$count if $count;
 4801   # increase recorded score if the current score is greater.
 4802   $problem_state{recorded_score} = $problem_result{score} if $problem_result{score} > $problem_state{recorded_score};
 4803 
 4804 
 4805   $problem_state{num_of_correct_ans}++ if $total == $count;
 4806   $problem_state{num_of_incorrect_ans}++ if $total < $count ;
 4807 
 4808   $problem_state{state_summary_msg} = '';  # an HTML formatted message printed at the bottom of the problem page
 4809 
 4810   warn "Error in grading this problem the total $total is larger than $count" if $total > $count;
 4811   (\%problem_result, \%problem_state);
 4812 }
 4813 
 4814 =head2 Utility subroutines
 4815 
 4816 =head4
 4817 
 4818   warn pretty_print( $rh_hash_input)
 4819 
 4820 This can be very useful for printing out messages about objects while debugging
 4821 
 4822 =cut
 4823 
 4824 sub pretty_print {
 4825     my $r_input = shift;
 4826     my $out = '';
 4827     if ( not ref($r_input) ) {
 4828       $out = $r_input;    # not a reference
 4829     } elsif ("$r_input" =~/hash/i) {  # this will pick up objects whose '$self' is hash and so works better than ref($r_iput).
 4830       local($^W) = 0;
 4831     $out .= "$r_input " ."<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
 4832     foreach my $key (lex_sort( keys %$r_input )) {
 4833       $out .= "<tr><TD> $key</TD><TD>=&gt;</td><td>&nbsp;".pretty_print($r_input->{$key}) . "</td></tr>";
 4834     }
 4835     $out .="</table>";
 4836   } elsif (ref($r_input) eq 'ARRAY' ) {
 4837     my @array = @$r_input;
 4838     $out .= "( " ;
 4839     while (@array) {
 4840       $out .= pretty_print(shift @array) . " , ";
 4841     }
 4842     $out .= " )";
 4843   } elsif (ref($r_input) eq 'CODE') {
 4844     $out = "$r_input";
 4845   } else {
 4846     $out = $r_input;
 4847   }
 4848     $out;
 4849 }
 4850 
 4851 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9