[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 3324 - (download) (as text) (annotate)
Wed Jun 29 16:19:42 2005 UTC (14 years, 5 months ago) by gage
File size: 162042 byte(s)
Fixed bug in radio_cmp closing bug #258.  We now check to make
sure that only a single string is being passed and not an array.
(The latter occurs if checkboxes are used instead of radio buttons.)
The presence of two checked checkboxes triggers a warning.

    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 #   my @filters_to_use = @_;
 2086 #   my %known_filters = (
 2087 #               'remove_whitespace'   =>  &remove_whitespace,
 2088 #         'compress_whitespace' =>  &compress_whitespace,
 2089 #         'trim_whitespace'   =>  &trim_whitespace,
 2090 #         'ignore_case'     =>  &ignore_case,
 2091 #         'ignore_order'      =>  &ignore_order,
 2092 #   );
 2093 #
 2094 #   #test for unknown filters
 2095 #   foreach my $filter ( @filters_to_use ) {
 2096 #     #check that filter is known
 2097 #     die "Unknown string filter $filter (try checking the parameters to str_cmp() )"
 2098 #                 unless exists $known_filters{$filter};
 2099 #     $stringToFilter = $known_filters{$filter}($stringToFilter);  # apply filter.
 2100 #   }
 2101 #   foreach $filter (@filters_to_use) {
 2102 #     die "Unknown string filter $filter (try checking the parameters to str_cmp() )"
 2103 #                 unless exists $known_filters{$filter};
 2104 #   }
 2105 #
 2106 #   if( grep( /remove_whitespace/i, @filters_to_use ) ) {
 2107 #     $stringToFilter = remove_whitespace( $stringToFilter );
 2108 #   }
 2109 #   if( grep( /compress_whitespace/i, @filters_to_use ) ) {
 2110 #     $stringToFilter = compress_whitespace( $stringToFilter );
 2111 #   }
 2112 #   if( grep( /trim_whitespace/i, @filters_to_use ) ) {
 2113 #     $stringToFilter = trim_whitespace( $stringToFilter );
 2114 #   }
 2115 #   if( grep( /ignore_case/i, @filters_to_use ) ) {
 2116 #     $stringToFilter = ignore_case( $stringToFilter );
 2117 #   }
 2118 #   if( grep( /ignore_order/i, @filters_to_use ) ) {
 2119 #     $stringToFilter = ignore_order( $stringToFilter );
 2120 #   }
 2121 
 2122 #   return $stringToFilter;
 2123 # }
 2124 sub remove_whitespace {
 2125   my $rh_ans = shift;
 2126   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
 2127   $rh_ans->{_filter_name} = 'remove_whitespace';
 2128   $rh_ans->{student_ans} =~ s/\s+//g;   # remove all whitespace
 2129   $rh_ans->{correct_ans} =~ s/\s+//g;   # remove all whitespace
 2130   return $rh_ans;
 2131 }
 2132 
 2133 sub compress_whitespace {
 2134   my $rh_ans = shift;
 2135   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
 2136   $rh_ans->{_filter_name} = 'compress_whitespace';
 2137   $rh_ans->{student_ans} =~ s/^\s*//;   # remove initial whitespace
 2138   $rh_ans->{student_ans} =~ s/\s*$//;   # remove trailing whitespace
 2139   $rh_ans->{student_ans} =~ s/\s+/ /g;    # replace spaces by single space
 2140   $rh_ans->{correct_ans} =~ s/^\s*//;   # remove initial whitespace
 2141   $rh_ans->{correct_ans} =~ s/\s*$//;   # remove trailing whitespace
 2142   $rh_ans->{correct_ans} =~ s/\s+/ /g;    # replace spaces by single space
 2143 
 2144   return $rh_ans;
 2145 }
 2146 
 2147 sub trim_whitespace {
 2148   my $rh_ans = shift;
 2149   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
 2150   $rh_ans->{_filter_name} = 'trim_whitespace';
 2151   $rh_ans->{student_ans} =~ s/^\s*//;   # remove initial whitespace
 2152   $rh_ans->{student_ans} =~ s/\s*$//;   # remove trailing whitespace
 2153   $rh_ans->{correct_ans} =~ s/^\s*//;   # remove initial whitespace
 2154   $rh_ans->{correct_ans} =~ s/\s*$//;   # remove trailing whitespace
 2155 
 2156   return $rh_ans;
 2157 }
 2158 
 2159 sub ignore_case {
 2160   my $rh_ans = shift;
 2161   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
 2162   $rh_ans->{_filter_name} = 'ignore_case';
 2163   $rh_ans->{student_ans} =~ tr/a-z/A-Z/;
 2164   $rh_ans->{correct_ans} =~ tr/a-z/A-Z/;
 2165   return $rh_ans;
 2166 }
 2167 
 2168 sub ignore_order {
 2169   my $rh_ans = shift;
 2170   die "expected an answer hash" unless ref($rh_ans)=~/HASH/i;
 2171   $rh_ans->{student_ans} = join( "", lex_sort( split( /\s*/, $rh_ans->{student_ans} ) ) );
 2172   $rh_ans->{correct_ans} = join( "", lex_sort( split( /\s*/, $rh_ans->{correct_ans} ) ) );
 2173 
 2174   return $rh_ans;
 2175 }
 2176 # sub remove_whitespace {
 2177 #   my $filteredAnswer = shift;
 2178 #
 2179 #   $filteredAnswer =~ s/\s+//g;    # remove all whitespace
 2180 #
 2181 #   return $filteredAnswer;
 2182 # }
 2183 #
 2184 # sub compress_whitespace {
 2185 #   my $filteredAnswer = shift;
 2186 #
 2187 #   $filteredAnswer =~ s/^\s*//;    # remove initial whitespace
 2188 #   $filteredAnswer =~ s/\s*$//;    # remove trailing whitespace
 2189 #   $filteredAnswer =~ s/\s+/ /g;   # replace spaces by single space
 2190 #
 2191 #   return $filteredAnswer;
 2192 # }
 2193 #
 2194 # sub trim_whitespace {
 2195 #   my $filteredAnswer = shift;
 2196 #
 2197 #   $filteredAnswer =~ s/^\s*//;    # remove initial whitespace
 2198 #   $filteredAnswer =~ s/\s*$//;    # remove trailing whitespace
 2199 #
 2200 #   return $filteredAnswer;
 2201 # }
 2202 #
 2203 # sub ignore_case {
 2204 #   my $filteredAnswer = shift;
 2205 #   #warn "filtered answer is ", $filteredAnswer;
 2206 #   #$filteredAnswer = uc $filteredAnswer;  # this didn't work on webwork xmlrpc, but does elsewhere ????
 2207 #   $filteredAnswer =~ tr/a-z/A-Z/;
 2208 #
 2209 #   return $filteredAnswer;
 2210 # }
 2211 #
 2212 # sub ignore_order {
 2213 #   my $filteredAnswer = shift;
 2214 #
 2215 #   $filteredAnswer = join( "", lex_sort( split( /\s*/, $filteredAnswer ) ) );
 2216 #
 2217 #   return $filteredAnswer;
 2218 # }
 2219 ################################
 2220 ## END STRING ANSWER FILTERS
 2221 
 2222 
 2223 =head3 str_cmp()
 2224 
 2225 Compares a string or a list of strings, using a named hash of options to set
 2226 parameters. This can make for more readable code than using the "mode"_str_cmp()
 2227 style, but some people find one or the other easier to remember.
 2228 
 2229 ANS( str_cmp( answer or answer_array_ref, options_hash ) );
 2230 
 2231   1. the correct answer or a reference to an array of answers
 2232   2. either a list of filters, or:
 2233      a hash consisting of
 2234     filters - a reference to an array of filters
 2235 
 2236   Returns an answer evaluator, or (if given a reference to an array of answers),
 2237   a list of answer evaluators
 2238 
 2239 FILTERS:
 2240 
 2241   remove_whitespace --  removes all whitespace
 2242   compress_whitespace --  removes whitespace from the beginning and end of the string,
 2243               and treats one or more whitespace characters in a row as a
 2244               single space (true by default)
 2245   trim_whitespace   --  removes whitespace from the beginning and end of the string
 2246   ignore_case   --  ignores the case of the letters (true by default)
 2247   ignore_order    --  ignores the order in which letters are entered
 2248 
 2249 EXAMPLES:
 2250 
 2251   str_cmp( "Hello" )  --  matches "Hello", "  hello" (same as std_str_cmp() )
 2252   str_cmp( ["Hello", "Goodbye"] ) --  same as std_str_cmp_list()
 2253   str_cmp( " hello ", trim_whitespace ) --  matches "hello", " hello  "
 2254   str_cmp( "ABC", filters => 'ignore_order' ) --  matches "ACB", "A B C", but not "abc"
 2255   str_cmp( "D E F", remove_whitespace, ignore_case )  --  matches "def" and "d e f" but not "fed"
 2256 
 2257 
 2258 =cut
 2259 
 2260 sub str_cmp {
 2261   my $correctAnswer = shift @_;
 2262   $correctAnswer = '' unless defined($correctAnswer);
 2263   my @options = @_;
 2264   my %options = ();
 2265   # backward compatibility
 2266   if (grep /filters|debug|filter/, @options) { # see whether we have hash keys in the input.
 2267     %options = @options;
 2268   } elsif (@options) {     # all options are names of filters.
 2269     $options{filters} = [@options];
 2270   }
 2271   my $ra_filters;
 2272   assign_option_aliases( \%options,
 2273         'filter'               =>  'filters',
 2274      );
 2275     set_default_options(  \%options,
 2276           'filters'               =>  [qw(trim_whitespace compress_whitespace ignore_case)],
 2277             'debug'         =>  0,
 2278             'type'                  =>  'str_cmp',
 2279     );
 2280   $options{filters} = (ref($options{filters}))?$options{filters}:[$options{filters}];
 2281   # make sure this is a reference to an array.
 2282   # error-checking for filters occurs in the filters() subroutine
 2283 #   if( not defined( $options[0] ) ) {    # used with no filters as alias for std_str_cmp()
 2284 #     @options = ( 'compress_whitespace', 'ignore_case' );
 2285 #   }
 2286 #
 2287 #   if( $options[0] eq 'filters' ) {    # using filters => [f1, f2, ...] notation
 2288 #     $ra_filters = $options[1];
 2289 #   }
 2290 #   else {            # using a list of filters
 2291 #     $ra_filters = \@options;
 2292 #   }
 2293 
 2294   # thread over lists
 2295   my @ans_list = ();
 2296 
 2297   if ( ref($correctAnswer) eq 'ARRAY' ) {
 2298     @ans_list = @{$correctAnswer};
 2299   }
 2300   else {
 2301     push( @ans_list, $correctAnswer );
 2302   }
 2303 
 2304   # final_answer;
 2305   my @output_list = ();
 2306 
 2307   foreach my $ans (@ans_list) {
 2308     push(@output_list, STR_CMP(
 2309                   'correct_ans' =>  $ans,
 2310             'filters'   =>  $options{filters},
 2311             'type'      =>  $options{type},
 2312             'debug'         =>  $options{debug},
 2313          )
 2314     );
 2315   }
 2316 
 2317   return (wantarray) ? @output_list : $output_list[0] ;
 2318 }
 2319 
 2320 =head3 "mode"_str_cmp functions
 2321 
 2322 The functions of the the form "mode"_str_cmp() use different functions to
 2323 specify which filters to apply. They take no options except the correct
 2324 string. There are also versions which accept a list of strings.
 2325 
 2326  std_str_cmp( $correctString )
 2327  std_str_cmp_list( @correctStringList )
 2328   Filters: compress_whitespace, ignore_case
 2329 
 2330  std_cs_str_cmp( $correctString )
 2331  std_cs_str_cmp_list( @correctStringList )
 2332   Filters: compress_whitespace
 2333 
 2334  strict_str_cmp( $correctString )
 2335  strict_str_cmp_list( @correctStringList )
 2336   Filters: trim_whitespace
 2337 
 2338  unordered_str_cmp( $correctString )
 2339  unordered_str_cmp_list( @correctStringList )
 2340   Filters: ignore_order, ignore_case
 2341 
 2342  unordered_cs_str_cmp( $correctString )
 2343  unordered_cs_str_cmp_list( @correctStringList )
 2344   Filters: ignore_order
 2345 
 2346  ordered_str_cmp( $correctString )
 2347  ordered_str_cmp_list( @correctStringList )
 2348   Filters: remove_whitespace, ignore_case
 2349 
 2350  ordered_cs_str_cmp( $correctString )
 2351  ordered_cs_str_cmp_list( @correctStringList )
 2352   Filters: remove_whitespace
 2353 
 2354 Examples
 2355 
 2356   ANS( std_str_cmp( "W. Mozart" ) ) --  Accepts "W. Mozart", "W. MOZarT",
 2357     and so forth. Case insensitive. All internal spaces treated
 2358     as single spaces.
 2359   ANS( std_cs_str_cmp( "Mozart" ) ) --  Rejects "mozart". Same as
 2360     std_str_cmp() but case sensitive.
 2361   ANS( strict_str_cmp( "W. Mozart" ) )  --  Accepts only the exact string.
 2362   ANS( unordered_str_cmp( "ABC" ) ) --  Accepts "a c B", "CBA" and so forth.
 2363     Unordered, case insensitive, spaces ignored.
 2364   ANS( unordered_cs_str_cmp( "ABC" ) )  --  Rejects "abc". Same as
 2365     unordered_str_cmp() but case sensitive.
 2366   ANS( ordered_str_cmp( "ABC" ) ) --  Accepts "a b C", "A B C" and so forth.
 2367     Ordered, case insensitive, spaces ignored.
 2368   ANS( ordered_cs_str_cmp( "ABC" ) )  --  Rejects "abc", accepts "A BC" and
 2369     so forth. Same as ordered_str_cmp() but case sensitive.
 2370 
 2371 =cut
 2372 
 2373 sub std_str_cmp {         # compare strings
 2374   my $correctAnswer = shift @_;
 2375   my @filters = ( 'compress_whitespace', 'ignore_case' );
 2376   my $type = 'std_str_cmp';
 2377   STR_CMP('correct_ans' =>  $correctAnswer,
 2378       'filters' =>  \@filters,
 2379       'type'    =>  $type
 2380   );
 2381 }
 2382 
 2383 sub std_str_cmp_list {        # alias for std_str_cmp
 2384   my @answerList = @_;
 2385   my @output;
 2386   while (@answerList) {
 2387     push( @output, std_str_cmp(shift @answerList) );
 2388   }
 2389   @output;
 2390 }
 2391 
 2392 sub std_cs_str_cmp {        # compare strings case sensitive
 2393   my $correctAnswer = shift @_;
 2394   my @filters = ( 'compress_whitespace' );
 2395   my $type = 'std_cs_str_cmp';
 2396   STR_CMP(  'correct_ans' =>  $correctAnswer,
 2397       'filters' =>  \@filters,
 2398       'type'    =>  $type
 2399   );
 2400 }
 2401 
 2402 sub std_cs_str_cmp_list {     # alias for std_cs_str_cmp
 2403   my @answerList = @_;
 2404   my @output;
 2405   while (@answerList) {
 2406     push( @output, std_cs_str_cmp(shift @answerList) );
 2407   }
 2408   @output;
 2409 }
 2410 
 2411 sub strict_str_cmp {        # strict string compare
 2412   my $correctAnswer = shift @_;
 2413   my @filters = ( 'trim_whitespace' );
 2414   my $type = 'strict_str_cmp';
 2415   STR_CMP(  'correct_ans' =>  $correctAnswer,
 2416       'filters' =>  \@filters,
 2417       'type'    =>  $type
 2418   );
 2419 }
 2420 
 2421 sub strict_str_cmp_list {     # alias for strict_str_cmp
 2422   my @answerList = @_;
 2423   my @output;
 2424   while (@answerList) {
 2425     push( @output, strict_str_cmp(shift @answerList) );
 2426   }
 2427   @output;
 2428 }
 2429 
 2430 sub unordered_str_cmp {       # unordered, case insensitive, spaces ignored
 2431   my $correctAnswer = shift @_;
 2432   my @filters = ( 'ignore_order', 'ignore_case' );
 2433   my $type = 'unordered_str_cmp';
 2434   STR_CMP(  'correct_ans'   =>  $correctAnswer,
 2435       'filters'   =>  \@filters,
 2436       'type'      =>  $type
 2437   );
 2438 }
 2439 
 2440 sub unordered_str_cmp_list {    # alias for unordered_str_cmp
 2441   my @answerList = @_;
 2442   my @output;
 2443   while (@answerList) {
 2444     push( @output, unordered_str_cmp(shift @answerList) );
 2445   }
 2446   @output;
 2447 }
 2448 
 2449 sub unordered_cs_str_cmp {      # unordered, case sensitive, spaces ignored
 2450   my $correctAnswer = shift @_;
 2451   my @filters = ( 'ignore_order' );
 2452   my $type = 'unordered_cs_str_cmp';
 2453   STR_CMP(  'correct_ans'   =>  $correctAnswer,
 2454       'filters'   =>  \@filters,
 2455       'type'      =>  $type
 2456   );
 2457 }
 2458 
 2459 sub unordered_cs_str_cmp_list {   # alias for unordered_cs_str_cmp
 2460   my @answerList = @_;
 2461   my @output;
 2462   while (@answerList) {
 2463     push( @output, unordered_cs_str_cmp(shift @answerList) );
 2464   }
 2465   @output;
 2466 }
 2467 
 2468 sub ordered_str_cmp {       # ordered, case insensitive, spaces ignored
 2469   my $correctAnswer = shift @_;
 2470   my @filters = ( 'remove_whitespace', 'ignore_case' );
 2471   my $type = 'ordered_str_cmp';
 2472   STR_CMP(  'correct_ans' =>  $correctAnswer,
 2473       'filters' =>  \@filters,
 2474       'type'    =>  $type
 2475   );
 2476 }
 2477 
 2478 sub ordered_str_cmp_list {      # alias for ordered_str_cmp
 2479   my @answerList = @_;
 2480   my @output;
 2481   while (@answerList) {
 2482     push( @output, ordered_str_cmp(shift @answerList) );
 2483   }
 2484   @output;
 2485 }
 2486 
 2487 sub ordered_cs_str_cmp {      # ordered,  case sensitive, spaces ignored
 2488   my $correctAnswer = shift @_;
 2489   my @filters = ( 'remove_whitespace' );
 2490   my $type = 'ordered_cs_str_cmp';
 2491   STR_CMP(  'correct_ans' =>  $correctAnswer,
 2492       'filters' =>  \@filters,
 2493       'type'    =>  $type
 2494   );
 2495 }
 2496 
 2497 sub ordered_cs_str_cmp_list {   # alias for ordered_cs_str_cmp
 2498   my @answerList = @_;
 2499   my @output;
 2500   while (@answerList) {
 2501     push( @output, ordered_cs_str_cmp(shift @answerList) );
 2502   }
 2503   @output;
 2504 }
 2505 
 2506 
 2507 ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
 2508 ##
 2509 ## IN:  a hashtable with the following entries (error-checking to be added later?):
 2510 ##      correctAnswer --  the correct answer, before filtering
 2511 ##      filters     --  reference to an array containing the filters to be applied
 2512 ##      type      --  a string containing the type of answer evaluator in use
 2513 ## OUT: a reference to an answer evaluator subroutine
 2514 sub STR_CMP {
 2515   my %str_params = @_;
 2516   #my $correctAnswer =  str_filters( $str_params{'correct_ans'}, @{$str_params{'filters'}} );
 2517   my $answer_evaluator = new AnswerEvaluator;
 2518   $answer_evaluator->{debug} = $str_params{debug};
 2519   $answer_evaluator->ans_hash(
 2520     correct_ans       => $str_params{correct_ans}||'',
 2521     type              => $str_params{type}||'str_cmp',
 2522     score             => 0,
 2523 
 2524     );
 2525   my %known_filters = (
 2526               'remove_whitespace'   =>  \&remove_whitespace,
 2527         'compress_whitespace' =>  \&compress_whitespace,
 2528         'trim_whitespace'   =>  \&trim_whitespace,
 2529         'ignore_case'     =>  \&ignore_case,
 2530         'ignore_order'      =>  \&ignore_order,
 2531   );
 2532 
 2533   foreach my $filter ( @{$str_params{filters}} ) {
 2534     #check that filter is known
 2535     die "Unknown string filter |$filter|. Known filters are ".
 2536          join(" ", keys %known_filters) .
 2537          "(try checking the parameters to str_cmp() )"
 2538                 unless exists $known_filters{$filter};
 2539     # install related pre_filter
 2540     $answer_evaluator->install_pre_filter( $known_filters{$filter} );
 2541   }
 2542   $answer_evaluator->install_evaluator(sub {
 2543       my $rh_ans = shift;
 2544       $rh_ans->{_filter_name} = "Evaluator: Compare string answers with eq";
 2545       $rh_ans->{score} = ($rh_ans->{student_ans} eq $rh_ans->{correct_ans})?1:0  ;
 2546       $rh_ans;
 2547   });
 2548   $answer_evaluator->install_post_filter(sub {
 2549     my $rh_hash = shift;
 2550     $rh_hash->{_filter_name} = "clean up preview strings";
 2551     $rh_hash->{'preview_text_string'} = $rh_hash->{student_ans};
 2552     $rh_hash->{'preview_latex_string'} = "\\text{ ".$rh_hash->{student_ans}." }";
 2553     $rh_hash;
 2554   });
 2555   return $answer_evaluator;
 2556 }
 2557 
 2558 # sub STR_CMP_old {
 2559 #   my %str_params = @_;
 2560 #   $str_params{'correct_ans'} = str_filters( $str_params{'correct_ans'}, @{$str_params{'filters'}} );
 2561 #   my $answer_evaluator = sub {
 2562 #     my $in = shift @_;
 2563 #     $in = '' unless defined $in;
 2564 #     my $original_student_ans = $in;
 2565 #     $in = str_filters( $in, @{$str_params{'filters'}} );
 2566 #     my $correctQ = ( $in eq $str_params{'correct_ans'} ) ? 1: 0;
 2567 #     my $ans_hash = new AnswerHash(    'score'       =>  $correctQ,
 2568 #               'correct_ans'     =>  $str_params{'correctAnswer'},
 2569 #               'student_ans'     =>  $in,
 2570 #               'ans_message'     =>  '',
 2571 #               'type'        =>  $str_params{'type'},
 2572 #               'preview_text_string'   =>  $in,
 2573 #               'preview_latex_string'    =>  $in,
 2574 #               'original_student_ans'    =>  $original_student_ans
 2575 #     );
 2576 #     return $ans_hash;
 2577 #   };
 2578 #   return $answer_evaluator;
 2579 # }
 2580 
 2581 ##########################################################################
 2582 ##########################################################################
 2583 ## Miscellaneous answer evaluators
 2584 
 2585 =head2 Miscellaneous Answer Evaluators (Checkboxes and Radio Buttons)
 2586 
 2587 These evaluators do not fit any of the other categories.
 2588 
 2589 checkbox_cmp( $correctAnswer )
 2590 
 2591   $correctAnswer  --  a string containing the names of the correct boxes,
 2592             e.g. "ACD". Note that this means that individual
 2593             checkbox names can only be one character. Internally,
 2594             this is largely the same as unordered_cs_str_cmp().
 2595 
 2596 radio_cmp( $correctAnswer )
 2597 
 2598   $correctAnswer  --  a string containing the name of the correct radio
 2599             button, e.g. "Choice1". This is case sensitive and
 2600             whitespace sensitive, so the correct answer must match
 2601             the name of the radio button exactly.
 2602 
 2603 =cut
 2604 
 2605 # added 6/14/2000 by David Etlinger
 2606 # because of the conversion of the answer
 2607 # string to an array, I thought it better not
 2608 # to force STR_CMP() to work with this
 2609 
 2610 #added 2/26/2003 by Mike Gage
 2611 # handled the case where multiple answers are passed as an array reference
 2612 # rather than as a \0 delimited string.
 2613 sub checkbox_cmp {
 2614   my  $correctAnswer = shift @_;
 2615   $correctAnswer = str_filters( $correctAnswer, 'ignore_order' );
 2616 
 2617   my  $answer_evaluator = sub {
 2618     my $in = shift @_;
 2619     $in = '' unless defined $in;      #in case no boxes checked
 2620                         # multiple answers could come in two forms
 2621                         # either a \0 delimited string or
 2622                         # an array reference.  We handle both.
 2623         if (ref($in) eq 'ARRAY')   {
 2624           $in = join("",@{$in});              # convert array to single no-delimiter string
 2625         } else {
 2626       my @temp = split( "\0", $in );    #convert "\0"-delimited string to array...
 2627       $in = join( "", @temp );      #and then to a single no-delimiter string
 2628     }
 2629     my $original_student_ans = $in;     #well, almost original
 2630     $in = str_filters( $in, 'ignore_order' );
 2631 
 2632     my $correctQ = ($in eq $correctAnswer) ? 1: 0;
 2633 
 2634     my $ans_hash = new AnswerHash(
 2635               'score'     =>  $correctQ,
 2636               'correct_ans'   =>  "$correctAnswer",
 2637               'student_ans'   =>  $in,
 2638               'ans_message'   =>  "",
 2639               'type'      =>  "checkbox_cmp",
 2640               'preview_text_string' =>  $in,
 2641               'preview_latex_string'  =>  $in,
 2642               'original_student_ans'  =>  $original_student_ans
 2643     );
 2644     return $ans_hash;
 2645 
 2646   };
 2647   return $answer_evaluator;
 2648 }
 2649 
 2650 #added 6/28/2000 by David Etlinger
 2651 #exactly the same as strict_str_cmp,
 2652 #but more intuitive to the user
 2653 
 2654 # check that answer is really a string and not an array
 2655 # also use ordinary string compare
 2656 sub radio_cmp {
 2657   #strict_str_cmp( @_ );
 2658   my $response = shift;  # there should be only one item.
 2659   warn "Multiple choices -- this should not happen with radio buttons. Have
 2660   you used checkboxes perhaps?" if ref($response);
 2661   str_cmp($response);
 2662 }
 2663 
 2664 ##########################################################################
 2665 ##########################################################################
 2666 ## Text and e-mail routines
 2667 
 2668 sub store_ans_at {
 2669   my $answerStringRef = shift;
 2670   my %options = @_;
 2671   my $ans_eval= '';
 2672   if ( ref($answerStringRef) eq 'SCALAR' ) {
 2673     $ans_eval= sub {
 2674       my $text = shift;
 2675       $text = '' unless defined($text);
 2676       $$answerStringRef = $$answerStringRef  . $text;
 2677       my $ans_hash = new AnswerHash(
 2678                'score'      =>  1,
 2679                'correct_ans'      =>  '',
 2680                'student_ans'      =>  $text,
 2681                'ans_message'      =>  '',
 2682                'type'       =>  'store_ans_at',
 2683                'original_student_ans'   =>  $text,
 2684                'preview_text_string'    =>  ''
 2685       );
 2686 
 2687     return $ans_hash;
 2688     };
 2689   }
 2690   else {
 2691     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";
 2692   }
 2693 
 2694   return $ans_eval;
 2695 }
 2696 
 2697 #### subroutines used in producing a questionnaire
 2698 #### these are at least good models for other answers of this type
 2699 
 2700 # my $QUESTIONNAIRE_ANSWERS=''; #  stores the answers until it is time to send them
 2701        #  this must be initialized before the answer evaluators are run
 2702        #  but that happens long after all of the text in the problem is
 2703        #  evaluated.
 2704 # this is a utility script for cleaning up the answer output for display in
 2705 #the answers.
 2706 
 2707 sub DUMMY_ANSWER {
 2708   my $num = shift;
 2709   qq{<INPUT TYPE="HIDDEN" NAME="answer$num" VALUE="">}
 2710 }
 2711 
 2712 sub escapeHTML {
 2713   my $string = shift;
 2714   $string =~ s/\n/$BR/ge;
 2715   $string;
 2716 }
 2717 
 2718 # these next three subroutines show how to modify the "store_ans_at()" answer
 2719 # evaluator to add extra information before storing the info
 2720 # They provide a good model for how to tweak answer evaluators in special cases.
 2721 
 2722 sub anstext {
 2723   my $num = shift;
 2724   my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
 2725   my $psvnNumber  = PG_restricted_eval(q!$main::psvnNumber!);
 2726   my $probNum     = PG_restricted_eval(q!$main::probNum!);
 2727   my $ans_eval    = sub {
 2728          my $text = shift;
 2729          $text = '' unless defined($text);
 2730          my $new_text = "\n$psvnNumber-Problem-$probNum-Question-$num:\n $text "; # modify entered text
 2731          my $out = &$ans_eval_template($new_text);       # standard evaluator
 2732          #warn "$QUESTIONNAIRE_ANSWERS";
 2733          $out->{student_ans} = escapeHTML($text);  #  restore original entered text
 2734          $out->{correct_ans} = "Question  $num answered";
 2735          $out->{original_student_ans} = escapeHTML($text);
 2736          $out;
 2737     };
 2738    $ans_eval;
 2739 }
 2740 
 2741 
 2742 sub ansradio {
 2743   my $num = shift;
 2744   my $psvnNumber  = PG_restricted_eval(q!$main::psvnNumber!);
 2745   my $probNum  = PG_restricted_eval(q!$main::probNum!);
 2746 
 2747   my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
 2748   my $ans_eval = sub {
 2749          my $text = shift;
 2750          $text = '' unless defined($text);
 2751          my $new_text = "\n$psvnNumber-Problem-$probNum-RADIO-$num:\n $text ";       # modify entered text
 2752          my $out = $ans_eval_template->($new_text);       # standard evaluator
 2753          $out->{student_ans} =escapeHTML($text);  # restore original entered text
 2754          $out->{original_student_ans} = escapeHTML($text);
 2755          $out;
 2756    };
 2757 
 2758    $ans_eval;
 2759 }
 2760 
 2761 sub anstext_non_anonymous {
 2762   ## this emails identifying information
 2763   my $num          = shift;
 2764     my $psvnNumber   = PG_restricted_eval(q!$main::psvnNumber!);
 2765   my $probNum      = PG_restricted_eval(q!$main::probNum!);
 2766     my $studentLogin = PG_restricted_eval(q!$main::studentLogin!);
 2767   my $studentID    = PG_restricted_eval(q!$main::studentID!);
 2768     my $studentName  = PG_restricted_eval(q!$main::studentName!);
 2769 
 2770 
 2771   my $ans_eval_template = store_ans_at(\$QUESTIONNAIRE_ANSWERS);
 2772   my $ans_eval = sub {
 2773          my $text = shift;
 2774          $text = '' unless defined($text);
 2775          my $new_text = "\n$psvnNumber-Problem-$probNum-Question-$num:\n$studentLogin $main::studentID $studentName\n$text "; # modify entered text
 2776          my $out = &$ans_eval_template($new_text);       # standard evaluator
 2777          #warn "$QUESTIONNAIRE_ANSWERS";
 2778          $out->{student_ans} = escapeHTML($text);  #  restore original entered text
 2779          $out->{correct_ans} = "Question  $num answered";
 2780          $out->{original_student_ans} = escapeHTML($text);
 2781          $out;
 2782     };
 2783    $ans_eval;
 2784 }
 2785 
 2786 
 2787 #  This is another example of how to modify an  answer evaluator to obtain
 2788 #  the desired behavior in a special case.  Here the object is to have
 2789 #  have the last answer trigger the send_mail_to subroutine which mails
 2790 #  all of the answers to the designated address.
 2791 #  (This address must be listed in PG_environment{'ALLOW_MAIL_TO'} or an error occurs.)
 2792 
 2793 # Fix me?? why is the body hard wired to the string QUESTIONNAIRE_ANSWERS?
 2794 
 2795 sub mail_answers_to {  #accepts the last answer and mails off the result
 2796   my $user_address = shift;
 2797   my $ans_eval = sub {
 2798 
 2799     # then mail out all of the answers, including this last one.
 2800 
 2801     send_mail_to( $user_address,
 2802           'subject'       =>  "$main::courseName WeBWorK questionnaire",
 2803           'body'          =>  $QUESTIONNAIRE_ANSWERS,
 2804           'ALLOW_MAIL_TO'   =>  $rh_envir->{ALLOW_MAIL_TO}
 2805     );
 2806 
 2807     my $ans_hash = new AnswerHash(  'score'   =>  1,
 2808             'correct_ans' =>  '',
 2809             'student_ans' =>  'Answer recorded',
 2810             'ans_message' =>  '',
 2811             'type'    =>  'send_mail_to',
 2812     );
 2813 
 2814     return $ans_hash;
 2815   };
 2816 
 2817   return $ans_eval;
 2818 }
 2819 
 2820 sub save_answer_to_file {  #accepts the last answer and mails off the result
 2821   my $fileID = shift;
 2822   my $ans_eval = new AnswerEvaluator;
 2823   $ans_eval->install_evaluator(
 2824       sub {
 2825          my $rh_ans = shift;
 2826 
 2827              unless ( defined( $rh_ans->{student_ans} ) ) {
 2828               $rh_ans->throw_error("save_answers_to_file","{student_ans} field not defined");
 2829               return $rh_ans;
 2830             }
 2831 
 2832         my $error;
 2833         my $string = '';
 2834         $string = qq![[<$main::studentLogin> $main::studentName /!. time() . qq!/]]\n!.
 2835           $rh_ans->{student_ans}. qq!\n\n============================\n\n!;
 2836 
 2837         if ($error = AnswerIO::saveAnswerToFile('preflight',$string) ) {
 2838           $rh_ans->throw_error("save_answers_to_file","Error:  $error");
 2839         } else {
 2840           $rh_ans->{'student_ans'} = 'Answer saved';
 2841           $rh_ans->{'score'} = 1;
 2842         }
 2843         $rh_ans;
 2844       }
 2845   );
 2846 
 2847   return $ans_eval;
 2848 }
 2849 
 2850 sub mail_answers_to2 {  #accepts the last answer and mails off the result
 2851   my $user_address         = shift;
 2852   my $subject              = shift;
 2853   my $ra_allow_mail_to     = shift;
 2854   $subject = "$main::courseName WeBWorK questionnaire" unless defined $subject;
 2855   send_mail_to($user_address,
 2856       'subject'     => $subject,
 2857       'body'        => $QUESTIONNAIRE_ANSWERS,
 2858       'ALLOW_MAIL_TO'   => $rh_envir->{ALLOW_MAIL_TO},
 2859   );
 2860 }
 2861 
 2862 ##########################################################################
 2863 ##########################################################################
 2864 
 2865 
 2866 ###########################################################################
 2867 ### THE FOLLOWING ARE LOCAL SUBROUTINES THAT ARE MEANT TO BE CALLED ONLY FROM THIS SCRIPT.
 2868 
 2869 ## Internal routine that converts variables into the standard array format
 2870 ##
 2871 ## IN:  one of the following:
 2872 ##      an undefined value (i.e., no variable was specified)
 2873 ##      a reference to an array of variable names -- [var1, var2]
 2874 ##      a number (the number of variables desired) -- 3
 2875 ##      one or more variable names -- (var1, var2)
 2876 ## OUT: an array of variable names
 2877 
 2878 sub get_var_array {
 2879   my $in = shift @_;
 2880   my @out;
 2881 
 2882   if( not defined($in) ) {      #if nothing defined, build default array and return
 2883     @out = ( $functVarDefault );
 2884     return @out;
 2885   }
 2886   elsif( ref( $in ) eq 'ARRAY' ) {  #if given an array ref, dereference and return
 2887     return @{$in};
 2888   }
 2889   elsif( $in =~ /^\d+/ ) {      #if given a number, set up the array and return
 2890     if( $in == 1 ) {
 2891       $out[0] = 'x';
 2892     }
 2893     elsif( $in == 2 ) {
 2894       $out[0] = 'x';
 2895       $out[1] = 'y';
 2896     }
 2897     elsif( $in == 3 ) {
 2898       $out[0] = 'x';
 2899       $out[1] = 'y';
 2900       $out[2] = 'z';
 2901     }
 2902     else {  #default to the x_1, x_2, ... convention
 2903       my ($i, $tag);
 2904       for( $i=0; $i < $in; $i++ ) {
 2905               ## akp the above seems to be off by one 1/4/00
 2906         $tag = $i + 1;                            ## akp 1/4/00
 2907         $out[$i] = "${functVarDefault}_" . $tag;              ## akp 1/4/00
 2908       }
 2909     }
 2910     return @out;
 2911   }
 2912   else {            #if given one or more names, return as an array
 2913     unshift( @_, $in );
 2914     return @_;
 2915   }
 2916 }
 2917 
 2918 ## Internal routine that converts limits into the standard array of arrays format
 2919 ##  Some of the cases are probably unneccessary, but better safe than sorry
 2920 ##
 2921 ## IN:  one of the following:
 2922 ##      an undefined value (i.e., no limits were specified)
 2923 ##      a reference to an array of arrays of limits -- [[llim,ulim], [llim,ulim]]
 2924 ##      a reference to an array of limits -- [llim, ulim]
 2925 ##      an array of array references -- ([llim,ulim], [llim,ulim])
 2926 ##      an array of limits -- (llim,ulim)
 2927 ## OUT: an array of array references -- ([llim,ulim], [llim,ulim]) or ([llim,ulim])
 2928 
 2929 sub get_limits_array {
 2930   my $in = shift @_;
 2931   my @out;
 2932 
 2933   if( not defined($in) ) {        #if nothing defined, build default array and return
 2934     @out = ( [$functLLimitDefault, $functULimitDefault] );
 2935     return @out;
 2936   }
 2937   elsif( ref($in) eq 'ARRAY' ) {        #$in is either ref to array, or ref to array of refs
 2938     my @deref = @{$in};
 2939 
 2940     if( ref( $in->[0] ) eq 'ARRAY' ) {    #$in is a ref to an array of array refs
 2941       return @deref;
 2942     }
 2943     else {            #$in was just a ref to an array of numbers
 2944       @out = ( $in );
 2945       return @out;
 2946     }
 2947   }
 2948   else {              #$in was an array of references or numbers
 2949     unshift( @_, $in );
 2950 
 2951     if( ref($_[0]) eq 'ARRAY' ) {     #$in was an array of references, so just return it
 2952       return @_;
 2953     }
 2954     else {            #$in was an array of numbers
 2955       @out = ( \@_ );
 2956       return @out;
 2957     }
 2958   }
 2959 }
 2960 
 2961 #sub check_option_list {
 2962 # my $size = scalar(@_);
 2963 # if( ( $size % 2 ) != 0 ) {
 2964 #   warn "ERROR in answer evaluator generator:\n" .
 2965 #     "Usage: <CODE>str_cmp([\$ans1,  \$ans2],%options)</CODE>
 2966 #     or <CODE> num_cmp([\$num1, \$num2], %options)</CODE><BR>
 2967 #     A list of inputs must be inclosed in square brackets <CODE>[\$ans1, \$ans2]</CODE>";
 2968 # }
 2969 #}
 2970 
 2971 # simple subroutine to display an error message when
 2972 # function compares are called with invalid parameters
 2973 sub function_invalid_params {
 2974   my $correctEqn = shift @_;
 2975   my $error_response = sub {
 2976     my $PGanswerMessage = "Tell your professor that there is an error with the parameters " .
 2977             "to the function answer evaluator";
 2978     return ( 0, $correctEqn, "", $PGanswerMessage );
 2979   };
 2980   return $error_response;
 2981 }
 2982 
 2983 sub clean_up_error_msg {
 2984   my $msg = $_[0];
 2985   $msg =~ s/^\[[^\]]*\][^:]*://;
 2986   $msg =~ s/Unquoted string//g;
 2987   $msg =~ s/may\s+clash.*/does not make sense here/;
 2988   $msg =~ s/\sat.*line [\d]*//g;
 2989   $msg = 'Error: '. $msg;
 2990 
 2991   return $msg;
 2992 }
 2993 
 2994 #formats the student and correct answer as specified
 2995 #format must be of a form suitable for sprintf (e.g. '%0.5g'),
 2996 #with the exception that a '#' at the end of the string
 2997 #will cause trailing zeros in the decimal part to be removed
 2998 sub prfmt {
 2999   my($number,$format) = @_;  # attention, the order of format and number are reversed
 3000   my $out;
 3001   if ($format) {
 3002     warn "Incorrect format used: $format. <BR> Format should look something like %4.5g<BR>"
 3003                 unless $format =~ /^\s*%\d*\.?\d*\w#?\s*$/;
 3004 
 3005     if( $format =~ s/#\s*$// ) {  # remove trailing zeros in the decimal
 3006       $out = sprintf( $format, $number );
 3007       $out =~ s/(\.\d*?)0+$/$1/;
 3008       $out =~ s/\.$//;      # in case all decimal digits were zero, remove the decimal
 3009       $out =~ s/e/E/g;        # only use capital E's for exponents. Little e is for 2.71828...
 3010     } elsif (is_a_number($number) ){
 3011       $out = sprintf( $format, $number );
 3012       $out =~ s/e/E/g;        # only use capital E's for exponents. Little e is for 2.71828...
 3013     } else { # number is probably a string representing an arithmetic expression
 3014       $out = $number;
 3015     }
 3016 
 3017   } else {
 3018     if (is_a_number($number)) {# only use capital E's for exponents. Little e is for 2.71828...
 3019       $out = $number;
 3020       $out =~ s/e/E/g;
 3021     } else { # number is probably a string representing an arithmetic expression
 3022       $out = $number;
 3023     }
 3024   }
 3025   return $out;
 3026 }
 3027 #########################################################################
 3028 # Filters for answer evaluators
 3029 #########################################################################
 3030 
 3031 =head2 Filters
 3032 
 3033 =pod
 3034 
 3035 A filter is a short subroutine with the following structure.  It accepts an
 3036 AnswerHash, followed by a hash of options.  It returns an AnswerHash
 3037 
 3038   $ans_hash = filter($ans_hash, %options);
 3039 
 3040 See the AnswerHash.pm file for a list of entries which can be expected to be found
 3041 in an AnswerHash, such as 'student_ans', 'score' and so forth.  Other entries
 3042 may be present for specialized answer evaluators.
 3043 
 3044 The hope is that a well designed set of filters can easily be combined to form
 3045 a new answer_evaluator and that this method will produce answer evaluators which are
 3046 are more robust than the method of copying existing answer evaluators and modifying them.
 3047 
 3048 Here is an outline of how a filter is constructed:
 3049 
 3050   sub filter{
 3051     my $rh_ans = shift;
 3052     my %options = @_;
 3053     assign_option_aliases(\%options,
 3054         'alias1'  => 'option5'
 3055         'alias2'  => 'option7'
 3056     );
 3057     set_default_options(\%options,
 3058         '_filter_name'  =>  'filter',
 3059         'option5'   =>  .0001,
 3060         'option7'   =>  'ascii',
 3061         'allow_unknown_options  =>  0,
 3062     }
 3063     .... body code of filter .......
 3064       if ($error) {
 3065         $rh_ans->throw_error("FILTER_ERROR", "Something went wrong");
 3066         # see AnswerHash.pm for details on using the throw_error method.
 3067 
 3068     $rh_ans;  #reference to an AnswerHash object is returned.
 3069   }
 3070 
 3071 =cut
 3072 
 3073 =head4 compare_numbers
 3074 
 3075 
 3076 =cut
 3077 
 3078 
 3079 sub compare_numbers {
 3080   my ($rh_ans, %options) = @_;
 3081   my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
 3082   if ($PG_eval_errors) {
 3083     $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
 3084     $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
 3085     # return $rh_ans;
 3086   } else {
 3087     $rh_ans->{student_ans} = prfmt($inVal,$options{format});
 3088   }
 3089 
 3090   my $permitted_error;
 3091 
 3092   if ($rh_ans->{tolType} eq 'absolute') {
 3093     $permitted_error = $rh_ans->{tolerance};
 3094   }
 3095   elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) {
 3096       $permitted_error = $options{zeroLevelTol};  ## want $tol to be non zero
 3097   }
 3098   else {
 3099     $permitted_error = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans});
 3100   }
 3101 
 3102   my $is_a_number = is_a_number($inVal);
 3103   $rh_ans->{score} = 1 if ( ($is_a_number) and
 3104       (abs( $inVal - $rh_ans->{correct_ans} ) <= $permitted_error) );
 3105   if (not $is_a_number) {
 3106     $rh_ans->{error_message} = "$rh_ans->{error_message}". 'Your answer does not evaluate to a number ';
 3107   }
 3108 
 3109   $rh_ans;
 3110 }
 3111 
 3112 =head4 std_num_filter
 3113 
 3114   std_num_filter($rh_ans, %options)
 3115   returns $rh_ans
 3116 
 3117 Replaces some constants using math_constants, then evaluates a perl expression.
 3118 
 3119 
 3120 =cut
 3121 
 3122 sub std_num_filter {
 3123   my $rh_ans = shift;
 3124   my %options = @_;
 3125   my $in = $rh_ans->input();
 3126   $in = math_constants($in);
 3127   $rh_ans->{type} = 'std_number';
 3128   my ($inVal,$PG_eval_errors,$PG_full_error_report);
 3129   if ($in =~ /\S/) {
 3130     ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($in);
 3131   } else {
 3132     $PG_eval_errors = '';
 3133   }
 3134 
 3135   if ($PG_eval_errors) {        ##error message from eval or above
 3136     $rh_ans->{ans_message} = 'There is a syntax error in your answer';
 3137     $rh_ans->{student_ans} =
 3138     clean_up_error_msg($PG_eval_errors);
 3139   } else {
 3140     $rh_ans->{student_ans} = $inVal;
 3141   }
 3142   $rh_ans;
 3143 }
 3144 
 3145 =head std_num_array_filter
 3146 
 3147   std_num_array_filter($rh_ans, %options)
 3148   returns $rh_ans
 3149 
 3150 Assumes the {student_ans} field is a numerical  array, and applies BOTH check_syntax and std_num_filter
 3151 to each element of the array.  Does it's best to generate sensible error messages for syntax errors.
 3152 A typical error message displayed in {studnet_ans} might be ( 56, error message, -4).
 3153 
 3154 =cut
 3155 
 3156 sub std_num_array_filter {
 3157   my $rh_ans= shift;
 3158   my %options = @_;
 3159   set_default_options(  \%options,
 3160         '_filter_name'  =>  'std_num_array_filter',
 3161     );
 3162   my @in = @{$rh_ans->{student_ans}};
 3163   my $temp_hash = new AnswerHash;
 3164   my @out=();
 3165   my $PGanswerMessage = '';
 3166   foreach my $item (@in)   {  # evaluate each number in the vector
 3167     $temp_hash->input($item);
 3168     $temp_hash = check_syntax($temp_hash);
 3169     if (defined($temp_hash->{error_flag}) and $temp_hash->{error_flag} eq 'SYNTAX') {
 3170       $PGanswerMessage .= $temp_hash->{ans_message};
 3171       $temp_hash->{ans_message} = undef;
 3172     } else {
 3173       #continue processing
 3174       $temp_hash = std_num_filter($temp_hash);
 3175       if (defined($temp_hash->{ans_message}) and $temp_hash->{ans_message} ) {
 3176         $PGanswerMessage .= $temp_hash->{ans_message};
 3177         $temp_hash->{ans_message} = undef;
 3178       }
 3179     }
 3180     push(@out, $temp_hash->input());
 3181 
 3182   }
 3183   if ($PGanswerMessage) {
 3184     $rh_ans->input( "( " . join(", ", @out ) . " )" );
 3185         $rh_ans->throw_error('SYNTAX', 'There is a syntax error in your answer.');
 3186   } else {
 3187     $rh_ans->input( [@out] );
 3188   }
 3189   $rh_ans;
 3190 }
 3191 
 3192 =head4 function_from_string2
 3193 
 3194 
 3195 
 3196 =cut
 3197 
 3198 sub function_from_string2 {
 3199     my $rh_ans = shift;
 3200     my %options = @_;
 3201   assign_option_aliases(\%options,
 3202         'vars'      => 'ra_vars',
 3203         'var'           => 'ra_vars',
 3204         'store_in'      => 'stdout',
 3205   );
 3206   set_default_options(  \%options,
 3207         'stdin'         =>  'student_ans',
 3208               'stdout'    =>  'rf_student_ans',
 3209           'ra_vars'   =>  [qw( x y )],
 3210           'debug'     =>  0,
 3211           '_filter_name'  =>  'function_from_string2',
 3212     );
 3213     # initialize
 3214     $rh_ans->{_filter_name} = $options{_filter_name};
 3215 
 3216     my $eqn         = $rh_ans->{ $options{stdin} };
 3217     my @VARS        = @{ $options{ 'ra_vars'}    };
 3218     #warn "VARS = ", join("<>", @VARS) if defined($options{debug}) and $options{debug} ==1;
 3219     my $originalEqn = $eqn;
 3220     $eqn            = &math_constants($eqn);
 3221     for( my $i = 0; $i < @VARS; $i++ ) {
 3222         #  This next line is a hack required for 5.6.0 -- it doesn't appear to be needed in 5.6.1
 3223         my ($temp,$er1,$er2) = PG_restricted_eval('"'. $VARS[$i] . '"');
 3224     #$eqn =~ s/\b$VARS[$i]\b/\$VARS[$i]/g;
 3225         $eqn  =~ s/\b$temp\b/\$VARS[$i]/g;
 3226 
 3227   }
 3228   #warn "equation evaluated = $eqn",$rh_ans->pretty_print(), "<br>\noptions<br>\n",
 3229   #     pretty_print(\%options)
 3230   #     if defined($options{debug}) and $options{debug} ==1;
 3231     my ($function_sub,$PG_eval_errors, $PG_full_errors) = PG_answer_eval( q!
 3232       sub {
 3233         my @VARS = @_;
 3234         my $input_str = '';
 3235         for( my $i=0; $i<@VARS; $i++ ) {
 3236           $input_str .= "\$VARS[$i] = $VARS[$i]; ";
 3237         }
 3238         my $PGanswerMessage;
 3239         $input_str .= '! . $eqn . q!';  # need the single quotes to keep the contents of $eqn from being
 3240                                         # evaluated when it is assigned to $input_str;
 3241         my ($out, $PG_eval_errors, $PG_full_errors) = PG_answer_eval($input_str); #Finally evaluated
 3242 
 3243         if ( defined($PG_eval_errors) and $PG_eval_errors =~ /\S/ ) {
 3244             $PGanswerMessage  = clean_up_error_msg($PG_eval_errors);
 3245 # This message seemed too verbose, but it does give extra information, we'll see if it is needed.
 3246 #                    "<br> There was an error in evaluating your function <br>
 3247 #           !. $originalEqn . q! <br>
 3248 #           at ( " . join(', ', @VARS) . " ) <br>
 3249 #            $PG_eval_errors
 3250 #           ";   # this message appears in the answer section which is not process by Latex2HTML so it must
 3251 #                # be in HTML.  That is why $BR is NOT used.
 3252 
 3253       }
 3254       (wantarray) ? ($out, $PGanswerMessage): $out;   # PGanswerMessage may be undefined.
 3255       };
 3256   !);
 3257 
 3258   if (defined($PG_eval_errors) and $PG_eval_errors =~/\S/ ) {
 3259         $PG_eval_errors = clean_up_error_msg($PG_eval_errors);
 3260 
 3261     my $PGanswerMessage = "There was an error in converting the expression
 3262       $BR $originalEqn $BR into a function.
 3263       $BR $PG_eval_errors.";
 3264     $rh_ans->{rf_student_ans} = $function_sub;
 3265     $rh_ans->{ans_message} = $PGanswerMessage;
 3266     $rh_ans->{error_message} = $PGanswerMessage;
 3267     $rh_ans->{error_flag} = 1;
 3268      # we couldn't compile the equation, we'll return an error message.
 3269   } else {
 3270 #     if (defined($options{stdout} )) {
 3271 #       $rh_ans ->{$options{stdout}} = $function_sub;
 3272 #     } else {
 3273 #         $rh_ans->{rf_student_ans} = $function_sub;
 3274 #       }
 3275       $rh_ans ->{$options{stdout}} = $function_sub;
 3276   }
 3277 
 3278     $rh_ans;
 3279 }
 3280 
 3281 =head4 is_zero_array
 3282 
 3283 
 3284 =cut
 3285 
 3286 
 3287 sub is_zero_array {
 3288     my $rh_ans = shift;
 3289     my %options = @_;
 3290     set_default_options(  \%options,
 3291         '_filter_name'  =>  'is_zero_array',
 3292         'tolerance'     =>  0.000001,
 3293         'stdin'         => 'ra_differences',
 3294         'stdout'        => 'score',
 3295     );
 3296     #intialize
 3297     $rh_ans->{_filter_name} = $options{_filter_name};
 3298 
 3299     my $array = $rh_ans -> {$options{stdin}};  # default ra_differences
 3300   my $num = @$array;
 3301   my $i;
 3302   my $max = 0; my $mm;
 3303   for ($i=0; $i< $num; $i++) {
 3304     $mm = $array->[$i] ;
 3305     if  (not is_a_number($mm) ) {
 3306       $max = $mm;  # break out if one of the elements is not a number
 3307       last;
 3308     }
 3309     $max = abs($mm) if abs($mm) > $max;
 3310   }
 3311   if (not is_a_number($max)) {
 3312     $rh_ans->{score} = 0;
 3313       my $error = "WeBWorK was unable evaluate your function. Please check that your
 3314                 expression doesn't take roots of negative numbers, or divide by zero.";
 3315     $rh_ans->throw_error('EVAL',$error);
 3316   } else {
 3317       $rh_ans->{$options{stdout}} = ($max < $options{tolerance} ) ? 1: 0;       # set 'score' to 1 if the array is close to 0;
 3318   }
 3319   $rh_ans;
 3320 }
 3321 
 3322 =head4 best_approx_parameters
 3323 
 3324   best_approx_parameters($rh_ans,%options);   #requires the following fields in $rh_ans
 3325                         {rf_student_ans}      # reference to the test answer
 3326                         {rf_correct_ans}      # reference to the comparison answer
 3327                         {evaluation_points},  # an array of row vectors indicating the points
 3328                                       # to evaluate when comparing the functions
 3329 
 3330                          %options       # debug => 1   gives more error answers
 3331                                     # param_vars => ['']  additional parameters used to adapt to function
 3332                          )
 3333 
 3334 
 3335 The parameters for the comparison function which best approximates the test_function are stored
 3336 in the field {ra_parameters}.
 3337 
 3338 
 3339 The last $dim_of_parms_space variables are assumed to be parameters, and it is also
 3340 assumed that the function \&comparison_fun
 3341 depends linearly on these variables.  This function finds the  values for these parameters which minimizes the
 3342 Euclidean distance (L2 distance) between the test function and the comparison function and the test points specified
 3343 by the array reference  \@rows_of_test_points.  This is assumed to be an array of arrays, with the inner arrays
 3344 determining a test point.
 3345 
 3346 The comparison function should have $dim_of_params_space more input variables than the test function.
 3347 
 3348 
 3349 
 3350 
 3351 
 3352 =cut
 3353 
 3354 # Used internally:
 3355 #
 3356 #   &$determine_param_coeff( $rf_comparison_function # a reference to the correct answer function
 3357 #                    $ra_variables                   # an array of the active input variables to the functions
 3358 #                    $dim_of_params_space            # indicates the number of parameters upon which the
 3359 #                                                    # the comparison function depends linearly.  These are assumed to
 3360 #                                                    # be the last group of inputs to the comparison function.
 3361 #
 3362 #                    %options                        # $options{debug} gives more error messages
 3363 #
 3364 #                                                    # A typical function might look like
 3365 #                                                    # f(x,y,z,a,b) = x^2+a*cos(xz) + b*sin(x) with a parameter
 3366 #                                                    # space of dimension 2 and a variable space of dimension 3.
 3367 #                   )
 3368 #         # returns a list of coefficients
 3369 
 3370 sub best_approx_parameters {
 3371     my $rh_ans = shift;
 3372     my %options = @_;
 3373     set_default_options(\%options,
 3374         '_filter_name'      =>  'best_approx_paramters',
 3375         'allow_unknown_options' =>  1,
 3376     );
 3377     my $errors = undef;
 3378     # This subroutine for the determining the coefficents of the parameters at a given point
 3379     # is pretty specialized, so it is included here as a sub-subroutine.
 3380     my $determine_param_coeffs  = sub {
 3381     my ($rf_fun, $ra_variables, $dim_of_params_space, %options) =@_;
 3382     my @zero_params=();
 3383     for(my $i=1;$i<=$dim_of_params_space;$i++){push(@zero_params,0); }
 3384     my @vars = @$ra_variables;
 3385     my @coeff = ();
 3386     my @inputs = (@vars,@zero_params);
 3387     my ($f0, $f1, $err);
 3388     ($f0, $err) = &{$rf_fun}(@inputs);
 3389     if (defined($err) ) {
 3390       $errors .= "$err ";
 3391     } else {
 3392       for (my $i=@vars;$i<@inputs;$i++) {
 3393         $inputs[$i]=1;  # set one parameter to 1;
 3394         my($f1,$err) = &$rf_fun(@inputs);
 3395         if (defined($err) ) {
 3396           $errors .= " $err ";
 3397         } else {
 3398           push(@coeff, $f1-$f0);
 3399         }
 3400         $inputs[$i]=0;  # set it back
 3401       }
 3402     }
 3403     (\@coeff, $errors);
 3404   };
 3405     my $rf_fun = $rh_ans->{rf_student_ans};
 3406     my $rf_correct_fun = $rh_ans->{rf_correct_ans};
 3407     my $ra_vars_matrix = $rh_ans->{evaluation_points};
 3408     my $dim_of_param_space = @{$options{param_vars}};
 3409     # Short cut.  Bail if there are no param_vars
 3410     unless ($dim_of_param_space >0) {
 3411     $rh_ans ->{ra_parameters} = [];
 3412     return $rh_ans;
 3413     }
 3414     # inputs are row arrays in this case.
 3415     my @zero_params=();
 3416 
 3417     for(my $i=1;$i<=$dim_of_param_space;$i++){push(@zero_params,0); }
 3418     my @rows_of_vars = @$ra_vars_matrix;
 3419     warn "input rows ", pretty_print(\@rows_of_vars) if defined($options{debug}) and $options{debug};
 3420     my $rows = @rows_of_vars;
 3421     my $matrix =new Matrix($rows,$dim_of_param_space);
 3422     my $rhs_vec = new Matrix($rows, 1);
 3423     my $row_num = 1;
 3424     my ($ra_coeff,$val2, $val1, $err1,$err2,@inputs,@vars);
 3425     my $number_of_data_points = $dim_of_param_space +2;
 3426     while (@rows_of_vars and $row_num <= $number_of_data_points) {
 3427      # get one set of data points from the test function;
 3428       @vars = @{ shift(@rows_of_vars) };
 3429       ($val2, $err1) = &{$rf_fun}(@vars);
 3430       $errors .= " $err1 "  if defined($err1);
 3431       @inputs = (@vars,@zero_params);
 3432       ($val1, $err2) = &{$rf_correct_fun}(@inputs);
 3433       $errors .= " $err2 " if defined($err2);
 3434 
 3435       unless (defined($err1) or defined($err2) ) {
 3436           $rhs_vec->assign($row_num,1, $val2-$val1 );
 3437 
 3438     # warn "rhs data  val1=$val1, val2=$val2, val2 - val1 = ", $val2 - $val1 if $options{debug};
 3439     # warn "vars ", join(" | ", @vars) if $options{debug};
 3440 
 3441       ($ra_coeff, $err1) = &{$determine_param_coeffs}($rf_correct_fun,\@vars,$dim_of_param_space,%options);
 3442       if (defined($err1) ) {
 3443         $errors .= " $err1 ";
 3444       } else {
 3445         my @coeff = @$ra_coeff;
 3446         my $col_num=1;
 3447           while(@coeff) {
 3448             $matrix->assign($row_num,$col_num, shift(@coeff) );
 3449             $col_num++;
 3450           }
 3451         }
 3452       }
 3453       $row_num++;
 3454       last if $errors;  # break if there are any errors.
 3455                       # This cuts down on the size of error messages.
 3456                       # However it impossible to check for equivalence at 95% of points
 3457             # which might be useful for functions that are not defined at some points.
 3458   }
 3459     warn "<br> best_approx_parameters: matrix1 <br>  ", " $matrix " if $options{debug};
 3460     warn "<br> best_approx_parameters: vector <br>  ", " $rhs_vec " if $options{debug};
 3461 
 3462    # we have   Matrix * parameter = data_vec + perpendicular vector
 3463    # where the matrix has column vectors defining the span of the parameter space
 3464    # multiply both sides by Matrix_transpose and solve for the parameters
 3465    # This is exactly what the method proj_coeff method does.
 3466    my @array;
 3467    if (defined($errors) ) {
 3468     @array = ();   #     new Matrix($dim_of_param_space,1);
 3469    } else {
 3470     @array = $matrix->proj_coeff($rhs_vec)->list();
 3471    }
 3472   # check size (hack)
 3473   my $max = 0;
 3474   foreach my $val (@array ) {
 3475     $max = abs($val) if  $max < abs($val);
 3476     if (not is_a_number($val) ) {
 3477       $max = "NaN: $val";
 3478       last;
 3479     }
 3480   }
 3481   if ($max =~/NaN/) {
 3482     $errors .= "WeBWorK was unable evaluate your function. Please check that your
 3483                 expression doesn't take roots of negative numbers, or divide by zero.";
 3484   } elsif ($max > $options{maxConstantOfIntegration} ) {
 3485     $errors .= "At least one of the adapting parameters
 3486              (perhaps the constant of integration) is too large: $max,
 3487              ( the maximum allowed is $options{maxConstantOfIntegration} )";
 3488   }
 3489 
 3490     $rh_ans->{ra_parameters} = \@array;
 3491     $rh_ans->throw_error('EVAL', $errors) if defined($errors);
 3492     $rh_ans;
 3493 }
 3494 
 3495 =head4 calculate_difference_vector
 3496 
 3497   calculate_difference_vector( $ans_hash, %options);
 3498 
 3499                 {rf_student_ans},     # a reference to the test function
 3500                                {rf_correct_ans},      # a reference to the correct answer function
 3501                                {evaluation_points},   # an array of row vectors indicating the points
 3502                                           # to evaluate when comparing the functions
 3503                                {ra_parameters}        # these are the (optional) additional inputs to
 3504                                                       # the comparison function which adapt it properly
 3505                                                       # to the problem at hand.
 3506 
 3507                                %options               # mode => 'rel'  specifies that each element in the
 3508                                                       # difference matrix is divided by the correct answer.
 3509                                                       # unless the correct answer is nearly 0.
 3510                               )
 3511 
 3512 =cut
 3513 
 3514 sub calculate_difference_vector {
 3515   my $rh_ans = shift;
 3516   my %options = @_;
 3517   assign_option_aliases( \%options,
 3518     );
 3519     set_default_options(  \%options,
 3520         allow_unknown_options  =>  1,
 3521       stdin1               => 'rf_student_ans',
 3522       stdin2                 => 'rf_correct_ans',
 3523       stdout                 => 'ra_differences',
 3524     debug                  =>  0,
 3525     tolType                => 'absolute',
 3526     error_msg_flag         =>  1,
 3527      );
 3528   # initialize
 3529   $rh_ans->{_filter_name} = 'calculate_difference_vector';
 3530   my $rf_fun              = $rh_ans -> {$options{stdin1}};        # rf_student_ans by default
 3531   my $rf_correct_fun      = $rh_ans -> {$options{stdin2}};        # rf_correct_ans by default
 3532   my $ra_parameters       = $rh_ans -> {ra_parameters};
 3533   my @evaluation_points   = @{$rh_ans->{evaluation_points} };
 3534   my @parameters          = ();
 3535   @parameters             = @$ra_parameters if defined($ra_parameters) and ref($ra_parameters) eq 'ARRAY';
 3536   my $errors              = undef;
 3537   my @zero_params         = ();
 3538   for (my $i=1;$i<=@{$ra_parameters};$i++) {
 3539     push(@zero_params,0);
 3540   }
 3541   my @differences         = ();
 3542   my @student_values;
 3543   my @adjusted_student_values;
 3544   my @instructorVals;
 3545   my ($diff,$instructorVal);
 3546   # calculate the vector of differences between the test function and the comparison function.
 3547   while (@evaluation_points) {
 3548     my ($err1, $err2,$err3);
 3549     my @vars = @{ shift(@evaluation_points) };
 3550     my @inputs = (@vars, @parameters);
 3551     my ($inVal,  $correctVal);
 3552     ($inVal, $err1) = &{$rf_fun}(@vars);
 3553     $errors .= " $err1 "  if defined($err1);
 3554     $errors .= " Error detected evaluating student input at (".join(' , ',@vars) ." ) " if  defined($options{debug}) and $options{debug}==1 and defined($err1);
 3555     ($correctVal, $err2) =&{$rf_correct_fun}(@inputs);
 3556     $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err2 " if defined($err2);
 3557     $errors .= " Error detected evaluating correct adapted answer  at (".join(' , ',@inputs) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err2);
 3558     ($instructorVal,$err3)= &$rf_correct_fun(@vars, @zero_params);
 3559     $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err3 " if defined($err3);
 3560     $errors .= " Error detected evaluating instructor answer  at (".join(' , ',@vars, @zero_params) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err3);
 3561     unless (defined($err1) or defined($err2) or defined($err3) ) {
 3562       $diff = ( $inVal - ($correctVal -$instructorVal ) ) - $instructorVal;  #prevents entering too high a number?
 3563       #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff;
 3564       if ( $options{tolType} eq 'relative' ) {  #relative tolerance
 3565         #warn "diff = $diff";
 3566         #$diff = ( $inVal - ($correctVal-$instructorVal ) )/abs($instructorVal) -1    if abs($instructorVal) > $options{zeroLevel};
 3567         $diff = ( $inVal - ($correctVal-$instructorVal ) )/$instructorVal -1    if abs($instructorVal) > $options{zeroLevel};
 3568         #$diff = ( $inVal - ($correctVal-$instructorVal- $instructorVal ) )/abs($instructorVal)    if abs($instructorVal) > $options{zeroLevel};
 3569         #warn "diff = $diff,   ", abs( &$rf_correct_fun(@inputs) ) , "-- $correctVal";
 3570       }
 3571     }
 3572     last if $errors;  # break if there are any errors.
 3573                   # This cuts down on the size of error messages.
 3574                   # However it impossible to check for equivalence at 95% of points
 3575                   # which might be useful for functions that are not defined at some points.
 3576         push(@student_values,$inVal);
 3577         push(@adjusted_student_values,(  $inVal - ($correctVal -$instructorVal) ) );
 3578     push(@differences, $diff);
 3579     push(@instructorVals,$instructorVal);
 3580   }
 3581   if (( not defined($errors) )  or $errors eq '' or $options{error_msg_flag} ) {
 3582       $rh_ans ->{$options{stdout}} = \@differences;
 3583     $rh_ans ->{ra_student_values} = \@student_values;
 3584     $rh_ans ->{ra_adjusted_student_values} = \@adjusted_student_values;
 3585     $rh_ans->{ra_instructor_values}=\@instructorVals;
 3586     $rh_ans->throw_error('EVAL', $errors) if defined($errors);
 3587   } else {
 3588 
 3589   }      # no output if error_msg_flag is set to 0.
 3590 
 3591 
 3592   $rh_ans;
 3593 }
 3594 
 3595 =head4 fix_answer_for_display
 3596 
 3597 =cut
 3598 
 3599 sub fix_answers_for_display {
 3600   my ($rh_ans, %options) = @_;
 3601   if ( $rh_ans->{answerIsString} ==1) {
 3602     $rh_ans = evaluatesToNumber ($rh_ans, %options);
 3603   }
 3604   if (defined ($rh_ans->{student_units})) {
 3605     $rh_ans->{student_ans} = $rh_ans->{student_ans}. ' '. $rh_ans->{student_units};
 3606 
 3607   }
 3608   if ( $rh_ans->catch_error('UNITS')  ) {  # create preview latex string for expressions even if the units are incorrect
 3609       my $rh_temp = new AnswerHash;
 3610       $rh_temp->{student_ans} = $rh_ans->{student_ans};
 3611       $rh_temp = check_syntax($rh_temp);
 3612       $rh_ans->{preview_latex_string} = $rh_temp->{preview_latex_string};
 3613   }
 3614   $rh_ans->{correct_ans} = $rh_ans->{original_correct_ans};
 3615 
 3616   $rh_ans;
 3617 }
 3618 
 3619 =head4 evaluatesToNumber
 3620 
 3621 =cut
 3622 
 3623 sub evaluatesToNumber {
 3624   my ($rh_ans, %options) = @_;
 3625   if (is_a_numeric_expression($rh_ans->{student_ans})) {
 3626     my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
 3627     if ($PG_eval_errors) { # this if statement should never be run
 3628       # change nothing
 3629     } else {
 3630       # change this
 3631       $rh_ans->{student_ans} = prfmt($inVal,$options{format});
 3632     }
 3633   }
 3634   $rh_ans;
 3635 }
 3636 
 3637 =head4 is_numeric_expression
 3638 
 3639 =cut
 3640 
 3641 sub is_a_numeric_expression {
 3642   my $testString = shift;
 3643   my $is_a_numeric_expression = 0;
 3644   my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($testString);
 3645   if ($PG_eval_errors) {
 3646     $is_a_numeric_expression = 0;
 3647   } else {
 3648     $is_a_numeric_expression = 1;
 3649   }
 3650   $is_a_numeric_expression;
 3651 }
 3652 
 3653 =head4 is_a_number
 3654 
 3655 =cut
 3656 
 3657 sub is_a_number {
 3658   my ($num,%options) =  @_;
 3659   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
 3660   my ($rh_ans);
 3661   if ($process_ans_hash) {
 3662     $rh_ans = $num;
 3663     $num = $rh_ans->{student_ans};
 3664   }
 3665 
 3666   my $is_a_number = 0;
 3667   return $is_a_number unless defined($num);
 3668   $num =~ s/^\s*//; ## remove initial spaces
 3669   $num =~ s/\s*$//; ## remove trailing spaces
 3670 
 3671   ## the following is copied from the online perl manual
 3672   if ($num =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/){
 3673     $is_a_number = 1;
 3674   }
 3675 
 3676   if ($process_ans_hash)   {
 3677         if ($is_a_number == 1 ) {
 3678           $rh_ans->{student_ans}=$num;
 3679           return $rh_ans;
 3680         } else {
 3681           $rh_ans->{student_ans} = "Incorrect number format:  You must enter a number, e.g. -6, 5.3, or 6.12E-3";
 3682           $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
 3683           return $rh_ans;
 3684         }
 3685   } else {
 3686     return $is_a_number;
 3687   }
 3688 }
 3689 
 3690 =head4 is_a_fraction
 3691 
 3692 =cut
 3693 
 3694 sub is_a_fraction {
 3695   my ($num,%options) =  @_;
 3696   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
 3697   my ($rh_ans);
 3698   if ($process_ans_hash) {
 3699     $rh_ans = $num;
 3700     $num = $rh_ans->{student_ans};
 3701   }
 3702 
 3703   my $is_a_fraction = 0;
 3704   return $is_a_fraction unless defined($num);
 3705   $num =~ s/^\s*//; ## remove initial spaces
 3706   $num =~ s/\s*$//; ## remove trailing spaces
 3707 
 3708   if ($num =~ /^\s*\-?\s*[\/\d\.Ee\s]*$/) {
 3709     $is_a_fraction = 1;
 3710   }
 3711 
 3712     if ($process_ans_hash)   {
 3713       if ($is_a_fraction == 1 ) {
 3714         $rh_ans->{student_ans}=$num;
 3715         return $rh_ans;
 3716       } else {
 3717         $rh_ans->{student_ans} = "Not a number of fraction: You must enter a number or fraction, e.g. -6 or 7/13";
 3718         $rh_ans->throw_error('NUMBER', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
 3719         return $rh_ans;
 3720       }
 3721 
 3722       } else {
 3723     return $is_a_fraction;
 3724   }
 3725 }
 3726 
 3727 =head4 phase_pi
 3728   I often discovered that the answers I was getting, when using the arctan function would be off by phases of
 3729   pi, which for the tangent function, were equivalent values. This method allows for this.
 3730 =cut
 3731 
 3732 sub phase_pi {
 3733   my ($num,%options) =  @_;
 3734   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
 3735   my ($rh_ans);
 3736   if ($process_ans_hash) {
 3737     $rh_ans = $num;
 3738     $num = $rh_ans->{correct_ans};
 3739   }
 3740   while( ($rh_ans->{correct_ans}) >  3.14159265358979/2 ){
 3741     $rh_ans->{correct_ans} -= 3.14159265358979;
 3742   }
 3743   while( ($rh_ans->{correct_ans}) <= -3.14159265358979/2 ){
 3744     $rh_ans->{correct_ans} += 3.14159265358979;
 3745   }
 3746   $rh_ans;
 3747 }
 3748 
 3749 =head4 is_an_arithemetic_expression
 3750 
 3751 =cut
 3752 
 3753 sub is_an_arithmetic_expression {
 3754   my ($num,%options) =  @_;
 3755   my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
 3756   my ($rh_ans);
 3757   if ($process_ans_hash) {
 3758     $rh_ans = $num;
 3759     $num = $rh_ans->{student_ans};
 3760   }
 3761 
 3762   my $is_an_arithmetic_expression = 0;
 3763   return $is_an_arithmetic_expression unless defined($num);
 3764   $num =~ s/^\s*//; ## remove initial spaces
 3765   $num =~ s/\s*$//; ## remove trailing spaces
 3766 
 3767   if ($num =~ /^[+\-*\/\^\(\)\[\]\{\}\s\d\.Ee]*$/) {
 3768     $is_an_arithmetic_expression =  1;
 3769   }
 3770 
 3771     if ($process_ans_hash)   {
 3772       if ($is_an_arithmetic_expression == 1 ) {
 3773         $rh_ans->{student_ans}=$num;
 3774         return $rh_ans;
 3775       } else {
 3776 
 3777     $rh_ans->{student_ans} = "Not an arithmetic expression: You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2";
 3778         $rh_ans->throw_error('NUMBER', 'You must enter an arithmetic expression, e.g. -6 or (2.3*4+5/3)^2');
 3779         return $rh_ans;
 3780       }
 3781 
 3782       } else {
 3783     return $is_an_arithmetic_expression;
 3784   }
 3785 }
 3786 
 3787 #
 3788 
 3789 =head4 math_constants
 3790 
 3791 replaces pi, e, and ^ with their Perl equivalents
 3792 if useBaseTenLog is non-zero, convert log to logten
 3793 
 3794 =cut
 3795 
 3796 sub math_constants {
 3797   my($in,%options) = @_;
 3798   my $rh_ans;
 3799   my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ;
 3800   if ($process_ans_hash) {
 3801     $rh_ans = $in;
 3802     $in = $rh_ans->{student_ans};
 3803   }
 3804   # The code fragment above allows this filter to be used when the input is simply a string
 3805   # as well as when the input is an AnswerHash, and options.
 3806   $in =~s/\bpi\b/(4*atan2(1,1))/ge;
 3807   $in =~s/\be\b/(exp(1))/ge;
 3808   $in =~s/\^/**/g;
 3809   if($useBaseTenLog) {
 3810     $in =~ s/\blog\b/logten/g;
 3811   }
 3812 
 3813   if ($process_ans_hash)   {
 3814       $rh_ans->{student_ans}=$in;
 3815       return $rh_ans;
 3816     } else {
 3817     return $in;
 3818   }
 3819 }
 3820 
 3821 
 3822 
 3823 =head4 is_array
 3824 
 3825   is_array($rh_ans)
 3826     returns: $rh_ans.   Throws error "NOTARRAY" if this is not an array
 3827 
 3828 =cut
 3829 
 3830 sub is_array  {
 3831   my $rh_ans = shift;
 3832     # return if the result is an array
 3833   return($rh_ans) if  ref($rh_ans->{student_ans}) eq 'ARRAY' ;
 3834   $rh_ans->throw_error("NOTARRAY","The answer is not an array");
 3835   $rh_ans;
 3836 }
 3837 
 3838 =head4 check_syntax
 3839 
 3840   check_syntax( $rh_ans, %options)
 3841     returns an answer hash.
 3842 
 3843 latex2html preview code are installed in the answer hash.
 3844 The input has been transformed, changing 7pi to 7*pi  or 7x to 7*x.
 3845 Syntax error messages may be generated and stored in student_ans
 3846 Additional syntax error messages are stored in {ans_message} and duplicated in {error_message}
 3847 
 3848 
 3849 =cut
 3850 
 3851 sub check_syntax {
 3852         my $rh_ans = shift;
 3853         my %options = @_;
 3854         assign_option_aliases(\%options,
 3855     );
 3856     set_default_options(  \%options,
 3857           'stdin'         =>  'student_ans',
 3858           'stdout'    =>  'student_ans',
 3859           'ra_vars'   =>  [qw( x y )],
 3860           'debug'     =>  0,
 3861           '_filter_name'  =>  'check_syntax',
 3862           error_msg_flag  =>  1,
 3863     );
 3864     #initialize
 3865     $rh_ans->{_filter_name}     = $options{_filter_name};
 3866         unless ( defined( $rh_ans->{$options{stdin}} ) ) {
 3867           warn "Check_syntax requires an equation in the field '$options{stdin}' or input";
 3868           $rh_ans->throw_error("1","'$options{stdin}' field not defined");
 3869           return $rh_ans;
 3870         }
 3871         my $in     = $rh_ans->{$options{stdin}};
 3872     my $parser = new AlgParserWithImplicitExpand;
 3873     my $ret    = $parser -> parse($in);     #for use with loops
 3874 
 3875     if ( ref($ret) )  {   ## parsed successfully
 3876       # $parser -> tostring();   # FIXME?  was this needed for some reason?????
 3877       $parser -> normalize();
 3878       $rh_ans -> {$options{stdout}}     = $parser -> tostring();
 3879       $rh_ans -> {preview_text_string}  = $in;
 3880       $rh_ans -> {preview_latex_string} = $parser -> tolatex();
 3881 
 3882     } elsif ($options{error_msg_flag} ) {         ## error in parsing
 3883 
 3884       $rh_ans->{$options{stdout}}     = 'syntax error:'. $parser->{htmlerror},
 3885       $rh_ans->{'ans_message'}      = $parser -> {error_msg},
 3886       $rh_ans->{'preview_text_string'}  = '',
 3887       $rh_ans->{'preview_latex_string'} = '',
 3888       $rh_ans->throw_error('SYNTAX',  'syntax error in answer:'. $parser->{htmlerror} . "$BR" .$parser -> {error_msg});
 3889     }   # no output is produced if there is an error and the error_msg_flag is set to zero
 3890        $rh_ans;
 3891 
 3892 }
 3893 
 3894 =head4 check_strings
 3895 
 3896   check_strings ($rh_ans, %options)
 3897     returns $rh_ans
 3898 
 3899 =cut
 3900 
 3901 sub check_strings {
 3902   my ($rh_ans, %options) = @_;
 3903 
 3904   # if the student's answer is a number, simply return the answer hash (unchanged).
 3905 
 3906   #  we allow constructions like -INF to be treated as a string. Thus we ignore an initial
 3907   # - in deciding whether the student's answer is a number or string
 3908 
 3909   my $temp_ans = $rh_ans->{student_ans};
 3910   $temp_ans =~ s/^\s*\-//;   # remove an initial -
 3911 
 3912   if  ( $temp_ans =~ m/[\d+\-*\/^(){}\[\]]|^\s*e\s*$|^\s*pi\s*$/)   {
 3913   # if ( $rh_ans->{answerIsString} == 1) {
 3914   #     #$rh_ans->throw_error('STRING','Incorrect Answer'); # student's answer is a number
 3915   # }
 3916     return $rh_ans;
 3917   }
 3918   # the student's answer is recognized as a string
 3919   my $ans = $rh_ans->{student_ans};
 3920 
 3921 # OVERVIEW of reminder of function:
 3922 # if answer is correct, return correct.  (adjust score to 1)
 3923 # if answer is incorect:
 3924 # 1) determine if the answer is sensible.  if it is, return incorrect.
 3925 # 2) if the answer is not sensible (and incorrect), then return an error message indicating so.
 3926 # no matter what:  throw a 'STRING' error to skip numerical evaluations.  (error flag skips remainder of pre_filters and evaluators)
 3927 # last: 'STRING' post_filter will clear the error (avoiding pink screen.)
 3928 
 3929   my $sensibleAnswer = 0;
 3930   $ans = str_filters( $ans, 'compress_whitespace' );  # remove trailing, leading, and double spaces.
 3931   my ($ans_eval) = str_cmp($rh_ans->{correct_ans});
 3932   my $temp_ans_hash = &$ans_eval($ans);
 3933   $rh_ans->{test} = $temp_ans_hash;
 3934 
 3935   if ($temp_ans_hash->{score} ==1 ) {     # students answer matches the correct answer.
 3936     $rh_ans->{score} = 1;
 3937     $sensibleAnswer = 1;
 3938   } else {            # students answer does not match the correct answer.
 3939     my $legalString = '';       # find out if string makes sense
 3940     my @legalStrings = @{$options{strings}};
 3941     foreach $legalString (@legalStrings) {
 3942       if ( uc($ans) eq uc($legalString) ) {
 3943         $sensibleAnswer = 1;
 3944         last;
 3945         }
 3946       }
 3947     $sensibleAnswer = 1 unless $ans =~ /\S/;  ## empty answers are sensible
 3948     $rh_ans->throw_error('EVAL', "Your answer is not a recognized answer") unless ($sensibleAnswer);
 3949     # $temp_ans_hash -> setKeys( 'ans_message' => 'Your answer is not a recognized answer' ) unless ($sensibleAnswer);
 3950     # $temp_ans_hash -> setKeys( 'student_ans' => uc($ans) );
 3951   }
 3952 
 3953   $rh_ans->{student_ans} = $ans;
 3954 
 3955   if ($sensibleAnswer) {
 3956     $rh_ans->throw_error('STRING', "The student's answer $rh_ans->{student_ans} is interpreted as a string.");
 3957   }
 3958 
 3959   $rh_ans->{'preview_text_string'}  = $ans,
 3960   $rh_ans->{'preview_latex_string'} = $ans,
 3961 
 3962   # warn ("\$rh_ans->{answerIsString} = $rh_ans->{answerIsString}");
 3963   $rh_ans;
 3964 }
 3965 
 3966 =head4 check_units
 3967 
 3968   check_strings ($rh_ans, %options)
 3969     returns $rh_ans
 3970 
 3971 
 3972 =cut
 3973 
 3974 sub check_units {
 3975   my ($rh_ans, %options) = @_;
 3976   my %correct_units = %{$rh_ans-> {rh_correct_units}};
 3977   my $ans = $rh_ans->{student_ans};
 3978   # $ans = '' unless defined ($ans);
 3979   $ans = str_filters ($ans, 'trim_whitespace');
 3980   my $original_student_ans = $ans;
 3981   $rh_ans->{original_student_ans} = $original_student_ans;
 3982 
 3983   # it surprises me that the match below works since the first .* is greedy.
 3984   my ($num_answer, $units) = $ans =~ /^(.*)\s+([^\s]*)$/;
 3985 
 3986   unless ( defined($num_answer) && $units ) {
 3987     # there is an error reading the input
 3988     if ( $ans =~ /\S/ )  {  # the answer is not blank
 3989       $rh_ans -> setKeys( 'ans_message' => "The answer \"$ans\" could not be interpreted " .
 3990         "as a number or an arithmetic expression followed by a unit specification. " .
 3991         "Your answer must contain units." );
 3992       $rh_ans->throw_error('UNITS', "The answer \"$ans\" could not be interpreted " .
 3993         "as a number or an arithmetic expression followed by a unit specification. " .
 3994         "Your answer must contain units." );
 3995     }
 3996     return $rh_ans;
 3997   }
 3998 
 3999   # we have been able to parse the answer into a numerical part and a unit part
 4000 
 4001   # $num_answer = $1;   #$1 and $2 from the regular expression above
 4002   # $units    = $2;
 4003 
 4004   my %units = Units::evaluate_units($units);
 4005   if ( defined( $units{'ERROR'} ) ) {
 4006      # handle error condition
 4007           $units{'ERROR'} = clean_up_error_msg($units{'ERROR'});
 4008     $rh_ans -> setKeys( 'ans_message' => "$units{'ERROR'}" );
 4009     $rh_ans -> throw_error('UNITS', "$units{'ERROR'}");
 4010     return $rh_ans;
 4011   }
 4012 
 4013   my $units_match = 1;
 4014   my $fund_unit;
 4015   foreach $fund_unit (keys %correct_units) {
 4016     next if $fund_unit eq 'factor';
 4017     $units_match = 0 unless $correct_units{$fund_unit} == $units{$fund_unit};
 4018   }
 4019 
 4020   if ( $units_match ) {
 4021         # units are ok.  Evaluate the numerical part of the answer
 4022     $rh_ans->{'tolerance'} = $rh_ans->{'tolerance'}* $correct_units{'factor'}/$units{'factor'}  if
 4023           $rh_ans->{'tolType'} eq 'absolute'; # the tolerance is in the units specified by the instructor.
 4024     $rh_ans->{correct_ans} =  prfmt($rh_ans->{correct_ans}*$correct_units{'factor'}/$units{'factor'});
 4025     $rh_ans->{student_units} = $units;
 4026     $rh_ans->{student_ans} = $num_answer;
 4027 
 4028   } else {
 4029         $rh_ans -> setKeys( ans_message => 'There is an error in the units for this answer.' );
 4030         $rh_ans -> throw_error ( 'UNITS', 'There is an error in the units for this answer.' );
 4031   }
 4032 
 4033   return $rh_ans;
 4034 }
 4035 
 4036 
 4037 
 4038 =head2 Filter utilities
 4039 
 4040 These two subroutines can be used in filters to set default options.  They
 4041 help make filters perform in uniform, predictable ways, and also make it
 4042 easy to recognize from the code which options a given filter expects.
 4043 
 4044 
 4045 =head4 assign_option_aliases
 4046 
 4047 Use this to assign aliases for the standard options.  It must come before set_default_options
 4048 within the subroutine.
 4049 
 4050     assign_option_aliases(\%options,
 4051         'alias1'  => 'option5'
 4052         'alias2'  => 'option7'
 4053     );
 4054 
 4055 
 4056 If the subroutine is called with an option  " alias1 => 23 " it will behave as if it had been
 4057 called with the option " option5 => 23 "
 4058 
 4059 =cut
 4060 
 4061 
 4062 
 4063 sub assign_option_aliases {
 4064   my $rh_options = shift;
 4065   warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
 4066   my @option_aliases = @_;
 4067   while (@option_aliases) {
 4068     my $alias = shift @option_aliases;
 4069     my $option_key = shift @option_aliases;
 4070 
 4071     if (defined($rh_options->{$alias} )) {                       # if the alias appears in the option list
 4072       if (not defined($rh_options->{$option_key}) ) {          # and the option itself is not defined,
 4073         $rh_options->{$option_key} = $rh_options->{$alias};  # insert the value defined by the alias into the option value
 4074                                                              # the FIRST alias for a given option takes precedence
 4075                                                              # (after the option itself)
 4076       } else {
 4077         warn "option $option_key is already defined as", $rh_options->{$option_key}, "<br>\n",
 4078              "The attempt to override this option with the alias $alias with value ", $rh_options->{$alias},
 4079              " was ignored.";
 4080       }
 4081     }
 4082     delete($rh_options->{$alias});                               # remove the alias from the initial list
 4083   }
 4084 
 4085 }
 4086 
 4087 =head4 set_default_options
 4088 
 4089     set_default_options(\%options,
 4090         '_filter_name'  =>  'filter',
 4091         'option5'   =>  .0001,
 4092         'option7'   =>  'ascii',
 4093         'allow_unknown_options  =>  0,
 4094     }
 4095 
 4096 Note that the first entry is a reference to the options with which the filter was called.
 4097 
 4098 The option5 is set to .0001 unless the option is explicitly set when the subroutine is called.
 4099 
 4100 The B<'_filter_name'> option should always be set, although there is no error if it is missing.
 4101 It is used mainly for debugging answer evaluators and allows
 4102 you to keep track of which filter is currently processing the answer.
 4103 
 4104 If B<'allow_unknown_options'> is set to 0 then if the filter is called with options which do NOT appear in the
 4105 set_default_options list an error will be signaled and a warning message will be printed out.  This provides
 4106 error checking against misspelling an option and is generally what is desired for most filters.
 4107 
 4108 Occasionally one wants to write a filter which accepts a long list of options, not all of which are known in advance,
 4109 but only uses a subset of the options
 4110 provided.  In this case, setting 'allow_unkown_options' to 1 prevents the error from being signaled.
 4111 
 4112 =cut
 4113 
 4114 sub set_default_options {
 4115   my $rh_options = shift;
 4116   warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
 4117   my %default_options = @_;
 4118   unless ( defined($default_options{allow_unknown_options}) and $default_options{allow_unknown_options} == 1 ) {
 4119     foreach  my $key1 (keys %$rh_options) {
 4120       warn "This option |$key1| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key1});
 4121     }
 4122   }
 4123   foreach my $key (keys %default_options) {
 4124     if  ( not defined($rh_options->{$key} ) and defined( $default_options{$key} )  ) {
 4125       $rh_options->{$key} = $default_options{$key};  #this allows     tol   => undef to allow the tol option, but doesn't define
 4126                                                      # this key unless tol is explicitly defined.
 4127     }
 4128   }
 4129 }
 4130 
 4131 =head2 Problem Grader Subroutines
 4132 
 4133 =cut
 4134 
 4135 ## Problem Grader Subroutines
 4136 
 4137 #####################################
 4138 # This is a model for plug-in problem graders
 4139 #####################################
 4140 sub install_problem_grader {
 4141   my $rf_problem_grader = shift;
 4142   my $rh_flags = PG_restricted_eval(q!\\%main::PG_FLAGS!);
 4143   $rh_flags->{PROBLEM_GRADER_TO_USE} = $rf_problem_grader;
 4144 }
 4145 
 4146 =head4 std_problem_grader
 4147 
 4148 This is an all-or-nothing grader.  A student must get all parts of the problem write
 4149 before receiving credit.  You should make sure to use this grader on multiple choice
 4150 and true-false questions, otherwise students will be able to deduce how many
 4151 answers are correct by the grade reported by webwork.
 4152 
 4153 
 4154   install_problem_grader(~~&std_problem_grader);
 4155 
 4156 =cut
 4157 
 4158 sub std_problem_grader {
 4159   my $rh_evaluated_answers = shift;
 4160   my $rh_problem_state = shift;
 4161   my %form_options = @_;
 4162   my %evaluated_answers = %{$rh_evaluated_answers};
 4163   #  The hash $rh_evaluated_answers typically contains:
 4164   #    'answer1' => 34, 'answer2'=> 'Mozart', etc.
 4165 
 4166   # By default the  old problem state is simply passed back out again.
 4167   my %problem_state = %$rh_problem_state;
 4168 
 4169   # %form_options might include
 4170   # The user login name
 4171   # The permission level of the user
 4172   # The studentLogin name for this psvn.
 4173   # Whether the form is asking for a refresh or is submitting a new answer.
 4174 
 4175   # initial setup of the answer
 4176   my %problem_result = ( score    => 0,
 4177                errors   => '',
 4178              type   => 'std_problem_grader',
 4179              msg    => '',
 4180   );
 4181   # Checks
 4182 
 4183   my $ansCount = keys %evaluated_answers;  # get the number of answers
 4184 
 4185   unless ($ansCount > 0 ) {
 4186 
 4187     $problem_result{msg} = "This problem did not ask any questions.";
 4188     return(\%problem_result,\%problem_state);
 4189   }
 4190 
 4191   if ($ansCount > 1 ) {
 4192     $problem_result{msg} = 'In order to get credit for this problem all answers must be correct.' ;
 4193   }
 4194 
 4195   unless ($form_options{answers_submitted} == 1) {
 4196     return(\%problem_result,\%problem_state);
 4197   }
 4198 
 4199   my $allAnswersCorrectQ=1;
 4200   foreach my $ans_name (keys %evaluated_answers) {
 4201   # I'm not sure if this check is really useful.
 4202     if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) )  {
 4203       $allAnswersCorrectQ = 0 unless( 1 == $evaluated_answers{$ans_name}->{score} );
 4204     }
 4205     else {
 4206       die "Error at file ",__FILE__,"line ", __LINE__,":  Answer |$ans_name| is not a hash reference\n".
 4207          $evaluated_answers{$ans_name} .
 4208          "This probably means that the answer evaluator for this answer\n" .
 4209          "is not working correctly.";
 4210       $problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}";
 4211     }
 4212   }
 4213   # report the results
 4214   $problem_result{score} = $allAnswersCorrectQ;
 4215 
 4216   # I don't like to put in this bit of code.
 4217   # It makes it hard to construct error free problem graders
 4218   # I would prefer to know that the problem score was numeric.
 4219   unless (defined($problem_state{recorded_score}) and $problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) {
 4220     $problem_state{recorded_score} = 0;  # This gets rid of non-numeric scores
 4221   }
 4222   #
 4223   if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) {
 4224     $problem_state{recorded_score} = 1;
 4225   }
 4226   else {
 4227     $problem_state{recorded_score} = 0;
 4228   }
 4229 
 4230   $problem_state{num_of_correct_ans}++ if $allAnswersCorrectQ == 1;
 4231   $problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0;
 4232   (\%problem_result, \%problem_state);
 4233 }
 4234 
 4235 =head4 std_problem_grader2
 4236 
 4237 This is an all-or-nothing grader.  A student must get all parts of the problem write
 4238 before receiving credit.  You should make sure to use this grader on multiple choice
 4239 and true-false questions, otherwise students will be able to deduce how many
 4240 answers are correct by the grade reported by webwork.
 4241 
 4242 
 4243   install_problem_grader(~~&std_problem_grader2);
 4244 
 4245 The only difference between the two versions
 4246 is at the end of the subroutine, where std_problem_grader2
 4247 records the attempt only if there have been no syntax errors,
 4248 whereas std_problem_grader records it regardless.
 4249 
 4250 =cut
 4251 
 4252 
 4253 
 4254 sub std_problem_grader2 {
 4255   my $rh_evaluated_answers = shift;
 4256   my $rh_problem_state = shift;
 4257   my %form_options = @_;
 4258   my %evaluated_answers = %{$rh_evaluated_answers};
 4259   #  The hash $rh_evaluated_answers typically contains:
 4260   #    'answer1' => 34, 'answer2'=> 'Mozart', etc.
 4261 
 4262   # By default the  old problem state is simply passed back out again.
 4263   my %problem_state = %$rh_problem_state;
 4264 
 4265   # %form_options might include
 4266   # The user login name
 4267   # The permission level of the user
 4268   # The studentLogin name for this psvn.
 4269   # Whether the form is asking for a refresh or is submitting a new answer.
 4270 
 4271   # initial setup of the answer
 4272   my %problem_result = ( score        => 0,
 4273              errors       => '',
 4274              type       => 'std_problem_grader',
 4275              msg        => '',
 4276   );
 4277 
 4278   # syntax errors are not counted.
 4279   my $record_problem_attempt = 1;
 4280   # Checks
 4281 
 4282   my $ansCount = keys %evaluated_answers;  # get the number of answers
 4283   unless ($ansCount > 0 ) {
 4284     $problem_result{msg} = "This problem did not ask any questions.";
 4285     return(\%problem_result,\%problem_state);
 4286   }
 4287 
 4288   if ($ansCount > 1 ) {
 4289     $problem_result{msg} = 'In order to get credit for this problem all answers must be correct.' ;
 4290   }
 4291 
 4292   unless ($form_options{answers_submitted} == 1) {
 4293     return(\%problem_result,\%problem_state);
 4294   }
 4295 
 4296   my  $allAnswersCorrectQ=1;
 4297   foreach my $ans_name (keys %evaluated_answers) {
 4298   # I'm not sure if this check is really useful.
 4299     if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) )  {
 4300       $allAnswersCorrectQ = 0 unless( 1 == $evaluated_answers{$ans_name}->{score} );
 4301     }
 4302     else {
 4303       die "Error at file ",__FILE__,"line ", __LINE__,":  Answer |$ans_name| is not a hash reference\n".
 4304          $evaluated_answers{$ans_name} .
 4305          "This probably means that the answer evaluator for this answer\n" .
 4306          "is not working correctly.";
 4307       $problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}";
 4308     }
 4309   }
 4310   # report the results
 4311   $problem_result{score} = $allAnswersCorrectQ;
 4312 
 4313   # I don't like to put in this bit of code.
 4314   # It makes it hard to construct error free problem graders
 4315   # I would prefer to know that the problem score was numeric.
 4316   unless ($problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) {
 4317     $problem_state{recorded_score} = 0;  # This gets rid of non-numeric scores
 4318   }
 4319   #
 4320   if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) {
 4321     $problem_state{recorded_score} = 1;
 4322   }
 4323   else {
 4324     $problem_state{recorded_score} = 0;
 4325   }
 4326   # record attempt only if there have been no syntax errors.
 4327 
 4328   if ($record_problem_attempt == 1) {
 4329     $problem_state{num_of_correct_ans}++ if $allAnswersCorrectQ == 1;
 4330     $problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0;
 4331   }
 4332   else {
 4333     $problem_result{show_partial_correct_answers} = 0 ;  # prevent partial correct answers from being shown for syntax errors.
 4334   }
 4335   (\%problem_result, \%problem_state);
 4336 }
 4337 
 4338 =head4 avg_problem_grader
 4339 
 4340 This grader gives a grade depending on how many questions from the problem are correct.  (The highest
 4341 grade is the one that is kept.  One can never lower the recorded grade on a problem by repeating it.)
 4342 Many professors (and almost all students :-)  ) prefer this grader.
 4343 
 4344 
 4345   install_problem_grader(~~&avg_problem_grader);
 4346 
 4347 =cut
 4348 
 4349 
 4350 sub avg_problem_grader {
 4351     my $rh_evaluated_answers = shift;
 4352   my $rh_problem_state = shift;
 4353   my %form_options = @_;
 4354   my %evaluated_answers = %{$rh_evaluated_answers};
 4355   #  The hash $rh_evaluated_answers typically contains:
 4356   #    'answer1' => 34, 'answer2'=> 'Mozart', etc.
 4357 
 4358   # By default the  old problem state is simply passed back out again.
 4359   my %problem_state = %$rh_problem_state;
 4360 
 4361 
 4362   # %form_options might include
 4363   # The user login name
 4364   # The permission level of the user
 4365   # The studentLogin name for this psvn.
 4366   # Whether the form is asking for a refresh or is submitting a new answer.
 4367 
 4368   # initial setup of the answer
 4369   my  $total=0;
 4370   my %problem_result = ( score        => 0,
 4371              errors       => '',
 4372              type       => 'avg_problem_grader',
 4373              msg        => '',
 4374   );
 4375   my $count = keys %evaluated_answers;
 4376   $problem_result{msg} = 'You can earn partial credit on this problem.' if $count >1;
 4377   # Return unless answers have been submitted
 4378   unless ($form_options{answers_submitted} == 1) {
 4379     return(\%problem_result,\%problem_state);
 4380   }
 4381 
 4382   # Answers have been submitted -- process them.
 4383   foreach my $ans_name (keys %evaluated_answers) {
 4384     # I'm not sure if this check is really useful.
 4385     if ( ( ref($evaluated_answers{$ans_name} ) eq 'HASH' ) or ( ref($evaluated_answers{$ans_name}) eq 'AnswerHash' ) )  {
 4386       $total += $evaluated_answers{$ans_name}->{score};
 4387     }
 4388     else {
 4389       die "Error: Answer |$ans_name| is not a hash reference\n".
 4390          $evaluated_answers{$ans_name} .
 4391          "This probably means that the answer evaluator for this answer\n" .
 4392          "is not working correctly.";
 4393       $problem_result{error} = "Error: Answer $ans_name is not a hash: $evaluated_answers{$ans_name}";
 4394     }
 4395   }
 4396   # Calculate score rounded to three places to avoid roundoff problems
 4397   $problem_result{score} = $total/$count if $count;
 4398   # increase recorded score if the current score is greater.
 4399   $problem_state{recorded_score} = $problem_result{score} if $problem_result{score} > $problem_state{recorded_score};
 4400 
 4401 
 4402   $problem_state{num_of_correct_ans}++ if $total == $count;
 4403   $problem_state{num_of_incorrect_ans}++ if $total < $count ;
 4404   warn "Error in grading this problem the total $total is larger than $count" if $total > $count;
 4405   (\%problem_result, \%problem_state);
 4406 }
 4407 
 4408 =head2 Utility subroutines
 4409 
 4410 =head4
 4411 
 4412   warn pretty_print( $rh_hash_input)
 4413 
 4414 This can be very useful for printing out messages about objects while debugging
 4415 
 4416 =cut
 4417 
 4418 sub pretty_print {
 4419     my $r_input = shift;
 4420     my $out = '';
 4421     if ( not ref($r_input) ) {
 4422       $out = $r_input;    # not a reference
 4423     } elsif ("$r_input" =~/hash/i) {  # this will pick up objects whose '$self' is hash and so works better than ref($r_iput).
 4424       local($^W) = 0;
 4425     $out .= "$r_input " ."<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
 4426     foreach my $key (lex_sort( keys %$r_input )) {
 4427       $out .= "<tr><TD> $key</TD><TD>=&gt;</td><td>&nbsp;".pretty_print($r_input->{$key}) . "</td></tr>";
 4428     }
 4429     $out .="</table>";
 4430   } elsif (ref($r_input) eq 'ARRAY' ) {
 4431     my @array = @$r_input;
 4432     $out .= "( " ;
 4433     while (@array) {
 4434       $out .= pretty_print(shift @array) . " , ";
 4435     }
 4436     $out .= " )";
 4437   } elsif (ref($r_input) eq 'CODE') {
 4438     $out = "$r_input";
 4439   } else {
 4440     $out = $r_input;
 4441   }
 4442     $out;
 4443 }
 4444 
 4445 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9