[system] / trunk / pg / macros / PGanswermacros.pl Repository:
ViewVC logotype

View of /trunk/pg/macros/PGanswermacros.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2151 - (download) (as text) (annotate)
Sat May 22 01:23:17 2004 UTC (15 years, 6 months ago) by gage
File size: 158993 byte(s)
Roll back the previous changes.  They were added to HEAD instead of to the experimental branch.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9