[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 1690 - (download) (as text) (annotate)
Sun Dec 28 19:46:57 2003 UTC (15 years, 11 months ago) by gage
File size: 150880 byte(s)
Zeroed the variable storing the responses to questionnaires.  Should
fix the error on questionnaires revealed by the persistance of mod_perl
modules.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9