[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 1250 - (download) (as text) (annotate)
Mon Jun 23 15:43:11 2003 UTC (16 years, 5 months ago) by gage
File size: 147658 byte(s)
Made changes required to allow caching of these files.
My tests indicate that these changes are compatible with webwork1.8
One possible problem might be the mail-to answer macros
which access the environement variable directly
I think I have this properly patched, but it has not been
tested yet.
--Mike

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9