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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1080 - (download) (as text) (annotate)
Mon Jun 9 17:49:36 2003 UTC (16 years, 7 months ago) by apizer
File size: 146962 byte(s)
remove unneccsary shebang lines

Arnie

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9