## Forum archive 2000-2006

### Michael Gage - PGodemacros.pl

by Arnold Pizer -
Number of replies: 0
 PGodemacros.pl topic started 5/21/2002; 10:05:28 AMlast post 5/21/2002; 10:05:28 AM
Michael Gage - PGodemacros.pl
5/21/2002; 10:05:28 AM (reads: 1047, responses: 0)

    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 |>