[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 3346 - (download) (as text) (annotate)
Mon Jul 4 19:52:38 2005 UTC (14 years, 5 months ago) by gage
File size: 164882 byte(s)
Rewrote checkbox_cmp as an AnswerEvaluator

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9