[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 2155 - (download) (as text) (annotate)
Sat May 22 18:04:23 2004 UTC (15 years, 8 months ago) by jj
File size: 13849 byte(s)
Moved nicestring to PGbasicmacros.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9