[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 4928 - (download) (as text) (annotate)
Tue Apr 17 00:36:16 2007 UTC (12 years, 7 months ago) by dpvc
File size: 179056 byte(s)
Modified the way the Parser-based versions of the traditional answer
checkers get copies of their contexts.  They now use a new method
getCopy to obtain the copy either from the problem's context table or
the default table (rather than only from the default).  That way the
instructor can use parserCustomization.pl to customize the contexts
used by the answer checkers.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9