[system] / trunk / pg / macros / PGasu.pl Repository:
ViewVC logotype

View of /trunk/pg/macros/PGasu.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5658 - (download) (as text) (annotate)
Sat May 3 17:43:29 2008 UTC (11 years, 8 months ago) by sh002i
File size: 15375 byte(s)
markup for ww-symbol-map

    1 ###
    2 
    3 =head1 NAME
    4 
    5         PGasu.pl -- located in the pg/macros directory
    6 
    7 =head1 SYNPOSIS
    8 
    9 
   10   Macros contributed by John Jones
   11 
   12 =cut
   13 
   14 
   15 # Answer evaluator which always marks things correct
   16 
   17 =head3 auto_right()
   18 
   19 =pod
   20 
   21   Usage: ANS(auto_right());
   22           or
   23                ANS(auto_right("this answer can be left blank"));
   24 
   25 This answer checker marks any answer correct.  It is useful when you want
   26 to leave multiple answer blanks, only some of which will be used.  If you
   27 turn off showing partial correct answers and partial credit, the effect is
   28 not visible to the students.  The comment in the second case is what will
   29 be displayed as the correct answer.  This helps avoid confusion.
   30 
   31 =cut
   32 
   33 # ^function auto_right
   34 # ^uses AnswerEvaluator::new
   35 # ^uses auto_right_checker
   36 sub auto_right {
   37         my $cmt = shift;
   38         my %params = @_;
   39         $cmt = '' unless defined($cmt);
   40 
   41         my $answerEvaluator = new AnswerEvaluator;
   42         $answerEvaluator->ans_hash(
   43             type => "auto_right",
   44             correct_ans => "$cmt"
   45         );
   46         $answerEvaluator->install_pre_filter('reset');
   47         $answerEvaluator->install_evaluator(\&auto_right_checker,%params);
   48 
   49         return $answerEvaluator;
   50 }
   51 
   52 # used in auto_right above
   53 
   54 # ^function auto_right_checker
   55 sub auto_right_checker {
   56  my $ans = shift;
   57  $ans->score(1);
   58  return($ans);
   59 }
   60 
   61 
   62 =head3  no_decs()
   63 
   64 =pod
   65 
   66 Can be wrapped around an numerical evaluation.  It marks the answer wrong
   67 if it contains a decimal point.  Usage:
   68 
   69   ANS(no_decs(num_cmp("sqrt(3)")));
   70 
   71 This will accept "sqrt(3)" or "3^(1/2)" as answers, but not 1.7320508
   72 
   73 =cut
   74 
   75 # ^function no_decs
   76 # ^uses must_have_filter
   77 # ^uses raw_student_answer_filter
   78 # ^uses catch_errors_filter
   79 sub no_decs {
   80   my ($old_evaluator) = @_;
   81 
   82   my $msg= "Your answer contains a decimal.  You must provide an exact answer, e.g. sqrt(5)/3";
   83   $old_evaluator->install_pre_filter(must_have_filter(".", 'no', $msg));
   84   $old_evaluator->install_post_filter(\&raw_student_answer_filter);
   85   $old_evaluator->install_post_filter(\&catch_errors_filter);
   86 
   87   return $old_evaluator;
   88   }
   89 
   90 =head3     must_include()
   91 
   92 =pod
   93 
   94 Wrapper for other answer evaluators.  It insists that a string is part of
   95 the answer to be marked right.
   96 
   97 =cut
   98 
   99 # ^function must_include
  100 # ^uses must_have_filter
  101 # ^uses raw_student_answer_filter
  102 # ^uses catch_errors_filter
  103 sub must_include {
  104   my ($old_evaluator) = shift;
  105   my $muststr = shift;
  106 
  107   $old_evaluator->install_pre_filter(must_have_filter($muststr));
  108   $old_evaluator->install_post_filter(\&raw_student_answer_filter);
  109   $old_evaluator->install_post_filter(\&catch_errors_filter);
  110   return $old_evaluator;
  111   }
  112 
  113 =head3      no_trig_fun()
  114 
  115 Wrapper for other answer evaluators.  It marks the answer wrong if
  116 it contains one of the six basic trig functions.
  117 
  118 This is useful if you want students to report the value of sin(pi/4),
  119 but you don't want to allow "sin(pi/4)" as the answer.
  120 
  121 =cut
  122 
  123 # ^function no_trig_fun
  124 # ^uses fun_cmp
  125 # ^uses must_have_filter
  126 # ^uses catch_errors_filter
  127 sub no_trig_fun {
  128   my ($ans) = shift;
  129   my $new_eval = fun_cmp($ans);
  130   my ($msg) = "Your answer to this problem may not contain a trig function.";
  131   $new_eval->install_pre_filter(must_have_filter("sin", 'no', $msg));
  132   $new_eval->install_pre_filter(must_have_filter("cos", 'no', $msg));
  133   $new_eval->install_pre_filter(must_have_filter("tan", 'no', $msg));
  134   $new_eval->install_pre_filter(must_have_filter("sec", 'no', $msg));
  135   $new_eval->install_pre_filter(must_have_filter("csc", 'no', $msg));
  136   $new_eval->install_pre_filter(must_have_filter("cot", 'no', $msg));
  137 
  138   $new_eval->install_post_filter(\&catch_errors_filter);
  139   return $new_eval;
  140 }
  141 
  142 =head3      no_trig()
  143 
  144 
  145 
  146 =cut
  147 
  148 # ^function no_trig
  149 # ^uses num_cmp
  150 # ^uses must_have_filter
  151 # ^uses catch_errors_filter
  152 sub no_trig {
  153   my ($ans) = shift;
  154   my $new_eval = num_cmp($ans);
  155   my ($msg) = "Your answer to this problem may not contain a trig function.";
  156   $new_eval->install_pre_filter(must_have_filter("sin", 'no', $msg));
  157   $new_eval->install_pre_filter(must_have_filter("cos", 'no', $msg));
  158   $new_eval->install_pre_filter(must_have_filter("tan", 'no', $msg));
  159   $new_eval->install_pre_filter(must_have_filter("sec", 'no', $msg));
  160   $new_eval->install_pre_filter(must_have_filter("csc", 'no', $msg));
  161   $new_eval->install_pre_filter(must_have_filter("cot", 'no', $msg));
  162 
  163   $new_eval->install_post_filter(\&catch_errors_filter);
  164   return $new_eval;
  165 }
  166 
  167 =head3      exact_no_trig()
  168 
  169 
  170 
  171 =cut
  172 
  173 # ^function exact_no_trig
  174 # ^uses num_cmp
  175 # ^uses no_decs
  176 # ^uses must_have_filter
  177 sub exact_no_trig {
  178   my ($ans) = shift;
  179   my $old_eval = num_cmp($ans);
  180   my $new_eval = no_decs($old_eval);
  181   my ($msg) = "Your answer to this problem may not contain a trig function.";
  182   $new_eval->install_pre_filter(must_have_filter("sin", 'no', $msg));
  183   $new_eval->install_pre_filter(must_have_filter("cos", 'no', $msg));
  184   $new_eval->install_pre_filter(must_have_filter("tan", 'no', $msg));
  185   $new_eval->install_pre_filter(must_have_filter("sec", 'no', $msg));
  186   $new_eval->install_pre_filter(must_have_filter("csc", 'no', $msg));
  187   $new_eval->install_pre_filter(must_have_filter("cot", 'no', $msg));
  188 
  189   return $new_eval;
  190 }
  191 
  192 
  193 =head3      must_have_filter()
  194 
  195 =pod
  196 
  197 Filter for checking that an answer has (or doesn't have) a certain
  198 string in it.  This can be used to screen answers where you want them
  199 in a particular form (e.g., if you allow most functions, but not trig
  200 functions in the answer, or if the answer must include some string).
  201 
  202 First argument is the string to have, or not have
  203 Second argument is optional, and tells us whether yes or no
  204 Third argument is the error message to produce (if any).
  205 
  206 =cut
  207 
  208 
  209 # First argument is the string to have, or not have
  210 # Second argument is optional, and tells us whether yes or no
  211 # Third argument is the error message to produce (if any).
  212 # ^function must_have_filter
  213 sub must_have_filter {
  214   my $str = shift;
  215   my $yesno = shift;
  216   my $errm = shift;
  217 
  218   $str =~ s/\./\\./g;
  219   if(!defined($yesno)) {
  220     $yesno=1;
  221   } else {
  222     $yesno = ($yesno eq 'no') ? 0 :1;
  223   }
  224 
  225   my $newfilt = sub {
  226     my $num = shift;
  227     my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
  228     my ($rh_ans);
  229     if ($process_ans_hash) {
  230       $rh_ans = $num;
  231       $num = $rh_ans->{original_student_ans};
  232     }
  233     my $is_ok = 0;
  234 
  235     return $is_ok unless defined($num);
  236 
  237     if (($yesno and ($num =~ /$str/)) or (!($yesno) and !($num=~ /$str/))) {
  238       $is_ok = 1;
  239     }
  240 
  241     if ($process_ans_hash)   {
  242       if ($is_ok == 1 ) {
  243         $rh_ans->{original_student_ans}=$num;
  244         return $rh_ans;
  245       } else {
  246         if(defined($errm)) {
  247           $rh_ans->{ans_message} = $errm;
  248           $rh_ans->{student_ans} = $rh_ans->{original_student_ans};
  249 #         $rh_ans->{student_ans} = "Your answer was \"$rh_ans->{original_student_ans}\". $errm";
  250           $rh_ans->throw_error('SYNTAX', $errm);
  251         } else {
  252           $rh_ans->throw_error('NUMBER', "");
  253         }
  254         return $rh_ans;
  255       }
  256 
  257     } else {
  258       return $is_ok;
  259     }
  260   };
  261   return $newfilt;
  262 }
  263 
  264 =head3      catch_errors_filter()
  265 
  266 =cut
  267 
  268 # ^function catch_errors_filter
  269 sub catch_errors_filter {
  270   my ($rh_ans) = shift;
  271   if ($rh_ans->catch_error('SYNTAX') ) {
  272     $rh_ans->{ans_message} = $rh_ans->{error_message};
  273     $rh_ans->clear_error('SYNTAX');
  274   }
  275   if ($rh_ans->catch_error('NUMBER') ) {
  276     $rh_ans->{ans_message} = $rh_ans->{error_message};
  277     $rh_ans->clear_error('NUMBER');
  278   }
  279   $rh_ans;
  280 }
  281 
  282 =head3      raw_student_answer_filter()
  283 
  284 
  285 
  286 =cut
  287 
  288 # ^function raw_student_answer_filter
  289 sub raw_student_answer_filter {
  290   my ($rh_ans) = shift;
  291 # warn "answer was ".$rh_ans->{student_ans};
  292   $rh_ans->{student_ans} = $rh_ans->{original_student_ans}
  293     unless ($rh_ans->{student_ans} =~ /[a-zA-Z]/);
  294 # warn "2nd time ... answer was ".$rh_ans->{student_ans};
  295 
  296   return $rh_ans;
  297 }
  298 
  299 =head3      no_decimal_list()
  300 
  301 
  302 
  303 =cut
  304 
  305 # ^function no_decimal_list
  306 # ^uses number_list_cmp
  307 sub no_decimal_list {
  308   my ($ans) = shift;
  309   my (%jopts) = @_;
  310   my $old_evaluator = number_list_cmp($ans);
  311 
  312   my $answer_evaluator = sub {
  313     my $tried = shift;
  314     my $ans_hash;
  315       if  ( ref($old_evaluator) eq 'AnswerEvaluator' ) { # new style
  316         $ans_hash = $old_evaluator->evaluate($tried);
  317       } elsif (ref($old_evaluator) eq  'CODE' )     { #old style
  318         $ans_hash = &$old_evaluator($tried);
  319     }
  320     if(defined($jopts{'must'}) && ! ($tried =~ /$jopts{'must'}/)) {
  321       $ans_hash->{score}=0;
  322       $ans_hash->setKeys( 'ans_message' => 'Your answer needs to be exact.');
  323     }
  324     if($tried =~ /\./) {
  325       $ans_hash->{score}=0;
  326       $ans_hash->setKeys( 'ans_message' => 'You may not use decimals in your answer.');
  327     }
  328     return $ans_hash;
  329   };
  330   return $answer_evaluator;
  331 }
  332 
  333 
  334 =head3      no_decimals()
  335 
  336 
  337 
  338 =cut
  339 
  340 # ^function no_decimals
  341 # ^uses std_num_cmp
  342 sub no_decimals {
  343   my ($ans) = shift;
  344   my (%jopts) = @_;
  345   my $old_evaluator = std_num_cmp($ans);
  346 
  347   my $answer_evaluator = sub {
  348     my $tried = shift;
  349     my $ans_hash;
  350       if  ( ref($old_evaluator) eq 'AnswerEvaluator' ) { # new style
  351         $ans_hash = $old_evaluator->evaluate($tried);
  352       } elsif (ref($old_evaluator) eq  'CODE' )     { #old style
  353         $ans_hash = &$old_evaluator($tried);
  354     }
  355     if(defined($jopts{'must'}) && ! ($tried =~ /$jopts{'must'}/)) {
  356       $ans_hash->{score}=0;
  357       $ans_hash->setKeys( 'ans_message' => 'Your answer needs to be exact.');
  358     }
  359     if($tried =~ /\./) {
  360       $ans_hash->{score}=0;
  361       $ans_hash->setKeys( 'ans_message' => 'You may not use decimals in your answer.');
  362     }
  363     return $ans_hash;
  364   };
  365   return $answer_evaluator;
  366 }
  367 
  368 =head3      with_comments()
  369 
  370 
  371   # Wrapper for an answer evaluator which can also supply comments
  372 
  373 =cut
  374 
  375 # Wrapper for an answer evaluator which can also supply comments
  376 
  377 # ^function with_comments
  378 sub with_comments {
  379   my ($old_evaluator, $cmt) = @_;
  380 
  381 #   $mdm = $main::displayMode;
  382 #   $main::displayMode = 'HTML_tth';
  383 #   $cmt = EV2($cmt);
  384 #   $main::displayMode =$mdm;
  385 
  386   my $ans_evaluator =  sub  {
  387     my $tried = shift;
  388     my $ans_hash;
  389 
  390     if  ( ref($old_evaluator) eq 'AnswerEvaluator' ) { # new style
  391       $ans_hash = $old_evaluator->evaluate($tried);
  392     } elsif (ref($old_evaluator) eq  'CODE' )     { #old style
  393       $ans_hash = &$old_evaluator($tried);
  394     } else {
  395       warn "There is a problem using the answer evaluator";
  396     }
  397 
  398     if($ans_hash->{score}>0) {
  399       $ans_hash -> setKeys( 'ans_message' => $cmt);
  400     }
  401     return $ans_hash;
  402   };
  403 
  404   $ans_evaluator;
  405 }
  406 
  407 
  408 =head3      pc_evaluator()
  409 
  410 
  411     # Wrapper for multiple answer evaluators, it takes a list of the following as inputs
  412     # [answer_evaluator, partial credit factor, comment]
  413     # it applies evaluators from the list until it hits one with positive credit,
  414     # weights it by the partial credit factor, and throws in its comment
  415 
  416 
  417 =cut
  418 
  419 
  420 # Wrapper for multiple answer evaluators, it takes a list of the following as inputs
  421 # [answer_evaluator, partial credit factor, comment]
  422 # it applies evaluators from the list until it hits one with positive credit,
  423 # weights it by the partial credit factor, and throws in its comment
  424 # ^function pc_evaluator
  425 sub pc_evaluator {
  426         my @ev_list;
  427         if(ref($_[0]) ne 'ARRAY') {
  428                 warn "Improper input to pc_evaluator";
  429         }
  430         if(ref($_[0]->[0]) ne 'ARRAY') {
  431                 @ev_list = @_;
  432         } else {
  433                 @ev_list = @{$_[0]};
  434         }
  435 
  436         my $ans_evaluator =  sub  {
  437                 my $tried = shift;
  438                 my $ans_hash;
  439                 for($j=0;$j<scalar(@ev_list); $j++) {
  440                         my $old_evaluator = $ev_list[$j][0];
  441                         my $cmt = $ev_list[$j][2];
  442                         my $weight = $ev_list[$j][1];
  443                         $weight = 1 unless defined($weight);
  444 
  445                         if  ( ref($old_evaluator) eq 'AnswerEvaluator' ) { # new style
  446                                 $ans_hash = $old_evaluator->evaluate($tried);
  447                         } elsif (ref($old_evaluator) eq  'CODE' )     { #old style
  448                                 $ans_hash = &$old_evaluator($tried);
  449                         } else {
  450                                 warn "There is a problem using the answer evaluator";
  451                         }
  452 
  453                         if($ans_hash->{score}>0) {
  454                                 $ans_hash -> setKeys( 'ans_message' => $cmt) if defined($cmt);
  455                                 $ans_hash->{score} *= $weight;
  456                                 return $ans_hash;
  457                         };
  458                 };
  459                 return $ans_hash;
  460         };
  461 
  462   $ans_evaluator;
  463 }
  464 
  465 
  466 
  467 =head3      weighted_partial_grader
  468 
  469 =pod
  470 
  471 This is a grader which weights the different parts of the problem
  472 differently.  The weights passed to it through the environment.  In
  473 the problem:
  474 
  475  $ENV{'partial_weights'} = [.2,.2,.2,.3];
  476 
  477 This will soon be superceded by a better grader.
  478 
  479 =cut
  480 
  481 # ^function weighted_partial_grader
  482 # ^uses $ENV{grader_message}
  483 # ^uses $ENV{partial_weights}
  484 sub weighted_partial_grader {
  485     my $rh_evaluated_answers = shift;
  486     my $rh_problem_state = shift;
  487     my %form_options = @_;
  488     my %evaluated_answers = %{$rh_evaluated_answers};
  489         #  The hash $rh_evaluated_answers typically contains:
  490         #      'answer1' => 34, 'answer2'=> 'Mozart', etc.
  491 
  492         # By default the  old problem state is simply passed back out again.
  493     my %problem_state = %$rh_problem_state;
  494 
  495 
  496         # %form_options might include
  497         # The user login name
  498         # The permission level of the user
  499         # The studentLogin name for this psvn.
  500         # Whether the form is asking for a refresh or
  501         #     is submitting a new answer.
  502 
  503         # initial setup of the answer
  504     my      $total=0;
  505         my %problem_result = ( score => 0,
  506                 errors => '',
  507                 type => 'custom_problem_grader',
  508                 msg => $ENV{'grader_message'}
  509                                );
  510 
  511 
  512     # Return unless answers have been submitted
  513     unless ($form_options{answers_submitted} == 1) {
  514         return(\%problem_result,\%problem_state);
  515     }
  516         # Answers have been submitted -- process them.
  517 
  518         ########################################################
  519         # Here's where we compute the score.  The variable     #
  520         # $numright is the number of correct answers.          #
  521         ########################################################
  522 
  523 
  524     my      $numright=0;
  525     my      $i;
  526     my      $ans_ref;
  527 
  528     warn "Partial value weights not defined" if not defined($ENV{'partial_weights'});
  529     my      @partial_weights = @{$ENV{'partial_weights'}};
  530     my      $total_weight=0;
  531 
  532     # Renormalize weights so they add to 1
  533     for $i (@partial_weights) { $total_weight += $i; }
  534     warn("Weights do not add to a positive number") unless ($total_weight >0);
  535     for $i (0..$#partial_weights) { $partial_weights[$i] /= $total_weight; }
  536 
  537     $i = 1;
  538     while (defined($ans_ref = $evaluated_answers{'AnSwEr'."$i"})) {
  539       $total += $ans_ref->{score}*$partial_weights[$i-1];
  540       $i++;
  541     }
  542 
  543     $problem_result{score} = $total;
  544         # increase recorded score if the current score is greater.
  545     $problem_state{recorded_score} = $problem_result{score} if $problem_result{score} > $problem_state{recorded_score};
  546 
  547     $problem_state{num_of_correct_ans}++ if $total == 1;
  548     $problem_state{num_of_incorrect_ans}++ if $total < 1 ;
  549 
  550     (\%problem_result, \%problem_state);
  551 }
  552 
  553 1;
  554 
  555 ## Local Variables:
  556 ## mode: CPerl
  557 ## font-lock-mode: t
  558 ## End:

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9