\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 = @_; 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: \$diffEqRHS
\$rh_correct_ans->{error_message}
\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}
\n \$rh_correct_ans->{error_message}
\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
starting at ( \$initial_t , \$initial_y )
\$check_eval->ans_hash->pretty_print()". "options
\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
\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; }); \$answer_evaluator; } 1;