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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 50 - (download) (as text) (annotate)
Thu Jun 21 20:38:56 2001 UTC (18 years, 5 months ago) by chris
File size: 144653 byte(s)
Split evalutesToNumber into subroutine is_a_numeric_expression.  No changes in functionality.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9