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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1463 - (download) (as text) (annotate)
Fri Aug 15 16:51:09 2003 UTC (16 years, 6 months ago) by gage
File size: 150707 byte(s)
Changes to mail that make it work properly with ALLOW_MAIL_TO
--Mike

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9