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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5684 - (download) (as text) (annotate)
Sat May 24 23:05:02 2008 UTC (11 years, 8 months ago) by dpvc
File size: 38003 byte(s)
Moved previous_equivalence_message filter to Formula object directly,
so it is no longer needed in the FUNCTION_CMP macro itself.

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: pg/macros/PGfunctionevaluators.pl,v 1.4 2008/04/26 21:14:05 gage Exp $
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 =head1 NAME
   18 
   19 PGfunctionevaluators.pl - Macros that generate function answer evaluators.
   20 
   21 =head1 SYNOPSIS
   22 
   23   ANS(fun_cmp($answer_or_answer_array_ref, %options));
   24 
   25   ANS(function_cmp($correctEqn, $var, $llimit, $ulimit, $relTol, $numPoints, $zeroLevel,
   26                    $zeroLevelTol));
   27   ANS(function_cmp_up_to_constant($correctEqn, $var, $llimit, $ulimit, $relpercentTol,
   28                                   $numOfPoints, $maxConstantOfIntegration, $zeroLevel,
   29                                   $zeroLevelTol));
   30   ANS(function_cmp_abs($correctFunction, $var, $llimit, $ulimit, $absTol, $numOfPoints));
   31   ANS(function_cmp_up_to_constant_abs($correctFunction, $var, $llimit, $ulimit,
   32                                       $absTol, $numOfPoints, $maxConstantOfIntegration));
   33 
   34 =head1 DESCRIPTION
   35 
   36 Function answer evaluators take in a function, compare it numerically to a
   37 correct function, and return a score. They can require an exactly equivalent
   38 function, or one that is equal up to a constant. They can accept or reject an
   39 answer based on specified tolerances for numerical deviation.
   40 
   41 The general function answer evaluator is fun_cmp(). It takes a hash of named
   42 options as parameters. There are also several specific function_cmp_*() answer
   43 evaluators for use in common situations which feature a simplified syntax.
   44 
   45 =head2 MathObjects and answer evaluators
   46 
   47 The MathObjects system provides a Formula->cmp() method that produce answer
   48 evaluators for function comparisons. fun_cmp() has been rewritten to use
   49 Formula->cmp() to produce the answer evaluator. It is recommended that you use
   50 the Formula object's cmp() method directly if possible.
   51 
   52 =cut
   53 
   54 BEGIN { be_strict() }
   55 
   56 # Until we get the PG cacheing business sorted out, we need to use
   57 # PG_restricted_eval to get the correct values for some(?) PG environment
   58 # variables. We do this once here and place the values in lexicals for later
   59 # access.
   60 my $Context;
   61 my $functAbsTolDefault;
   62 my $functLLimitDefault;
   63 my $functMaxConstantOfIntegration;
   64 my $functNumOfPoints;
   65 my $functRelPercentTolDefault;
   66 my $functULimitDefault;
   67 my $functVarDefault;
   68 my $functZeroLevelDefault;
   69 my $functZeroLevelTolDefault;
   70 my $inputs_ref;
   71 my $useOldAnswerMacros;
   72 my $user_context;
   73 sub _PGfunctionevaluators_init {
   74   $functAbsTolDefault            = PG_restricted_eval(q/$envir{functAbsTolDefault}/);
   75   $functLLimitDefault            = PG_restricted_eval(q/$envir{functLLimitDefault}/);
   76   $functMaxConstantOfIntegration = PG_restricted_eval(q/$envir{functMaxConstantOfIntegration}/);
   77   $functNumOfPoints              = PG_restricted_eval(q/$envir{functNumOfPoints}/);
   78   $functRelPercentTolDefault     = PG_restricted_eval(q/$envir{functRelPercentTolDefault}/);
   79   $functULimitDefault            = PG_restricted_eval(q/$envir{functULimitDefault}/);
   80   $functVarDefault               = PG_restricted_eval(q/$envir{functVarDefault}/);
   81   $functZeroLevelDefault         = PG_restricted_eval(q/$envir{functZeroLevelDefault}/);
   82   $functZeroLevelTolDefault      = PG_restricted_eval(q/$envir{functZeroLevelTolDefault}/);
   83   $inputs_ref                    = PG_restricted_eval(q/$envir{inputs_ref}/);
   84   $useOldAnswerMacros            = PG_restricted_eval(q/$envir{useOldAnswerMacros}/);
   85   unless ($useOldAnswerMacros) {
   86     $user_context = PG_restricted_eval(q/\%context/);
   87     $Context = sub { Parser::Context->current($user_context, @_) };
   88   }
   89 }
   90 
   91 =head1 fun_cmp
   92 
   93   ANS(fun_cmp($answer_or_answer_array_ref, %options));
   94 
   95 Compares a function or a list of functions, using a named hash of options to set
   96 parameters. This can make for more readable code than using the function_cmp()
   97 style, but some people find one or the other easier to remember.
   98 
   99 =head2 Options
  100 
  101 $answer_or_answer_array_ref can either be a string scalar representing the
  102 correct formula or a reference to an array of string scalars. If multiple
  103 formulas are provided, fun_cmp() will return a list of answer evaluators, one
  104 for each answer specified. The answer can contain functions, pi, e, and
  105 arithmetic operations. However, the correct answer string follows a slightly
  106 stricter syntax than student answers; specifically, there is no implicit
  107 multiplication. So the correct answer must be "3*x" rather than "3 x". Students
  108 can still enter "3 x".
  109 
  110 %options is a hash containing options that affect the way the comparison is
  111 performed. All hash items are optional. Allowed options are:
  112 
  113 =over
  114 
  115 =item mode
  116 
  117 This determines the evaluation mode. The recognized modes are:
  118 
  119 =over
  120 
  121 =item std (default)
  122 
  123 Function must match exactly.
  124 
  125 =item antider
  126 
  127 Function must match up to a constant.
  128 
  129 =back
  130 
  131 =item tol
  132 
  133 An absolute tolerance value. When the student and correct functions are
  134 evaluated,  the result for each evaluation point must be within a fixed distance
  135 from the correct answer to qualify. For example, an absolute tolerance of 5
  136 means that any result which is +-5 of the correct answer qualifies as correct.
  137 abstol is accepted as a synonym for tol.
  138 
  139 =item relTol
  140 
  141 A relative tolerance. Relative tolerances are given in percentages. A relative
  142 tolerance of 1 indicates that when the student's function are evaluated, the
  143 result of evaluation at each point must be within within 1% of the correct
  144 answer to qualify as correct. In other words, a student answer is correct when
  145 
  146   abs(studentAnswer - correctAnswer) <= abs(.01*relTol*correctAnswer)
  147 
  148 tol and relTol are mutually exclusive. reltol is also accpeted as a synonym for
  149 relTol.
  150 
  151 =item zeroLevel, zeroLevelTol
  152 
  153 zeroLevel and zeroLevelTol specify a alternative absolute tolerance to use when
  154 the correct answer is very close to zero.
  155 
  156 If the correct answer has an absolute value less than or equal to zeroLevel,
  157 then the student answer must be, in absolute terms, within zeroLevelTol of
  158 correctAnswer, i.e.,
  159 
  160   abs(studentAnswer - correctAnswer) <= zeroLevelTol
  161 
  162 In other words, if the correct answer is very near zero, an absolute tolerance
  163 will be used. One must do this to handle floating point answers very near zero,
  164 because of the inaccuracy of floating point arithmetic. However, the default
  165 values are almost always adequate.
  166 
  167 =item var
  168 
  169 The var parameter can contain a number, a string, or a reference to an array of
  170 variable names. If it contains a number, the variables are named automatically
  171 as follows:
  172 
  173    var | variables used
  174   -----+--------------------
  175    1   | x
  176    2   | x, y
  177    3   | x, y, z
  178    4+  | x_1, x_2, x_3, ...
  179 
  180 If the var parameter contains a reference to an array of variable names, then
  181 the number of variables is determined by the number of items in the array. For example:
  182 
  183   var=>['r','s','t']
  184 
  185 If the var parameter contains a string, the string is used as the name of a
  186 single variable. Hence, the following are equivalent:
  187 
  188   var=>['t']
  189   var=>'t'
  190 
  191 vars is recognied as a synonym for var. The default is a single variable, x.
  192 
  193 =item limits
  194 
  195 Limits are specified with the limits parameter. If you specify limits for one
  196 variable, you must specify them for all variables. The limit parameter must be a
  197 reference to an array of arrays of the form C<[$lower_limit. $upper_limit]>,
  198 each array corresponding to the lower and upper endpoints of the (half-open)
  199 domain of one variable. For example,
  200 
  201   vars=>2, limits=>[[0,2], [-3,8]]
  202 
  203 would cause x to be evaluated in [0,2) and y to be evaluated in [-3,8). If only
  204 one variable is being used, you can write either:
  205 
  206   limits => [[0,3]]
  207   limits => [0,3]
  208 
  209 domain is recognized as a synonym for limits.
  210 
  211 =item test_points
  212 
  213 In some cases, the problem writer may want to specify the points used to check a
  214 particular function.  For example, if you want to use only integer values, they
  215 can be specified.  With one variable, either of these two forms work:
  216 
  217   test_points=>[1,4,5,6]
  218   test_points=>[[1,4,5,6]]
  219 
  220 With more variables, specify the list for the first variable, then the second,
  221 and so on:
  222 
  223   vars=>['x','y'], test_points=>[[1,4,5],[7,14,29]]".
  224 
  225 If the problem writer wants random values which need to meet some special
  226 restrictions (such as being integers), they can be generated in the problem:
  227 
  228   test_points=>[random(1,50), random(1,50), random(1,50), random(1,50)]
  229 
  230 Note that test_points should not be used for function checks which involve
  231 parameters (either explicitly given by "params", or as antiderivatives).
  232 
  233 
  234 =item numPoints
  235 
  236 The number of sample points to use when evaluating the function.
  237 
  238 =item maxConstantOfIntegration
  239 
  240 Maximum size for the constant of integration (in antider mode).
  241 
  242 =item params
  243 
  244 A reference to an array of "free" parameters which can be used to adapt the
  245 correct answer to the submitted answer. (e.g. ['c'] for a constant of
  246 integration in the answer x^3/3+c.
  247 
  248 =item debug
  249 
  250 If set to one, extra debugging information will be output.
  251 
  252 =back
  253 
  254 =head2 Examples
  255 
  256   # standard compare, variable is x
  257   fun_cmp("3*x");
  258 
  259   # standard compare, defaults used for all three functions
  260   fun_cmp(["3*x", "4*x+3", "3*x**2"]);
  261 
  262   # standard compare, variable is t
  263   fun_cmp("3*t", var=>'t');
  264 
  265   # x, y and z are the variables
  266   fun_cmp("5*x*y*z", var=>3);
  267 
  268   # student answer must match up to constant (i.e., 5x+C)
  269   fun_cmp("5*x", mode=>'antider');
  270 
  271   # x is evaluated in [0,2), y in [5,7)
  272   fun_cmp(["3*x*y", "4*x*y"], limits=>[[0,2], [5,7]]);
  273 
  274 =cut
  275 
  276 sub fun_cmp {
  277   my $correctAnswer = shift @_;
  278   my %opt           = @_;
  279 
  280     assign_option_aliases( \%opt,
  281         'vars'    =>  'var',    # set the standard option 'var' to the one specified as vars
  282           'domain'  =>  'limits', # set the standard option 'limits' to the one specified as domain
  283           'reltol'    =>  'relTol',
  284           'param'   =>  'params',
  285     );
  286 
  287     set_default_options(  \%opt,
  288         'var'         =>  $functVarDefault,
  289             'params'        =>  [],
  290         'limits'        =>  [[$functLLimitDefault, $functULimitDefault]],
  291         'test_points'   => undef,
  292         'mode'          =>  'std',
  293         'tolType'       =>    (defined($opt{tol}) ) ? 'absolute' : 'relative',
  294         'tol'         =>  .01, # default mode should be relative, to obtain this tol must not be defined
  295             'relTol'        =>  $functRelPercentTolDefault,
  296         'numPoints'       =>  $functNumOfPoints,
  297         'maxConstantOfIntegration'  =>  $functMaxConstantOfIntegration,
  298         'zeroLevel'       =>  $functZeroLevelDefault,
  299         'zeroLevelTol'      =>  $functZeroLevelTolDefault,
  300             'debug'         =>  0,
  301             'diagnostics'                           =>      undef,
  302      );
  303 
  304     # allow var => 'x' as an abbreviation for var => ['x']
  305   my %out_options = %opt;
  306   unless ( ref($out_options{var}) eq 'ARRAY' || $out_options{var} =~ m/^\d+$/) {
  307     $out_options{var} = [$out_options{var}];
  308   }
  309   # allow params => 'c' as an abbreviation for params => ['c']
  310   unless ( ref($out_options{params}) eq 'ARRAY' ) {
  311     $out_options{params} = [$out_options{params}];
  312   }
  313   my ($tolType, $tol);
  314     if ($out_options{tolType} eq 'absolute') {
  315     $tolType = 'absolute';
  316     $tol = $out_options{'tol'};
  317     delete($out_options{'relTol'}) if exists( $out_options{'relTol'} );
  318   } else {
  319     $tolType = 'relative';
  320     $tol = $out_options{'relTol'};
  321     delete($out_options{'tol'}) if exists( $out_options{'tol'} );
  322   }
  323 
  324   my @output_list = ();
  325   # thread over lists
  326   my @ans_list = ();
  327 
  328   if ( ref($correctAnswer) eq 'ARRAY' ) {
  329     @ans_list = @{$correctAnswer};
  330   }
  331   else {
  332     push( @ans_list, $correctAnswer );
  333   }
  334 
  335   # produce answer evaluators
  336   foreach my $ans (@ans_list) {
  337     push(@output_list,
  338       FUNCTION_CMP(
  339           'correctEqn'    =>  $ans,
  340           'var'       =>  $out_options{'var'},
  341           'limits'      =>  $out_options{'limits'},
  342           'tolerance'     =>  $tol,
  343           'tolType'     =>  $tolType,
  344           'numPoints'     =>  $out_options{'numPoints'},
  345           'test_points' =>  $out_options{'test_points'},
  346           'mode'        =>  $out_options{'mode'},
  347           'maxConstantOfIntegration'  =>  $out_options{'maxConstantOfIntegration'},
  348           'zeroLevel'     =>  $out_options{'zeroLevel'},
  349           'zeroLevelTol'    =>  $out_options{'zeroLevelTol'},
  350           'params'      =>  $out_options{'params'},
  351           'debug'       =>  $out_options{'debug'},
  352                 'diagnostics'             =>  $out_options{'diagnostics'} ,
  353       ),
  354     );
  355   }
  356 
  357   return (wantarray) ? @output_list : $output_list[0];
  358 }
  359 
  360 =head1 Single-variable Function Comparisons
  361 
  362 There are four single-variable function answer evaluators: "normal," absolute
  363 tolerance, antiderivative, and antiderivative with absolute tolerance. All
  364 parameters (other than the correct equation) are optional.
  365 
  366 =head2 function_cmp
  367 
  368   ANS(function_cmp($correctEqn, $var, $llimit, $ulimit, $relTol, $numPoints,
  369                    $zeroLevel, $zeroLevelTol));
  370 
  371 function_cmp() uses standard comparison and relative tolerance. It takes a
  372 string representing a single-variable function and compares the student answer
  373 to that function numerically. $var, $relTol, $numPoints, $zeroLevel, and
  374 $zeroLevelTol are equivalent to the identically-named options to fun_cmp(),
  375 above. $llimit and $ulimit are combined to form the value of limits above.
  376 
  377 =cut
  378 
  379 sub function_cmp {
  380   my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$zeroLevel,$zeroLevelTol) = @_;
  381 
  382   if ( (scalar(@_) == 3) or (scalar(@_) > 8) or (scalar(@_) == 0) ) {
  383     function_invalid_params( $correctEqn );
  384   }
  385   else {
  386     FUNCTION_CMP( 'correctEqn'          =>  $correctEqn,
  387         'var'           =>  $var,
  388         'limits'          =>  [$llimit, $ulimit],
  389         'tolerance'         =>  $relPercentTol,
  390         'tolType'         =>  'relative',
  391         'numPoints'         =>  $numPoints,
  392         'mode'            =>  'std',
  393         'maxConstantOfIntegration'      =>  0,
  394         'zeroLevel'         =>  $zeroLevel,
  395         'zeroLevelTol'          =>  $zeroLevelTol
  396           );
  397   }
  398 }
  399 
  400 =head2 function_cmp_up_to_constant
  401 
  402   ANS(function_cmp_up_to_constant($correctEqn, $var, $llimit, $ulimit,
  403                                   $relpercentTol, $numOfPoints,
  404                                   $maxConstantOfIntegration, $zeroLevel,
  405                                   $zeroLevelTol));
  406 
  407 function_cmp_up_to_constant() uses antiderivative compare and relative
  408 tolerance. All but the first argument are optional. All options work exactly
  409 like function_cmp(), except of course $maxConstantOfIntegration. It will accept
  410 as correct any function which differs from $correctEqn by at most a constant;
  411 that is, if
  412 
  413   $studentEqn = $correctEqn + C, where C <= $maxConstantOfIntegration
  414 
  415 the answer is correct.
  416 
  417 =cut
  418 
  419 sub function_cmp_up_to_constant { ## for antiderivative problems
  420   my ($correctEqn,$var,$llimit,$ulimit,$relPercentTol,$numPoints,$maxConstantOfIntegration,$zeroLevel,$zeroLevelTol) = @_;
  421 
  422   if ( (scalar(@_) == 3) or (scalar(@_) > 9) or (scalar(@_) == 0) ) {
  423     function_invalid_params( $correctEqn );
  424   }
  425   else {
  426     FUNCTION_CMP( 'correctEqn'          =>  $correctEqn,
  427         'var'           =>  $var,
  428         'limits'          =>  [$llimit, $ulimit],
  429         'tolerance'         =>  $relPercentTol,
  430         'tolType'         =>  'relative',
  431         'numPoints'         =>  $numPoints,
  432         'mode'            =>  'antider',
  433         'maxConstantOfIntegration'      =>  $maxConstantOfIntegration,
  434         'zeroLevel'         =>  $zeroLevel,
  435         'zeroLevelTol'          =>  $zeroLevelTol
  436           );
  437   }
  438 }
  439 
  440 =head2 function_cmp_abs
  441 
  442   ANS(function_cmp_abs($correctFunction, $var, $llimit, $ulimit, $absTol, $numOfPoints));
  443 
  444 function_cmp_abs() uses standard compare and absolute tolerance. All but the
  445 first argument are optional. $absTol defines the absolute tolerance value. See
  446 the corresponding option to fun_cmp(), above. All other options work exactly as
  447 for function_cmp().
  448 
  449 =cut
  450 
  451 sub function_cmp_abs {      ## similar to function_cmp but uses absolute tolerance
  452   my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints) = @_;
  453 
  454   if ( (scalar(@_) == 3) or (scalar(@_) > 6) or (scalar(@_) == 0) ) {
  455     function_invalid_params( $correctEqn );
  456   }
  457   else {
  458     FUNCTION_CMP( 'correctEqn'      =>  $correctEqn,
  459         'var'       =>  $var,
  460         'limits'      =>  [$llimit, $ulimit],
  461         'tolerance'     =>  $absTol,
  462         'tolType'     =>  'absolute',
  463         'numPoints'     =>  $numPoints,
  464         'mode'        =>  'std',
  465         'maxConstantOfIntegration'  =>  0,
  466         'zeroLevel'     =>  0,
  467         'zeroLevelTol'      =>  0
  468     );
  469   }
  470 }
  471 
  472 =head2 function_cmp_up_to_constant_abs
  473 
  474   ANS(function_cmp_up_to_constant_abs($correctFunction, $var, $llimit,
  475                                       $ulimit, $absTol, $numOfPoints,
  476                                       $maxConstantOfIntegration));
  477 
  478 function_cmp_up_to_constant_abs() uses antiderivative compare and absolute
  479 tolerance. All but the first argument are optional. $absTol defines the absolute
  480 tolerance value. See the corresponding option to fun_cmp(), above. All other
  481 options work exactly as with function_cmp_up_to_constant().
  482 
  483 =cut
  484 
  485 sub function_cmp_up_to_constant_abs  {  ## for antiderivative problems
  486                     ## similar to function_cmp_up_to_constant
  487                     ## but uses absolute tolerance
  488   my ($correctEqn,$var,$llimit,$ulimit,$absTol,$numPoints,$maxConstantOfIntegration) = @_;
  489 
  490   if ( (scalar(@_) == 3) or (scalar(@_) > 7) or (scalar(@_) == 0) ) {
  491     function_invalid_params( $correctEqn );
  492   }
  493 
  494   else {
  495     FUNCTION_CMP( 'correctEqn'          =>  $correctEqn,
  496         'var'           =>  $var,
  497         'limits'          =>  [$llimit, $ulimit],
  498         'tolerance'         =>  $absTol,
  499         'tolType'         =>  'absolute',
  500         'numPoints'         =>  $numPoints,
  501         'mode'            =>  'antider',
  502         'maxConstantOfIntegration'      =>  $maxConstantOfIntegration,
  503         'zeroLevel'         =>  0,
  504         'zeroLevelTol'          =>  0
  505     );
  506   }
  507 }
  508 
  509 =head2 adaptive_function_cmp
  510 
  511 FIXME undocumented.
  512 
  513 =cut
  514 
  515 sub adaptive_function_cmp {
  516   my $correctEqn = shift;
  517   my %options = @_;
  518   set_default_options(  \%options,
  519       'vars'      =>  [qw( x y )],
  520                   'params'    =>  [],
  521                   'limits'    =>  [ [0,1], [0,1]],
  522                   'reltol'    =>  $functRelPercentTolDefault,
  523                   'numPoints'   =>  $functNumOfPoints,
  524                   'zeroLevel'   =>  $functZeroLevelDefault,
  525                   'zeroLevelTol'  =>  $functZeroLevelTolDefault,
  526                   'debug'     =>  0,
  527             'diagnostics'           =>      undef,
  528   );
  529 
  530     my $var_ref = $options{'vars'};
  531     my $ra_params = $options{ 'params'};
  532     my $limit_ref = $options{'limits'};
  533     my $relPercentTol= $options{'reltol'};
  534     my $numPoints = $options{'numPoints'};
  535     my $zeroLevel = $options{'zeroLevel'};
  536     my $zeroLevelTol = $options{'zeroLevelTol'};
  537 
  538   FUNCTION_CMP( 'correctEqn'          =>  $correctEqn,
  539       'var'           =>  $var_ref,
  540       'limits'          =>  $limit_ref,
  541       'tolerance'         =>  $relPercentTol,
  542       'tolType'         =>  'relative',
  543       'numPoints'         =>  $numPoints,
  544       'mode'            =>  'std',
  545       'maxConstantOfIntegration'      =>  10**100,
  546       'zeroLevel'         =>  $zeroLevel,
  547       'zeroLevelTol'          =>  $zeroLevelTol,
  548       'scale_norm'                      =>    1,
  549       'params'                          =>    $ra_params,
  550       'debug'               =>  $options{debug} ,
  551       'diagnostics'           =>  $options{diagnostics} ,
  552   );
  553 }
  554 
  555 =head1 Multi-variable Function Comparisons
  556 
  557 =head2 [DEPRECATED] multivar_function_cmp
  558 
  559   ANS(multivar_function_cmp($correctFunction, $var, $limits, $relTol, $numPoints, $zeroLevel, $zeroLevelTol));
  560 
  561 This function is deprecated. Use fun_cmp instead:
  562 
  563   ANS(fun_cmp($correctFunction, var=>$var, limits=>$limits, ...));
  564 
  565 =cut
  566 
  567 ## The following answer evaluator for comparing multivarable functions was
  568 ## contributed by Professor William K. Ziemer
  569 ## (Note: most of the multivariable functionality provided by Professor Ziemer
  570 ## has now been integrated into fun_cmp and FUNCTION_CMP)
  571 ############################
  572 # W.K. Ziemer, Sep. 1999
  573 # Math Dept. CSULB
  574 # email: wziemer@csulb.edu
  575 ############################
  576 
  577 sub multivar_function_cmp {
  578   my ($correctEqn,$var_ref,$limit_ref,$relPercentTol,$numPoints,$zeroLevel,$zeroLevelTol) = @_;
  579 
  580   if ( (scalar(@_) > 7) or (scalar(@_) < 2) ) {
  581     function_invalid_params( $correctEqn );
  582   }
  583 
  584   FUNCTION_CMP( 'correctEqn'      =>  $correctEqn,
  585       'var'       =>  $var_ref,
  586       'limits'      =>  $limit_ref,
  587       'tolerance'     =>  $relPercentTol,
  588       'tolType'     =>  'relative',
  589       'numPoints'     =>  $numPoints,
  590       'mode'        =>  'std',
  591       'maxConstantOfIntegration'  =>  0,
  592       'zeroLevel'     =>  $zeroLevel,
  593       'zeroLevelTol'      =>  $zeroLevelTol
  594   );
  595 }
  596 
  597 ## LOW-LEVEL ROUTINE -- NOT NORMALLY FOR END USERS -- USE WITH CAUTION
  598 ## NOTE: PG_answer_eval is used instead of PG_restricted_eval in order to insure that the answer
  599 ## evaluated within the context of the package the problem was originally defined in.
  600 ## Includes multivariable modifications contributed by Professor William K. Ziemer
  601 ##
  602 ## IN:  a hash consisting of the following keys (error checking to be added later?)
  603 ##      correctEqn      --  the correct equation as a string
  604 ##      var       --  the variable name as a string,
  605 ##                or a reference to an array of variables
  606 ##      limits        --  reference to an array of arrays of type [lower,upper]
  607 ##      tolerance     --  the allowable margin of error
  608 ##      tolType       --  'relative' or 'absolute'
  609 ##      numPoints     --  the number of points to evaluate the function at
  610 ##      mode        --  'std' or 'antider'
  611 ##      maxConstantOfIntegration  --  maximum size of the constant of integration
  612 ##      zeroLevel     --  if the correct answer is this close to zero,
  613 ##                        then zeroLevelTol applies
  614 ##      zeroLevelTol      --  absolute tolerance to allow when answer is close to zero
  615 ##      test_points     --  user supplied points to use for testing the
  616 ##                          function, either array of arrays, or optionally
  617 ##                          reference to single array (for one variable)
  618 
  619 
  620 sub FUNCTION_CMP {
  621   return ORIGINAL_FUNCTION_CMP(@_)
  622     if $useOldAnswerMacros;
  623 
  624   my %func_params = @_;
  625 
  626   my $correctEqn               = $func_params{'correctEqn'};
  627   my $var                      = $func_params{'var'};
  628   my $ra_limits                = $func_params{'limits'};
  629   my $tol                      = $func_params{'tolerance'};
  630   my $tolType                  = $func_params{'tolType'};
  631   my $numPoints                = $func_params{'numPoints'};
  632   my $mode                     = $func_params{'mode'};
  633   my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'};
  634   my $zeroLevel                = $func_params{'zeroLevel'};
  635   my $zeroLevelTol             = $func_params{'zeroLevelTol'};
  636   my $testPoints               = $func_params{'test_points'};
  637 
  638   #
  639   #  Check that everything is defined:
  640   #
  641   $func_params{debug} = 0 unless defined $func_params{debug};
  642   $mode = 'std' unless defined $mode;
  643   my @VARS   = get_var_array($var);
  644   my @limits = get_limits_array($ra_limits);
  645   my @PARAMS = @{$func_params{'params'} || []};
  646 
  647   if ($tolType eq 'relative') {
  648     $tol = $functRelPercentTolDefault unless defined $tol;
  649     $tol *= .01;
  650   } else {
  651     $tol = $functAbsTolDefault unless defined $tol;
  652   }
  653 
  654   #
  655   #  Ensure that the number of limits matches number of variables
  656   #
  657   foreach my $i (0..scalar(@VARS)-1) {
  658     $limits[$i][0] = $functLLimitDefault unless defined $limits[$i][0];
  659     $limits[$i][1] = $functULimitDefault unless defined $limits[$i][1];
  660   }
  661 
  662   #
  663   #  Check that the test points are array references with the right number of coordinates
  664   #
  665   if ($testPoints) {
  666     my $n = scalar(@VARS); my $s = ($n != 1)? "s": "";
  667     foreach my $p (@{$testPoints}) {
  668       $p = [$p] unless ref($p) eq 'ARRAY';
  669       warn "Test point (".join(',',@{$p}).") should have $n coordiante$s"
  670         unless scalar(@{$p}) == $n;
  671     }
  672   }
  673 
  674   #
  675   #  Reorder variables, limits, and test_points if the variables are not in alphabetical order
  676   #
  677   if (scalar(@VARS) > 1 && join('',@VARS) ne join('',lex_sort(@VARS))) {
  678     my %order; foreach my $i (0..$#VARS) {$order{$VARS[$i]} = $i}
  679     @VARS = lex_sort(@VARS);
  680     @limits = map {$limits[$order{$_}]} @VARS;
  681     if ($testPoints) {foreach my $p (@{$testPoints}) {$p = [map {$p->[$order{$_}]} @VARS]}}
  682   }
  683 
  684   $numPoints                = $functNumOfPoints              unless defined $numPoints;
  685   $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration;
  686   $zeroLevel                = $functZeroLevelDefault         unless defined $zeroLevel;
  687   $zeroLevelTol             = $functZeroLevelTolDefault      unless defined $zeroLevelTol;
  688 
  689   $func_params{'var'}                      = \@VARS;
  690         $func_params{'params'}                   = \@PARAMS;
  691   $func_params{'limits'}                   = \@limits;
  692   $func_params{'tolerance'}                = $tol;
  693   $func_params{'tolType'}                  = $tolType;
  694   $func_params{'numPoints'}                = $numPoints;
  695   $func_params{'mode'}                     = $mode;
  696   $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration;
  697   $func_params{'zeroLevel'}                = $zeroLevel;
  698   $func_params{'zeroLevelTol'}             = $zeroLevelTol;
  699 
  700   ########################################################
  701   #   End of cleanup of calling parameters
  702   ########################################################
  703 
  704         my %options = (
  705     debug => $func_params{'debug'},
  706           diagnostics => $func_params{'diagnostics'},
  707         );
  708 
  709   #
  710   #  Initialize the context for the formula
  711   #
  712   my $context = Parser::Context->getCopy($user_context,"LegacyNumeric");
  713   $context->flags->set(
  714     tolerance    => $func_params{'tolerance'},
  715     tolType      => $func_params{'tolType'},
  716     zeroLevel    => $func_params{'zeroLevel'},
  717     zeroLevelTol => $func_params{'zeroLevelTol'},
  718     num_points   => $func_params{'numPoints'},
  719   );
  720   if ($func_params{'mode'} eq 'antider') {
  721     $context->flags->set(max_adapt => $func_params{'maxConstantOfIntegration'});
  722     $options{upToConstant} = 1;
  723   }
  724 
  725   #
  726   #  Add the variables and parameters to the context
  727   #
  728   my %variables; my $x;
  729   foreach $x (@{$func_params{'var'}})    {$variables{$x} = 'Real'}
  730   foreach $x (@{$func_params{'params'}}) {$variables{$x} = 'Parameter'}
  731   $context->variables->are(%variables);
  732 
  733   #
  734   #  Create the Formula object and get its answer checker
  735   #
  736   my $oldContext = &$Context(); &$Context($context);
  737   my $f = new Value::Formula($correctEqn);
  738   $f->{limits}      = $func_params{'limits'};
  739   $f->{test_points} = $func_params{'test_points'};
  740         $f->{correct_ans} = $correctEqn;
  741   my $cmp = $f->cmp(%options);
  742   &$Context($oldContext);
  743 
  744   return $cmp;
  745 }
  746 
  747 #
  748 #  The original version, for backward compatibility
  749 #  (can be removed when the Parser-based version is more fully tested.)
  750 #
  751 sub ORIGINAL_FUNCTION_CMP {
  752   my %func_params = @_;
  753 
  754   my $correctEqn               = $func_params{'correctEqn'};
  755   my $var                      = $func_params{'var'};
  756   my $ra_limits                = $func_params{'limits'};
  757   my $tol                      = $func_params{'tolerance'};
  758   my $tolType                  = $func_params{'tolType'};
  759   my $numPoints                = $func_params{'numPoints'};
  760   my $mode                     = $func_params{'mode'};
  761   my $maxConstantOfIntegration = $func_params{'maxConstantOfIntegration'};
  762   my $zeroLevel                = $func_params{'zeroLevel'};
  763   my $zeroLevelTol             = $func_params{'zeroLevelTol'};
  764   my $ra_test_points           = $func_params{'test_points'};
  765 
  766     # Check that everything is defined:
  767     $func_params{debug} = 0 unless defined $func_params{debug};
  768     $mode = 'std' unless defined $mode;
  769     my @VARS = get_var_array($var);
  770   my @limits = get_limits_array($ra_limits);
  771   my @PARAMS = ();
  772   @PARAMS = @{$func_params{'params'}} if defined $func_params{'params'};
  773 
  774   my @evaluation_points;
  775   if(defined $ra_test_points) {
  776     # see if this is the standard format
  777     if(ref $ra_test_points->[0] eq 'ARRAY') {
  778       $numPoints = scalar @{$ra_test_points->[0]};
  779       # now a little sanity check
  780       my $j;
  781       for $j (@{$ra_test_points}) {
  782         warn "Test points do not give the same number of values for each variable"
  783           unless(scalar(@{$j}) == $numPoints);
  784       }
  785       warn "Test points do not match the number of variables"
  786         unless scalar @{$ra_test_points} == scalar @VARS;
  787     } else { # we are got the one-variable format
  788       $ra_test_points = [$ra_test_points];
  789       $numPoints = scalar $ra_test_points->[0];
  790     }
  791     # The input format for test points is the transpose of what is used
  792     # internally below, so take care of that now.
  793     my ($j1, $j2);
  794     for ($j1 = 0; $j1 < scalar @{$ra_test_points}; $j1++) {
  795       for ($j2 = 0; $j2 < scalar @{$ra_test_points->[$j1]}; $j2++) {
  796         $evaluation_points[$j2][$j1] = $ra_test_points->[$j1][$j2];
  797       }
  798     }
  799   } # end of handling of user supplied evaluation points
  800 
  801   if ($mode eq 'antider') {
  802     # doctor the equation to allow addition of a constant
  803     my $CONSTANT_PARAM = 'Q'; # unfortunately parameters must be single letters.
  804                               # There is the possibility of conflict here.
  805                               #  'Q' seemed less dangerous than  'C'.
  806     $correctEqn = "( $correctEqn ) + $CONSTANT_PARAM";
  807     push @PARAMS, $CONSTANT_PARAM;
  808   }
  809     my $dim_of_param_space = @PARAMS;      # dimension of equivalence space
  810 
  811   if($tolType eq 'relative') {
  812     $tol = $functRelPercentTolDefault unless defined $tol;
  813     $tol *= .01;
  814   } else {
  815     $tol = $functAbsTolDefault unless defined $tol;
  816   }
  817 
  818   #loop ensures that number of limits matches number of variables
  819   for(my $i = 0; $i < scalar @VARS; $i++) {
  820     $limits[$i][0] = $functLLimitDefault unless defined $limits[$i][0];
  821     $limits[$i][1] = $functULimitDefault unless defined $limits[$i][1];
  822   }
  823   $numPoints                = $functNumOfPoints              unless defined $numPoints;
  824   $maxConstantOfIntegration = $functMaxConstantOfIntegration unless defined $maxConstantOfIntegration;
  825   $zeroLevel                = $functZeroLevelDefault         unless defined $zeroLevel;
  826   $zeroLevelTol             = $functZeroLevelTolDefault      unless defined $zeroLevelTol;
  827 
  828   $func_params{'var'}                      = $var;
  829   $func_params{'limits'}                   = \@limits;
  830   $func_params{'tolerance'}                = $tol;
  831   $func_params{'tolType'}                  = $tolType;
  832   $func_params{'numPoints'}                = $numPoints;
  833   $func_params{'mode'}                     = $mode;
  834   $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration;
  835   $func_params{'zeroLevel'}                = $zeroLevel;
  836   $func_params{'zeroLevelTol'}             = $zeroLevelTol;
  837 
  838   ########################################################
  839   #   End of cleanup of calling parameters
  840   ########################################################
  841 
  842   my $i; # for use with loops
  843   my $PGanswerMessage = "";
  844   my $originalCorrEqn = $correctEqn;
  845 
  846   ######################################################################
  847   # prepare the correct answer and check its syntax
  848   ######################################################################
  849 
  850     my $rh_correct_ans = new AnswerHash;
  851   $rh_correct_ans->input($correctEqn);
  852   $rh_correct_ans = check_syntax($rh_correct_ans);
  853   warn  $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
  854   $rh_correct_ans->clear_error();
  855   $rh_correct_ans = function_from_string2($rh_correct_ans,
  856     ra_vars => [ @VARS, @PARAMS ],
  857     stdout  => 'rf_correct_ans',
  858     debug   => $func_params{debug}
  859   );
  860   my $correct_eqn_sub = $rh_correct_ans->{rf_correct_ans};
  861   warn $rh_correct_ans->{error_message} if $rh_correct_ans->{error_flag};
  862 
  863   ######################################################################
  864   # define the points at which the functions are to be evaluated
  865   ######################################################################
  866 
  867   if(not defined $ra_test_points) {
  868     #create the evaluation points
  869     my $random_for_answers = new PGrandom($main::PG_original_problemSeed);
  870     my $NUMBER_OF_STEPS_IN_RANDOM = 1000; # determines the granularity of the random_for_answers number generator
  871     for(my $count = 0; $count < @PARAMS+1+$numPoints; $count++) {
  872         my (@vars,$iteration_limit);
  873       for(my $i = 0; $i < @VARS; $i++) {
  874         my $iteration_limit = 10;
  875         while (0 < --$iteration_limit) {  # make sure that the endpoints of the interval are not included
  876             $vars[$i] = $random_for_answers->random($limits[$i][0], $limits[$i][1], abs($limits[$i][1] - $limits[$i][0])/$NUMBER_OF_STEPS_IN_RANDOM);
  877             last if $vars[$i]!=$limits[$i][0] and $vars[$i]!=$limits[$i][1];
  878         }
  879         warn "Unable to properly choose  evaluation points for this function in the interval ( $limits[$i][0] , $limits[$i][1] )"
  880           if $iteration_limit == 0;
  881       }
  882 
  883       push @evaluation_points, \@vars;
  884     }
  885   }
  886   my $evaluation_points = Matrix->new_from_array_ref(\@evaluation_points);
  887 
  888   #my $COEFFS = determine_param_coeffs($correct_eqn_sub,$evaluation_points[0],$numOfParameters);
  889   #warn "coeff", join(" | ", @{$COEFFS});
  890 
  891   #construct the answer evaluator
  892     my $answer_evaluator = new AnswerEvaluator;
  893     $answer_evaluator->{debug} = $func_params{debug};
  894     $answer_evaluator->ans_hash(
  895     correct_ans       => $originalCorrEqn,
  896     rf_correct_ans    => $rh_correct_ans->{rf_correct_ans},
  897     evaluation_points => \@evaluation_points,
  898     ra_param_vars     => \@PARAMS,
  899     ra_vars           => \@VARS,
  900     type              => 'function',
  901     score             => 0,
  902     );
  903 
  904     #########################################################
  905     # Prepare the previous answer for evaluation, discard errors
  906     #########################################################
  907 
  908   $answer_evaluator->install_pre_filter(
  909     sub {
  910       my $rh_ans = shift;
  911       $rh_ans->{_filter_name} = "fetch_previous_answer";
  912       my $prev_ans_label = "previous_".$rh_ans->{ans_label};
  913       $rh_ans->{prev_ans} = (defined $inputs_ref->{$prev_ans_label} and $inputs_ref->{$prev_ans_label} =~/\S/)
  914         ? $inputs_ref->{$prev_ans_label}
  915         : undef;
  916       $rh_ans;
  917     }
  918   );
  919 
  920   $answer_evaluator->install_pre_filter(
  921     sub {
  922       my $rh_ans = shift;
  923       return $rh_ans unless defined $rh_ans->{prev_ans};
  924       check_syntax($rh_ans,
  925         stdin          => 'prev_ans',
  926         stdout         => 'prev_ans',
  927         error_msg_flag => 0
  928       );
  929       $rh_ans->{_filter_name} = "check_syntax_of_previous_answer";
  930       $rh_ans;
  931     }
  932   );
  933 
  934   $answer_evaluator->install_pre_filter(
  935     sub {
  936       my $rh_ans = shift;
  937       return $rh_ans unless defined $rh_ans->{prev_ans};
  938       function_from_string2($rh_ans,
  939         stdin   => 'prev_ans',
  940         stdout  => 'rf_prev_ans',
  941         ra_vars => \@VARS,
  942         debug   => $func_params{debug}
  943       );
  944       $rh_ans->{_filter_name} = "compile_previous_answer";
  945       $rh_ans;
  946     }
  947   );
  948 
  949     #########################################################
  950     # Prepare the current answer for evaluation
  951     #########################################################
  952 
  953   $answer_evaluator->install_pre_filter(\&check_syntax);
  954   $answer_evaluator->install_pre_filter(\&function_from_string2,
  955     ra_vars => \@VARS,
  956     debug   => $func_params{debug}
  957     ); # @VARS has been guaranteed to be an array, $var might be a single string.
  958 
  959     #########################################################
  960     # Compare the previous and current answer.  Discard errors
  961     #########################################################
  962 
  963   $answer_evaluator->install_evaluator(
  964     sub {
  965       my $rh_ans = shift;
  966       return $rh_ans unless defined $rh_ans->{rf_prev_ans};
  967       calculate_difference_vector($rh_ans,
  968         %func_params,
  969         stdin1         => 'rf_student_ans',
  970         stdin2         => 'rf_prev_ans',
  971         stdout         => 'ra_diff_with_prev_ans',
  972         error_msg_flag => 0,
  973       );
  974       $rh_ans->{_filter_name} = "calculate_difference_vector_of_previous_answer";
  975       $rh_ans;
  976     }
  977   );
  978 
  979   $answer_evaluator->install_evaluator(
  980     sub {
  981       my $rh_ans = shift;
  982       return $rh_ans unless defined $rh_ans->{ra_diff_with_prev_ans};
  983       ##
  984       ## DPVC -- only give the message if the answer is specified differently
  985       ##
  986       return $rh_ans if $rh_ans->{prev_ans} eq $rh_ans->{student_ans};
  987       ##
  988       ## /DPVC
  989       ##
  990       is_zero_array($rh_ans,
  991         stdin  => 'ra_diff_with_prev_ans',
  992         stdout => 'ans_equals_prev_ans'
  993       );
  994     }
  995   );
  996 
  997     #########################################################
  998     # Calculate values for approximation parameters and
  999     # compare the current answer with the correct answer.  Keep errors this time.
 1000     #########################################################
 1001 
 1002     $answer_evaluator->install_pre_filter(\&best_approx_parameters, %func_params, param_vars => \@PARAMS);
 1003     $answer_evaluator->install_evaluator(\&calculate_difference_vector, %func_params);
 1004     $answer_evaluator->install_evaluator(\&is_zero_array, tolerance => $tol );
 1005 
 1006     $answer_evaluator->install_post_filter(
 1007       sub {
 1008         my $rh_ans = shift;
 1009         $rh_ans->clear_error('SYNTAX');
 1010         $rh_ans;
 1011       }
 1012     );
 1013 
 1014   $answer_evaluator->install_post_filter(
 1015     sub {
 1016       my $rh_ans = shift;
 1017       if ($rh_ans->catch_error('EVAL')) {
 1018         $rh_ans->{ans_message} = $rh_ans->{error_message};
 1019         $rh_ans->clear_error('EVAL');
 1020       }
 1021       $rh_ans;
 1022     }
 1023   );
 1024 
 1025   #
 1026   #  Show a message when the answer is equivalent to the previous answer.
 1027   #
 1028   #  We want to show the message when we're not in preview mode AND the
 1029   #  answers are equivalent AND the answers are not identical. We DON'T CARE
 1030   #  whether the answers are correct or not, because that leaks information in
 1031   #  multipart questions when $showPartialCorrectAnswers is off.
 1032   #
 1033   $answer_evaluator->install_post_filter(
 1034     sub {
 1035       my $rh_ans = shift;
 1036 
 1037       my $isPreview = $inputs_ref->{previewAnswers} || ($inputs_ref->{action} =~ m/^Preview/);
 1038       return $rh_ans unless !$isPreview # not preview mode
 1039         and $rh_ans->{ans_equals_prev_ans} # equivalent
 1040         and $rh_ans->{prev_ans} ne $rh_ans->{original_student_ans}; # not identical
 1041 
 1042       $rh_ans->{ans_message} = "This answer is equivalent to the one you just submitted.";
 1043       return $rh_ans;
 1044     }
 1045   );
 1046 
 1047   $answer_evaluator;
 1048 }
 1049 
 1050 =head1 SEE ALSO
 1051 
 1052 L<PGanswermacros.pl>, L<MathObjects>.
 1053 
 1054 =cut
 1055 
 1056 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9