/home/jaubrey/webwork//pg_TRUNK/macros/PGdiffeqmacros.pl

From WeBWorK

Jump to: navigation


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}; # if student answer is empty and go on, we get a pink screen 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;