[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 2781 - (download) (as text) (annotate)
Tue Sep 14 21:36:45 2004 UTC (15 years, 2 months ago) by apizer
File size: 156930 byte(s)
Fixed bug with useBaseTenLog

Arnie

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9