[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 4562 - (download) (as text) (annotate)
Tue Oct 10 15:45:11 2006 UTC (13 years, 3 months ago) by jj
File size: 14446 byte(s)
Catch errors which get thrown by other filters.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9