|
rungeKutta4a
Answer checker filter for comparing to an integral curve of a vector field.
=cut
sub rungeKutta4a {
my $rh_ans = shift;
my %options = @_;
my $rf_fun = $rh_ans->{rf_diffeq};
set_default_options( \%options,
'initial_t' => 1,
'initial_y' => 1,
'dt' => .01,
'num_of_points' => 10, #number of reported points
'interior_points' => 5, # number of 'interior' steps
between reported points
'debug' => 1, # remind programmers to always
pass the debug parameter
);
my $t = $options{initial_t};
my $y = $options{initial_y};
my $num = $options{'num_of_points'}; # number of points
my $num2 = $options{'interior_points'}; # number of steps between points.
my $dt = $options{'dt'};
my $errors = undef;
my $rf_rhs = sub { my @in = @_;
my ( $out, $err) = &$rf_fun(@in);
$errors .= " $err at ( ".join(" , ", @in) . " )<br>\n" if defined($err);
$out = 'NaN' if defined($err) and not is_a_number($out);
$out;
};
my @output = ([$t, $y]);
my ($i, $j, $K1,$K2,$K3,$K4);
for ($j=0; $j<$num; $j++) {
for ($i=0; $i<$num2; $i++) {
$K1 = $dt*&$rf_rhs($t, $y);
$K2 = $dt*&$rf_rhs($t+$dt/2,$y+$K1/2);
$K3 = $dt*&$rf_rhs($t+$dt/2, $y+$K2/2);
$K4 = $dt*&$rf_rhs($t+$dt, $y+$K3);
$y = $y + ($K1 + 2*$K2 + 2*$K3 + $K4)/6;
$t = $t + $dt;
}
push(@output, [$t, $y]);
}
$rh_ans->{evaluation_points} = \@output;
$rh_ans->throw_error($errors) if defined($errors);
$rh_ans;
}
sub level_curve_check {
my $diffEqRHS = shift; #required differential equation
my $correctEqn = shift; # required answer in order to check the equation
my %options = @_;
my $saveUseOldAnswerMacros = main::PG_restricted_eval('$main::useOldAnswerMacros')
|| 0;
main::PG_restricted_eval('$main::useOldAnswerMacros = 1');
assign_option_aliases( \%options,
'vars' => 'var',
'numPoints' => 'num_of_points',
'reltol' => 'relTol',
);
set_default_options( \%options,
'initial_t' => 0,
'initial_y' => 1,
'var' => [qw( x y )],
'num_of_points' => 10,
'tolType' => (defined($options{tol}) ) ? 'absolute' : 'relative',
'relTol' => .01,
'tol' => .01,
'debug' => 0,
);
my $initial_t = $options{initial_t};
my $initial_y = $options{initial_y};
my $var = $options{var};
my $numPoints = $options{num_of_points};
my @VARS = get_var_array( $var );
my ($tolType, $tol);
if ($options{tolType} eq 'absolute') {
$tolType = 'absolute';
$tol = $options{'tol'};
delete($options{'relTol'}) if exists( $options{'relTol'} );
} else {
$tolType = 'relative';
$tol = $options{'relTol'};
delete($options{'tol'}) if exists( $options{'tol'} );
}
#prepare the correct answer and check its syntax
my $rh_correct_ans = new AnswerHash;
$rh_correct_ans ->{correct_ans} = $correctEqn;
# check and calculate the function defining the differential equation
$rh_correct_ans->input( $diffEqRHS );
$rh_correct_ans = check_syntax($rh_correct_ans);
warn $rh_correct_ans->{error_message},$rh_correct_ans->pretty_print()
if $rh_correct_ans->{error_flag}; $rh_correct_ans->{error_flag} =
undef; $rh_correct_ans = function_from_string2($rh_correct_ans, ra_vars
=> [@VARS], store_in =>'rf_diffeq', debug=>$options{debug} );
warn "Error in compiling instructor's answer: $diffEqRHbr
$rh_correct_ans->{error_message}<br>\n$rh_correct_ans->pretty_print()"
if $rh_correct_ans->{error_flag}; # create the test points that
should lie on a solution curve of the differential equation
$rh_correct_ans = rungeKutta4a( $rh_correct_ans, initial_t =>
$initial_t, initial_y => $initial_y, num_of_points => $numPoints,
debug=>$options{debug} ); warn "Errors in calculating the solution
curve $rh_correct_ans->{student_ans}<BR>\n
$rh_correct_ans->{error_message}<br>\n",$rh_correct_ans->pretty_print() if
$rh_correct_ans->catch_error();
$rh_correct_ans->clear_error();
# check and compile the correct answer submitted by the instructor.
my ($check_eval) = fun_cmp('c', vars => [@VARS],
params => ['c'],
tolType => $options{tolType},
relTol => $options{relTol},
tol => $options{tol},
debug => $options{debug},
); # an evaluator that tests for constants;
$check_eval->ans_hash(evaluation_points => $rh_correct_ans->{evaluation_points});
$check_eval->evaluate($rh_correct_ans->{correct_ans});
if( $check_eval->ans_hash->{score} == 0 or (defined($options{debug}) and $options{debug}))
{
# write error message for professor
my $out1 = $check_eval->ans_hash->{evaluation_points};
my $rf_corrEq = $check_eval->ans_hash->{rf_student_ans};
my $error_string = "This equation $correctEqn is not constant on solution curves
of y'(t) = $diffEqRHS\r\n<br>
starting at ( $initial_t , $initial_y )<br>
$check_eval->ans_hash->pretty_print()".
"options<br>\n".pretty_print({ vars => [@VARS],
params => ['c'],
tolType => $options{tolType},
relTol => $options{relTol},
tol => $options{tol},
debug => $options{debug},
});
for (my $i=0; $i<$numPoints;$i++) {
my ($z, $err) = &$rf_corrEq( $out1->[$i][0], $out1->[$i][1] );
$z = $err if defined $err;
$error_string .= "F( ". $out1->[$i][0] . " , ". $out1->[$i][1] . " ) = $z
<br>\r\n";
}
$error_string .= $rh_correct_ans->error_message();
warn $error_string, $check_eval->ans_hash->pretty_print;
}
my ($constant_eval) = fun_cmp('c', vars => [@VARS],
params => ['c'],
tolType => $options{tolType},
relTol => $options{relTol},
tol => $options{tol},
debug => $options{debug},
); # an evaluator that tests for constants;
$constant_eval->ans_hash(evaluation_points => $rh_correct_ans->{evaluation_points});
my $answer_evaluator = new AnswerEvaluator;
$answer_evaluator->ans_hash( correct_ans => $rh_correct_ans->{correct_ans},
# used for answer only
rf_correct_ans => sub { my @input = @_; pop(@input); },
# return the last input which is the constant parameter 'c';
evaluation_points => $rh_correct_ans->{evaluation_points},
ra_param_vars => ['c'], # compare with constant
function
ra_vars => [@VARS],
type => 'level_curve',
);
$answer_evaluator->install_evaluator(sub { my $ans_hash = shift;
my %options = @_;
$constant_eval->evaluate($ans_hash->{student_ans});
$constant_eval->ans_hash;
});
$answer_evaluator->install_post_filter( sub { my $ans_hash = shift; $ans_hash->{correct_ans}
= $correctEqn; $ans_hash; } );
$answer_evaluator->install_post_filter( sub { my $rh_ans= shift;
my %options = @_;
if ($rh_ans->catch_error('SYNTAX') ) {
$rh_ans->{ans_message} = $rh_ans->{error_message};
$rh_ans->clear_error('SYNTAX');
}
$rh_ans;
});
main::PG_restricted_eval('$main::useOldAnswerMacros = '.$saveUseOldAnswerMacros);
$answer_evaluator;
}
1;
File path = /ww/webwork/pg/macros/PGdiffeqmacros.pl
<| Post or View Comments |> |