[system] / trunk / webwork / system / courseScripts / PGanswermacros.pl Repository:
ViewVC logotype

View of /trunk/webwork/system/courseScripts/PGanswermacros.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 198 - (download) (as text) (annotate)
Mon Sep 10 17:05:20 2001 UTC (18 years, 5 months ago) by gage
File size: 143299 byte(s)
removed unneeded comments and cleaned up the code formatting.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9