[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 109 Revision 110
1587 my $correctAnswer = shift @_; 1587 my $correctAnswer = shift @_;
1588 my %opt = @_; 1588 my %opt = @_;
1589 1589
1590 assign_option_aliases( \%opt, 1590 assign_option_aliases( \%opt,
1591 'vars' => 'var', # set the standard option 'var' to the one specified as vars 1591 'vars' => 'var', # set the standard option 'var' to the one specified as vars
1592 'domain' => 'limits', # set the standard option 'limits' to the one specified as domain 1592 'domain' => 'limits', # set the standard option 'limits' to the one specified as domain
1593 'reltol' => 'relTol', 1593 'reltol' => 'relTol',
1594 'param' => 'params', 1594 'param' => 'params',
1595 ); 1595 );
1596 1596
1597 set_default_options( \%opt, 1597 set_default_options( \%opt,
1598 'var' => $functVarDefault, 1598 'var' => $functVarDefault,
1599 'params' => [], 1599 'params' => [],
1600 'limits' => [[$functLLimitDefault, $functULimitDefault]], 1600 'limits' => [[$functLLimitDefault, $functULimitDefault]],
1601 'mode' => 'std', 1601 'mode' => 'std',
1602 'tolType' => (defined($opt{tol}) ) ? 'absolute' : 'relative', 1602 'tolType' => (defined($opt{tol}) ) ? 'absolute' : 'relative',
1603 'tol' => .01, # default mode should be relative, to obtain this tol must not be defined 1603 'tol' => .01, # default mode should be relative, to obtain this tol must not be defined
1604 'relTol' => $functRelPercentTolDefault, 1604 'relTol' => $functRelPercentTolDefault,
1605 'numPoints' => $functNumOfPoints, 1605 'numPoints' => $functNumOfPoints,
1606 'maxConstantOfIntegration' => $functMaxConstantOfIntegration, 1606 'maxConstantOfIntegration' => $functMaxConstantOfIntegration,
1607 'zeroLevel' => $functZeroLevelDefault, 1607 'zeroLevel' => $functZeroLevelDefault,
1608 'zeroLevelTol' => $functZeroLevelTolDefault, 1608 'zeroLevelTol' => $functZeroLevelTolDefault,
1609 'debug' => 0, 1609 'debug' => 0,
1610 ); 1610 );
1611 1611
1612 # allow var => 'x' as an abbreviation for var => ['x'] 1612 # allow var => 'x' as an abbreviation for var => ['x']
1613 my %out_options = %opt; 1613 my %out_options = %opt;
1614 unless ( ref($out_options{var}) eq 'ARRAY' ) { 1614 unless ( ref($out_options{var}) eq 'ARRAY' ) {
1641 } 1641 }
1642 1642
1643 # produce answer evaluators 1643 # produce answer evaluators
1644 foreach my $ans (@ans_list) { 1644 foreach my $ans (@ans_list) {
1645 push(@output_list, 1645 push(@output_list,
1646 FUNCTION_CMP(
1646 FUNCTION_CMP( 'correctEqn' => $ans, 1647 'correctEqn' => $ans,
1647 'var' => $out_options{'var'}, 1648 'var' => $out_options{'var'},
1648 'limits' => $out_options{'limits'}, 1649 'limits' => $out_options{'limits'},
1649 'tolerance' => $tol, 1650 'tolerance' => $tol,
1650 'tolType' => $tolType, 1651 'tolType' => $tolType,
1651 'numPoints' => $out_options{'numPoints'}, 1652 'numPoints' => $out_options{'numPoints'},
1652 'mode' => $out_options{'mode'}, 1653 'mode' => $out_options{'mode'},
1653 'maxConstantOfIntegration' => $out_options{'maxConstantOfIntegration'}, 1654 'maxConstantOfIntegration' => $out_options{'maxConstantOfIntegration'},
1654 'zeroLevel' => $out_options{'zeroLevel'}, 1655 'zeroLevel' => $out_options{'zeroLevel'},
1655 'zeroLevelTol' => $out_options{'zeroLevelTol'}, 1656 'zeroLevelTol' => $out_options{'zeroLevelTol'},
1656 'params' => $out_options{'params'}, 1657 'params' => $out_options{'params'},
1657 'debug' => $out_options{'debug'}, 1658 'debug' => $out_options{'debug'},
1658 ), 1659 ),
1659 ); 1660 );
1660 } 1661 }
2090=cut 2091=cut
2091 2092
2092sub std_num_array_filter { 2093sub std_num_array_filter {
2093 my $rh_ans= shift; 2094 my $rh_ans= shift;
2094 my %options = @_; 2095 my %options = @_;
2096 set_default_options( \%options,
2097 '_filter_name' => 'std_num_array_filter',
2098 );
2095 my @in = @{$rh_ans->{student_ans}}; 2099 my @in = @{$rh_ans->{student_ans}};
2096 my $temp_hash = new AnswerHash; 2100 my $temp_hash = new AnswerHash;
2097 my @out=(); 2101 my @out=();
2098 my $PGanswerMessage = ''; 2102 my $PGanswerMessage = '';
2099 foreach my $item (@in) { # evaluate each number in the vector 2103 foreach my $item (@in) { # evaluate each number in the vector
2123} 2127}
2124 2128
2125sub function_from_string2 { 2129sub function_from_string2 {
2126 my $rh_ans = shift; 2130 my $rh_ans = shift;
2127 my %options = @_; 2131 my %options = @_;
2128 my $eqn = $rh_ans->{student_ans}; 2132 my $eqn = $rh_ans->{student_ans};
2133 assign_option_aliases(\%options,
2134 'vars' => 'ra_vars',
2135 'var' => 'ra_vars',
2136 );
2129 set_default_options( \%options, 2137 set_default_options( \%options,
2130 'store_in' => 'rf_student_ans', 2138 'store_in' => 'rf_student_ans',
2131 'ra_vars' => [qw( x y )], 2139 'ra_vars' => [qw( x y )],
2132 'debug' => 0, 2140 'debug' => 0,
2141 '_filter_name' => 'function_from_string2',
2133 ); 2142 );
2143 $rh_ans->{_filter_name} = $options{_filter_name};
2134 my @VARS = @{ $options{ 'ra_vars'}}; 2144 my @VARS = @{ $options{ 'ra_vars'}};
2135 warn "VARS = ", join("<>", @VARS) if defined($options{debug}) and $options{debug} ==1; 2145 #warn "VARS = ", join("<>", @VARS) if defined($options{debug}) and $options{debug} ==1;
2136 my $originalEqn = $eqn; 2146 my $originalEqn = $eqn;
2137 $eqn = &math_constants($eqn); 2147 $eqn = &math_constants($eqn);
2138 for( my $i = 0; $i < @VARS; $i++ ) { 2148 for( my $i = 0; $i < @VARS; $i++ ) {
2139 # This next line is a hack required for 5.6.0 -- it doesn't appear to be needed in 5.6.1 2149 # This next line is a hack required for 5.6.0 -- it doesn't appear to be needed in 5.6.1
2140 my ($temp,$er1,$er2) = PG_restricted_eval('"'. $VARS[$i] . '"'); 2150 my ($temp,$er1,$er2) = PG_restricted_eval('"'. $VARS[$i] . '"');
2141 #$eqn =~ s/\b$VARS[$i]\b/\$VARS[$i]/g; 2151 #$eqn =~ s/\b$VARS[$i]\b/\$VARS[$i]/g;
2142 $eqn =~ s/\b$temp\b/\$VARS[$i]/g; 2152 $eqn =~ s/\b$temp\b/\$VARS[$i]/g;
2143 2153
2144 } 2154 }
2145 warn "equation evaluated = $eqn",$rh_ans->pretty_print(), "<br>\noptions<br>\n", 2155 #warn "equation evaluated = $eqn",$rh_ans->pretty_print(), "<br>\noptions<br>\n",
2146 pretty_print(\%options) 2156 # pretty_print(\%options)
2147 if defined($options{debug}) and $options{debug} ==1; 2157 # if defined($options{debug}) and $options{debug} ==1;
2148 my ($function_sub,$PG_eval_errors, $PG_full_errors) = PG_answer_eval( q! 2158 my ($function_sub,$PG_eval_errors, $PG_full_errors) = PG_answer_eval( q!
2149 sub { 2159 sub {
2150 my @VARS = @_; 2160 my @VARS = @_;
2151 my $input_str = ''; 2161 my $input_str = '';
2152 for( my $i=0; $i<@VARS; $i++ ) { 2162 for( my $i=0; $i<@VARS; $i++ ) {
2197 2207
2198 2208
2199sub is_zero_array { 2209sub is_zero_array {
2200 my $rh_ans = shift; 2210 my $rh_ans = shift;
2201 my %options = @_; 2211 my %options = @_;
2212 set_default_options( \%options,
2213 '_filter_name' => 'is_zero_array',
2214 );
2202 my $array = $rh_ans -> {ra_differences}; 2215 my $array = $rh_ans -> {ra_differences};
2203 my $num = @$array; 2216 my $num = @$array;
2204 my $i; 2217 my $i;
2205 my $max = 0; my $mm; 2218 my $max = 0; my $mm;
2206 for ($i=0; $i< $num; $i++) { 2219 for ($i=0; $i< $num; $i++) {
2272=cut 2285=cut
2273 2286
2274sub best_approx_parameters { 2287sub best_approx_parameters {
2275 my $rh_ans = shift; 2288 my $rh_ans = shift;
2276 my %options = @_; 2289 my %options = @_;
2290 set_default_options(\%options,
2291 '_filter_name' => 'best_approx_paramters',
2292 'allow_unknown_options' => 1,
2293 );
2277 my $errors = undef; 2294 my $errors = undef;
2278 # This subroutine for the determining the coefficents of the parameters at a given point 2295 # This subroutine for the determining the coefficents of the parameters at a given point
2279 # is pretty specialized, so it is included here as a sub-subroutine. 2296 # is pretty specialized, so it is included here as a sub-subroutine.
2280 my $determine_param_coeffs = sub { 2297 my $determine_param_coeffs = sub {
2281 my ($rf_fun, $ra_variables, $dim_of_params_space, %options) =@_; 2298 my ($rf_fun, $ra_variables, $dim_of_params_space, %options) =@_;
2282 my @zero_params=(); 2299 my @zero_params=();
2283 for(my $i=1;$i<=$dim_of_params_space;$i++){push(@zero_params,0); } 2300 for(my $i=1;$i<=$dim_of_params_space;$i++){push(@zero_params,0); }
2284 my @vars = @$ra_variables; 2301 my @vars = @$ra_variables;
2285 my @coeff = (); 2302 my @coeff = ();
2286 my @inputs = (@vars,@zero_params); 2303 my @inputs = (@vars,@zero_params);
2287 my ($f0, $f1, $err); 2304 my ($f0, $f1, $err);
2288 ($f0, $err) = &{$rf_fun}(@inputs); 2305 ($f0, $err) = &{$rf_fun}(@inputs);
2289 if (defined($err) ) { 2306 if (defined($err) ) {
2290 $errors .= "$err "; 2307 $errors .= "$err ";
2291 } else { 2308 } else {
2292 for (my $i=@vars;$i<@inputs;$i++) { 2309 for (my $i=@vars;$i<@inputs;$i++) {
2293 $inputs[$i]=1; # set one parameter to 1; 2310 $inputs[$i]=1; # set one parameter to 1;
2294 my($f1,$err) = &$rf_fun(@inputs); 2311 my($f1,$err) = &$rf_fun(@inputs);
2295 if (defined($err) ) { 2312 if (defined($err) ) {
2296 $errors .= " $err "; 2313 $errors .= " $err ";
2297 } else { 2314 } else {
2298 push(@coeff, $f1-$f0); 2315 push(@coeff, $f1-$f0);
2316 }
2317 $inputs[$i]=0; # set it back
2299 } 2318 }
2300 $inputs[$i]=0; # set it back
2301 } 2319 }
2302 }
2303 (\@coeff, $errors); 2320 (\@coeff, $errors);
2304 }; 2321 };
2305 my $rf_fun = $rh_ans->{rf_student_ans}; 2322 my $rf_fun = $rh_ans->{rf_student_ans};
2306 my $rf_correct_fun = $rh_ans->{rf_correct_ans}; 2323 my $rf_correct_fun = $rh_ans->{rf_correct_ans};
2307 my $ra_vars_matrix = $rh_ans->{evaluation_points}; 2324 my $ra_vars_matrix = $rh_ans->{evaluation_points};
2308 my $dim_of_param_space = @{$options{param_vars}}; 2325 my $dim_of_param_space = @{$options{param_vars}};
2309 # Short cut. Bail if there are no param_vars 2326 # Short cut. Bail if there are no param_vars
2310 unless ($dim_of_param_space >0) { 2327 unless ($dim_of_param_space >0) {
2311 $rh_ans ->{ra_parameters} = []; 2328 $rh_ans ->{ra_parameters} = [];
2312 return $rh_ans; 2329 return $rh_ans;
2313 } 2330 }
2314 # inputs are row arrays in this case. 2331 # inputs are row arrays in this case.
2315 my @zero_params=(); 2332 my @zero_params=();
2316 2333
2317 for(my $i=1;$i<=$dim_of_param_space;$i++){push(@zero_params,0); } 2334 for(my $i=1;$i<=$dim_of_param_space;$i++){push(@zero_params,0); }
2318 my @rows_of_vars = @$ra_vars_matrix; 2335 my @rows_of_vars = @$ra_vars_matrix;
2319 warn "input rows ", pretty_print(\@rows_of_vars) if defined($options{debug}) and $options{debug}; 2336 warn "input rows ", pretty_print(\@rows_of_vars) if defined($options{debug}) and $options{debug};
2320 my $rows = @rows_of_vars; 2337 my $rows = @rows_of_vars;
2321 my $matrix =new Matrix($rows,$dim_of_param_space); 2338 my $matrix =new Matrix($rows,$dim_of_param_space);
2322 my $rhs_vec = new Matrix($rows, 1); 2339 my $rhs_vec = new Matrix($rows, 1);
2323 my $row_num = 1; 2340 my $row_num = 1;
2324 my ($ra_coeff,$val2, $val1, $err1,$err2,@inputs,@vars); 2341 my ($ra_coeff,$val2, $val1, $err1,$err2,@inputs,@vars);
2325 my $number_of_data_points = $dim_of_param_space +2; 2342 my $number_of_data_points = $dim_of_param_space +2;
2326 while (@rows_of_vars and $row_num <= $number_of_data_points) { 2343 while (@rows_of_vars and $row_num <= $number_of_data_points) {
2327 # get one set of data points from the test function; 2344 # get one set of data points from the test function;
2328 @vars = @{ shift(@rows_of_vars) }; 2345 @vars = @{ shift(@rows_of_vars) };
2329 ($val2, $err1) = &{$rf_fun}(@vars); 2346 ($val2, $err1) = &{$rf_fun}(@vars);
2330 $errors .= " $err1 " if defined($err1); 2347 $errors .= " $err1 " if defined($err1);
2331 @inputs = (@vars,@zero_params); 2348 @inputs = (@vars,@zero_params);

Legend:
Removed from v.109  
changed lines
  Added in v.110

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9