[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 2150 - (download) (as text) (annotate)
Sat May 22 01:19:11 2004 UTC (15 years, 6 months ago) by gage
File size: 159377 byte(s)
Experimental refactorization of answer evaluators will take place on this branch.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9