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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 4 Revision 5
1#!/usr/bin/perl 1#!/usr/local/bin/perl -w
2 2
3# This file is PGanswermacros.pl 3# This file is PGanswermacros.pl
4# This includes the subroutines for the ANS macros, that 4# This includes the subroutines for the ANS macros, that
5# is, macros allowing a more flexible answer checking 5# is, macros allowing a more flexible answer checking
6#################################################################### 6####################################################################
… …
106=cut 106=cut
107 107
108BEGIN { 108BEGIN {
109 be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix. 109 be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
110} 110}
111my ($BR , # convenient localizations.
112 $PAR ,
113 $numRelPercentTolDefault ,
114 $numZeroLevelDefault ,
115 $numZeroLevelTolDefault ,
116 $numAbsTolDefault ,
117 $numFormatDefault ,
118 $functRelPercentTolDefault ,
119 $functZeroLevelDefault ,
120 $functZeroLevelTolDefault ,
121 $functAbsTolDefault ,
122 $functNumOfPoints ,
123 $functVarDefault ,
124 $functLLimitDefault ,
125 $functULimitDefault ,
126 $functMaxConstantOfIntegration
127);
111 128
129sub _PGanswermacros_init {
130
112my $BR = $main::BR; # convenient localizations. 131 $BR = $main::BR; # convenient localizations.
113my $PAR = $main::PAR; 132 $PAR = $main::PAR;
114 133
115# import defaults 134 # import defaults
116# these are now imported from the %envir variable 135 # these are now imported from the %envir variable
117my $numRelPercentTolDefault = $main::numRelPercentTolDefault; 136 $numRelPercentTolDefault = $main::numRelPercentTolDefault;
118my $numZeroLevelDefault = $main::numZeroLevelDefault; 137 $numZeroLevelDefault = $main::numZeroLevelDefault;
119my $numZeroLevelTolDefault = $main::numZeroLevelTolDefault; 138 $numZeroLevelTolDefault = $main::numZeroLevelTolDefault;
120my $numAbsTolDefault = $main::numAbsTolDefault; 139 $numAbsTolDefault = $main::numAbsTolDefault;
121my $numFormatDefault = $main::numFormatDefault; 140 $numFormatDefault = $main::numFormatDefault;
122 141
123my $functRelPercentTolDefault = $main::functRelPercentTolDefault; 142 $functRelPercentTolDefault = $main::functRelPercentTolDefault;
124my $functZeroLevelDefault = $main::functZeroLevelDefault; 143 $functZeroLevelDefault = $main::functZeroLevelDefault;
125my $functZeroLevelTolDefault = $main::functZeroLevelTolDefault; 144 $functZeroLevelTolDefault = $main::functZeroLevelTolDefault;
126my $functAbsTolDefault = $main::functAbsTolDefault; 145 $functAbsTolDefault = $main::functAbsTolDefault;
127my $functNumOfPoints = $main::functNumOfPoints; 146 $functNumOfPoints = $main::functNumOfPoints;
128my $functVarDefault = $main::functVarDefault; 147 $functVarDefault = $main::functVarDefault;
129my $functLLimitDefault = $main::functLLimitDefault; 148 $functLLimitDefault = $main::functLLimitDefault;
130my $functULimitDefault = $main::functULimitDefault; 149 $functULimitDefault = $main::functULimitDefault;
131my $functMaxConstantOfIntegration = $main::functMaxConstantOfIntegration; 150 $functMaxConstantOfIntegration = $main::functMaxConstantOfIntegration;
132 151
133 152}
153_PGanswermacros_init();
134 154
135########################################################################## 155##########################################################################
136########################################################################## 156##########################################################################
137## Number answer evaluators 157## Number answer evaluators
138 158
… …
1004 $out_options{'format'}, 1024 $out_options{'format'},
1005 $out_options{'zeroLevel'}, 1025 $out_options{'zeroLevel'},
1006 $out_options{'zeroLevelTol'} 1026 $out_options{'zeroLevelTol'}
1007 ) 1027 )
1008 ); 1028 );
1009 }
1010 else { 1029 } else {
1011 push(@output_list, 1030 push(@output_list,
1012 NUM_CMP( 'correctAnswer' => $ans, 1031 NUM_CMP( 'correctAnswer' => $ans,
1013 'tolerance' => $tol, 1032 'tolerance' => $tol,
1014 'tolType' => $tolType, 1033 'tolType' => $tolType,
1015 'format' => $out_options{'format'}, 1034 'format' => $out_options{'format'},
… …
1052 my $zeroLevelTol = $num_params{'zeroLevelTol'}; 1071 my $zeroLevelTol = $num_params{'zeroLevelTol'};
1053 1072
1054 if( $tolType eq 'relative' ) { 1073 if( $tolType eq 'relative' ) {
1055 $tol = $numRelPercentTolDefault unless defined $tol; 1074 $tol = $numRelPercentTolDefault unless defined $tol;
1056 $tol *= .01; 1075 $tol *= .01;
1057 } 1076
1058 else { 1077 } else {
1059 $tol = $numAbsTolDefault unless defined $tol; 1078 $tol = $numAbsTolDefault unless defined $tol;
1060 } 1079 }
1061 $format = $numFormatDefault unless defined $format; 1080 $format = $numFormatDefault unless defined $format;
1062 $mode = 'std' unless defined $mode; 1081 $mode = 'std' unless defined $mode;
1063 $zeroLevel = $numZeroLevelDefault unless defined $zeroLevel; 1082 $zeroLevel = $numZeroLevelDefault unless defined $zeroLevel;
… …
1876 $func_params{'numPoints'}= $numPoints; 1895 $func_params{'numPoints'}= $numPoints;
1877 $func_params{'mode'} = $mode; 1896 $func_params{'mode'} = $mode;
1878 $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration; 1897 $func_params{'maxConstantOfIntegration'} = $maxConstantOfIntegration;
1879 $func_params{'zeroLevel'} = $zeroLevel; 1898 $func_params{'zeroLevel'} = $zeroLevel;
1880 $func_params{'zeroLevelTol'} = $zeroLevelTol; 1899 $func_params{'zeroLevelTol'} = $zeroLevelTol;
1881 1900########################################################
1901# End of cleanup of calling parameters
1902########################################################
1882 my $i; #for use with loops 1903 my $i; #for use with loops
1883 my $PGanswerMessage = ""; 1904 my $PGanswerMessage = "";
1884 my $originalCorrEqn = $correctEqn; 1905 my $originalCorrEqn = $correctEqn;
1885 1906
1886#prepare the correct answer and check it's syntax 1907#prepare the correct answer and check it's syntax
… …
2179 my $error = "WeBWorK was unable evaluate your function. Please check that your 2200 my $error = "WeBWorK was unable evaluate your function. Please check that your
2180 expression doesn't take roots of negative numbers, or divide by zero."; 2201 expression doesn't take roots of negative numbers, or divide by zero.";
2181 $rh_ans->throw_error('EVAL',$error); 2202 $rh_ans->throw_error('EVAL',$error);
2182 } else { 2203 } else {
2183 my $tol = $options{tol} if defined($options{tol}); 2204 my $tol = $options{tol} if defined($options{tol});
2184 $tol = 0.01*$options{reltol} if defined($options{reltol}); 2205 #$tol = 0.01*$options{reltol} if defined($options{reltol});
2185 $tol = .000001 unless defined($tol); 2206 $tol = .000001 unless defined($tol);
2186 2207
2187 $rh_ans->{score} = ($max <$tol) ? 1: 0; # 1 if the array is close to 0; 2208 $rh_ans->{score} = ($max <$tol) ? 1: 0; # 1 if the array is close to 0;
2188 } 2209 }
2189 $rh_ans; 2210 $rh_ans;
… …
2273 my $rf_correct_fun = $rh_ans->{rf_correct_ans}; 2294 my $rf_correct_fun = $rh_ans->{rf_correct_ans};
2274 my $ra_vars_matrix = $rh_ans->{evaluation_points}; 2295 my $ra_vars_matrix = $rh_ans->{evaluation_points};
2275 my $dim_of_param_space = @{$options{param_vars}}; 2296 my $dim_of_param_space = @{$options{param_vars}};
2276 # Short cut. Bail if there are no param_vars 2297 # Short cut. Bail if there are no param_vars
2277 unless ($dim_of_param_space >0) { 2298 unless ($dim_of_param_space >0) {
2278 $rh_ans ->{ra_paramters} = []; 2299 $rh_ans ->{ra_parameters} = [];
2279 return $rh_ans; 2300 return $rh_ans;
2280 } 2301 }
2281 # inputs are row arrays in this case. 2302 # inputs are row arrays in this case.
2282 my @zero_params=(); 2303 my @zero_params=();
2283 2304
… …
2315 while(@coeff) { 2336 while(@coeff) {
2316 $matrix->assign($row_num,$col_num, shift(@coeff) ); 2337 $matrix->assign($row_num,$col_num, shift(@coeff) );
2317 $col_num++; 2338 $col_num++;
2318 } 2339 }
2319 } 2340 }
2320 # which might be useful for functions that are not defined at some points. 2341
2321 } 2342 }
2322 $row_num++; 2343 $row_num++;
2323 last if $errors; # break if there are any errors. 2344 last if $errors; # break if there are any errors.
2324 # This cuts down on the size of error messages. 2345 # This cuts down on the size of error messages.
2325 # However it impossible to check for equivalence at 95% of points 2346 # However it impossible to check for equivalence at 95% of points
2326 2347 # which might be useful for functions that are not defined at some points.
2327 } 2348 }
2328 warn "<br> best_approx_parameters: matrix1 <br> ", " $matrix " if $options{debug}; 2349 warn "<br> best_approx_parameters: matrix1 <br> ", " $matrix " if $options{debug};
2329 warn "<br> best_approx_parameters: vector <br> ", " $rhs_vec " if $options{debug}; 2350 warn "<br> best_approx_parameters: vector <br> ", " $rhs_vec " if $options{debug};
2330 2351
2331 # we have Matrix * parameter = data_vec + perpendicular vector 2352 # we have Matrix * parameter = data_vec + perpendicular vector
… …
2390 my $ra_parameters = $rh_ans ->{ra_parameters}; 2411 my $ra_parameters = $rh_ans ->{ra_parameters};
2391 my @evaluation_points = @{$rh_ans->{evaluation_points} }; 2412 my @evaluation_points = @{$rh_ans->{evaluation_points} };
2392 my @parameters = (); 2413 my @parameters = ();
2393 @parameters = @$ra_parameters if defined($ra_parameters) and ref($ra_parameters) eq 'ARRAY'; 2414 @parameters = @$ra_parameters if defined($ra_parameters) and ref($ra_parameters) eq 'ARRAY';
2394 my $errors = undef; 2415 my $errors = undef;
2416 my @zero_params=();
2417 for(my $i=1;$i<=@{$ra_parameters};$i++){push(@zero_params,0); }
2395 my @differences = (); 2418 my @differences = ();
2396 my $diff; 2419 my @student_values;
2420 my @correct_values;
2421 my @tol_values;
2422 my ($diff,$tol_val);
2397 # calculate the vector of differences between the test function and the comparison function. 2423 # calculate the vector of differences between the test function and the comparison function.
2398 while (@evaluation_points) { 2424 while (@evaluation_points) {
2399 my ($err1, $err2); 2425 my ($err1, $err2,$err3);
2400 my @vars = @{ shift(@evaluation_points) }; 2426 my @vars = @{ shift(@evaluation_points) };
2401 my @inputs = (@vars, @parameters); 2427 my @inputs = (@vars, @parameters);
2402 my ($inVal, $correctVal); 2428 my ($inVal, $correctVal);
2403 ($inVal, $err1) = &{$rf_fun}(@vars); 2429 ($inVal, $err1) = &{$rf_fun}(@vars);
2404 $errors .= " $err1 " if defined($err1); 2430 $errors .= " $err1 " if defined($err1);
2405 $errors .= " Error detected evaluating student input at @vars " if defined($options{debug}) and $options{debug}=1 and defined($err1); 2431 $errors .= " Error detected evaluating student input at (".join(' , ',@vars) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err1);
2406 ($correctVal, $err2) =&{$rf_correct_fun}(@inputs); 2432 ($correctVal, $err2) =&{$rf_correct_fun}(@inputs);
2407 $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err2 " if defined($err2); 2433 $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err2 " if defined($err2);
2408 $errors .= " Error detected evaluating correct answer at @inputs " if defined($options{debug}) and $options{debug}=1 and defined($err2); 2434 $errors .= " Error detected evaluating correct answer at (".join(' , ',@inputs) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err2);
2435 ($tol_val,$err3)= &$rf_correct_fun(@vars, @zero_params);
2436 $errors .= " There is an error in WeBWorK's answer to this problem, please alert your instructor.<br> $err3 " if defined($err3);
2437 $errors .= " Error detected evaluating correct answer at (".join(' , ',@vars, @zero_params) ." ) " if defined($options{debug}) and $options{debug}=1 and defined($err3);
2409 unless (defined($err1) or defined($err2) ) { 2438 unless (defined($err1) or defined($err2) or defined($err3) ) {
2410 $diff = $inVal - $correctVal; 2439 $diff = ( $inVal - ($correctVal -$tol_val ) ) - $tol_val; #prevents entering too high a number?
2411 #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff; 2440 #warn "taking the difference of ", $inVal, " and ", $correctVal, " is ", $diff;
2412 2441
2413 if (defined($options{tolType}) and $options{tolType} eq 'relative' ) { #relative tolerance 2442 if (defined($options{tolType}) and $options{tolType} eq 'relative' ) { #relative tolerance
2414 $diff = $diff/abs( &$rf_correct_fun(@inputs) ) if $correctVal > $options{zeroLevel}; 2443 #warn "diff = $diff";
2444
2445 $diff = abs(( $inVal - ($correctVal-$tol_val ) )/$tol_val -1 ) if abs($tol_val) > $options{zeroLevel};
2446 #$diff = ( $inVal - ($correctVal-$tol_val- $tol_val ) )/abs($tol_val) if abs($tol_val) > $options{zeroLevel};
2447 #warn "diff = $diff, ", abs( &$rf_correct_fun(@inputs) ) , "-- $correctVal";
2415 } 2448 }
2416 } 2449 }
2417 last if $errors; # break if there are any errors. 2450 last if $errors; # break if there are any errors.
2418 # This cuts down on the size of error messages. 2451 # This cuts down on the size of error messages.
2419 # However it impossible to check for equivalence at 95% of points 2452 # However it impossible to check for equivalence at 95% of points
2420 # which might be useful for functions that are not defined at some points. 2453 # which might be useful for functions that are not defined at some points.
2454 push(@student_values,$inVal);
2455 push(@correct_values,( $inVal - ($correctVal-$tol_val ) ));
2421 push(@differences, $diff); 2456 push(@differences, $diff);
2457 push(@tol_values,$tol_val);
2422 } 2458 }
2423 $rh_ans ->{ra_differences} = \@differences; 2459 $rh_ans ->{ra_differences} = \@differences;
2460 $rh_ans ->{ra_student_values} = \@student_values; # values from student function
2461 $rh_ans ->{ra_adjusted_instructor_values} = \@correct_values; #values
2462 $rh_ans->{ra_instructor_values}=\@tol_values;
2424 $rh_ans->throw_error('EVAL', $errors) if defined($errors); 2463 $rh_ans->throw_error('EVAL', $errors) if defined($errors);
2425 $rh_ans; 2464 $rh_ans;
2426} 2465}
2427 2466
2428 2467
… …
3152 $problem_result{score} = $allAnswersCorrectQ; 3191 $problem_result{score} = $allAnswersCorrectQ;
3153 3192
3154 # I don't like to put in this bit of code. 3193 # I don't like to put in this bit of code.
3155 # It makes it hard to construct error free problem graders 3194 # It makes it hard to construct error free problem graders
3156 # I would prefer to know that the problem score was numeric. 3195 # I would prefer to know that the problem score was numeric.
3157 unless ($problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) { 3196 unless (defined($problem_state{recorded_score}) and $problem_state{recorded_score} =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) {
3158 $problem_state{recorded_score} = 0; # This gets rid of non-numeric scores 3197 $problem_state{recorded_score} = 0; # This gets rid of non-numeric scores
3159 } 3198 }
3160 # 3199 #
3161 if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) { 3200 if ($allAnswersCorrectQ == 1 or $problem_state{recorded_score} == 1) {
3162 $problem_state{recorded_score} = 1; 3201 $problem_state{recorded_score} = 1;
… …
3535 3574
3536 $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828... 3575 $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828...
3537 } 3576 }
3538 else { 3577 else {
3539 $out = $number; 3578 $out = $number;
3579 $out =~ s/e/E/g; # only use capital E's for exponents. Little e is for 2.71828...
3540 } 3580 }
3541 3581
3542 return $out; 3582 return $out;
3543} 3583}
3544 3584
… …
3579# Use this to set default options 3619# Use this to set default options
3580sub set_default_options { 3620sub set_default_options {
3581 my $rh_options = shift; 3621 my $rh_options = shift;
3582 warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH'; 3622 warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
3583 my %default_options = @_; 3623 my %default_options = @_;
3624 unless ( defined($default_options{allow_unknown_options}) and $default_options{allow_unknown_options} == 1 ) {
3584 foreach my $key (keys %$rh_options) { 3625 foreach my $key1 (keys %$rh_options) {
3585 warn "This option |$key| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key}); 3626 warn "This option |$key1| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key1});
3627 }
3586 } 3628 }
3587 foreach my $key (keys %default_options) { 3629 foreach my $key (keys %default_options) {
3588 if ( not defined($rh_options->{$key} ) and defined( $default_options{$key} ) ) { 3630 if ( not defined($rh_options->{$key} ) and defined( $default_options{$key} ) ) {
3589 $rh_options->{$key} = $default_options{$key}; #this allows tol => undef to allow the tol option, but doesn't define 3631 $rh_options->{$key} = $default_options{$key}; # using 'defined' instead of 'exists' allows
3632 # tol => undef to allow the tol option, but doesn't define
3590 # this key unless tol is explicitly defined. 3633 # this key unless tol is explicitly defined.
3591 } 3634 }
3592 } 3635 }
3593} 3636}
3594# Use this to assign aliases for the standard options 3637# Use this to assign aliases for the standard options
Legend:
Removed from v.4  
changed lines
  Added in v.5
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9