[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 1456 - (download) (as text) (annotate)
Thu Aug 14 16:10:01 2003 UTC (16 years, 5 months ago) by gage
File size: 150659 byte(s)
At least a temporary fix for mail_answers_to2

These evaluators are run in the grader and the
environment variables have disappeared??  I can't find
them at any rate.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9