Home
Current UR courses
Visitor page
Intro to WeBWorK
WeBWorK 2 Twiki
WW Community
Grant Support & awards
Discussion group
Problem library
Write/modify problems
Create & manage course
Tutorial on running a course
HowTos
FAQ
WeBWorK2 FAQ
Software Download
How to Install WW server
Feedback
Site Map
Change preferences
Change password
| Prev | Next | pod |
PGdiffeqmacros.pl DESCRIPTION
# Macros for Prills 163 problems
addtwo($1stAddend,$1stIndicator,$2ndAddend,$2ndIndicator)
########## # sub addtwo adds two strings formally # An "indicator" for a string is a # number ,e.g. coefficient,which indicates # whether the string is to be # added or is to be regarded as zero. # The non-zero terms are formally added as strings. # The input is an array # ($1staddend, $1stindicator,$2ndaddend,$2ndindicator) # The return is an array # (formal sum, indicator of formal sum)
add($1stAddend,$1stIndicator,$2ndAddend,$2ndIndicator,...)
######## # sub add generalizes sub addtwo to more addends. # It formally adds the nonzero terms. # The input is an array of even length # consisting of each addend,a string, # followed by its indicator.
diffop($a,$b,$c)
####### # sub diffop cleans up the typed expression # of a diff. operator. # input @diffop =($A,$B,$C) is the coefficients. # input is given as arguments viz difftop($A,$B,$C); # output is the diff. operator as a string $L in TEX
rad($num1,$num2,$num3)
######## # sub rad simplifies (a/b)*(sqrt(c)) # input is given as arguments on rad viz.: rad($a,$b,$c); # $a,$b,$c are integers and $c>=0 and $b is not zero. # output is an array =(answer as string,new$a,new$b, new$c)
simpleexp($r,$ind)
####
# sub exp simplifies exp($r*t) in form for writing perl
# or tex. The input is exp($r,$ind); $ind indicates whether
# we want perl or tex mode. $r is a string that represents
# a number.
# If $ind = 0 output is "exp(($r)*t)", simplified if possible.
# If $ind = 1 output is "exp(($r)*t)", simplified if possible.
undeterminedSin($A,$B,$C,$r,$w,$q1,$q0,$r1,$r0)
################# # undeterminedSin is a subroutine to solve # undetermined coefficient problems that have # sines and cosines. # The input is an array ($A,$B,$C,$r,$w,$q1,$q0,$r1,$r0) # given as arguments on undeterminedSin # $L =$A y" + $B y' + $C y # $rhs = ($q1 t + $q0) cos($w t)exp($r t) + # ($r1 t + $r0) sin($w t)exp($r t) # The subroutine uses undetermined coefficients # to find a solution $y of $L = $rhs . # The output \is $y
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
| Prev | Next | pod |