[system] / trunk / webwork / system / courseScripts / PGanswermacros.pl Repository:
ViewVC logotype

View of /trunk/webwork/system/courseScripts/PGanswermacros.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2780 - (download) (as text) (annotate)
Tue Sep 14 21:27:20 2004 UTC (15 years, 4 months ago) by apizer
File size: 151744 byte(s)
Fixed bug with useBaseTenLog

Arnie

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9