[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 40 - (download) (as text) (annotate)
Thu Jun 21 13:33:27 2001 UTC (18 years, 8 months ago) by gage
File size: 143666 byte(s)
Changed NUM_CMP so that the calculated versions of the student's answer
and the professor's remain in the answer hash to be displayed by
displayMacros.

There are now slight clues, when using num_str_cmp that the
instructor's answer is a string. I'm not sure anyone can find them
easily.  Further refinements should be able to remove them in any case.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9