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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6451 - (download) (as text) (annotate)
Tue Oct 12 00:04:19 2010 UTC (9 years, 4 months ago) by gage
File size: 12778 byte(s)
protect @ signs in user_id when naming graphs.
add Quiz prefix in MultiAnswer questions
replace psvnNumber by psvn


    1 
    2 =head1 PGgraders.pl DESCRIPTION
    3 
    4 Grader Plug-ins
    5 
    6 =cut
    7 
    8 =head3 full_partial_grader
    9 
   10 =pod
   11 
   12  ###########################################################
   13  #    full_partial_grader
   14  #    If the final answer is correct, then the problem is given full credit
   15  #    and a message is generated to that effect.  Otherwise, partial credit
   16  #    is given for previous parts.
   17 
   18 =cut
   19 
   20 sub full_partial_grader {
   21     # Get the standard inputs to a grader:
   22         my $rh_evaluated_answers = shift;
   23         my $rh_orig_problem_state = shift;
   24         my %original_problem_state = %$rh_orig_problem_state;
   25         my %form_options = @_;
   26         #  The hash $rh_evaluated_answers typically contains:
   27         #      'AnSwEr0001' => 34, 'AnSwEr0002'=> 'Mozart', etc.
   28 
   29 
   30         # Evaluate these inputs using the "average problem grader"
   31         my ($rh_problem_result, $rh_problem_state) =
   32             &avg_problem_grader($rh_evaluated_answers,$rh_orig_problem_state,%form_options);
   33 
   34       my @answer_labels = keys %{$rh_evaluated_answers};
   35       my $count = @answer_labels;
   36 
   37     # Get the last label
   38 
   39 #     my $last_label = pop sort @answer_labels; # This is what I would like to do but sort seems to be trapped by Safe.pm
   40 
   41       my $last_label = ANS_NUM_TO_NAME(1); #usually AnSwEr0001
   42 
   43       foreach my $answer_label (@answer_labels) {
   44         if ($answer_label gt $last_label) {$last_label = $answer_label;};
   45       }
   46 
   47         if (defined($rh_evaluated_answers->{$last_label}) and ${ $rh_evaluated_answers->{$last_label} }{score} == 1) {
   48                 $rh_problem_result->{score} = 1;
   49                 ${ $rh_evaluated_answers->{$last_label} }{ans_message} =
   50                   'You get full credit for this problem because this answer is correct.';
   51 
   52 
   53         $rh_problem_state->{recorded_score} = $rh_problem_result->{score} if
   54           $rh_problem_result->{score} > $rh_problem_state->{recorded_score};
   55         }
   56 
   57 
   58         # change the problem message
   59         $rh_problem_result->{msg} = 'You can earn full credit by answering just the last part.' if $count > 1;
   60         $rh_problem_result->{type} = 'full_partial_grader';  # change grader type
   61 
   62 
   63         # return the correct data
   64         if ($rh_problem_result->{score} == 1) {
   65             $rh_problem_state->{num_of_correct_ans} = $original_problem_state{num_of_correct_ans} + 1;
   66             $rh_problem_state->{num_of_incorrect_ans} = $original_problem_state{num_of_incorrect_ans};
   67         }
   68         else {
   69             $rh_problem_state->{num_of_correct_ans} = $original_problem_state{num_of_correct_ans};
   70             $rh_problem_state->{num_of_incorrect_ans} = $original_problem_state{num_of_incorrect_ans}+1;
   71      }
   72 
   73 
   74 
   75         # Return the results of grading the problem.
   76         ($rh_problem_result, $rh_problem_state);
   77 }
   78 
   79 =head3 custom_problem_grader_0_60_100(@rh_evaluated_answers,$rh_problem_state,%form_options)
   80 
   81 =pod
   82 
   83  ################################################################
   84  # custom_problem_grader_0_60_100
   85  #
   86  # We need a special problem grader on this problem, since we
   87  # want the student to get full credit for all five answers correct,
   88  # 60% credit for four correct, and 0% for three or fewer correct.
   89  # To change this scheme, look through the following mess of code
   90  # for the place where the variable $numright appears, and change
   91  # that part.
   92  # Also change the long line beginning "msg ==>", to show what will
   93  # appear on the screen for the student.
   94  #
   95  # To look at the problem itself, look for the boxed comment below
   96  # announcing the problem itself.
   97  ################################################################
   98 
   99 =cut
  100 
  101 sub custom_problem_grader_0_60_100 {
  102     my $rh_evaluated_answers = shift;
  103     my $rh_problem_state = shift;
  104     my %form_options = @_;
  105     my %evaluated_answers = %{$rh_evaluated_answers};
  106         #  The hash $rh_evaluated_answers typically contains:
  107         #      'answer1' => 34, 'answer2'=> 'Mozart', etc.
  108 
  109         # By default the  old problem state is simply passed back out again.
  110     my %problem_state = %$rh_problem_state;
  111 
  112 
  113         # %form_options might include
  114         # The user login name
  115         # The permission level of the user
  116         # The studentLogin name for this psvn.
  117         # Whether the form is asking for a refresh or
  118         #     is submitting a new answer.
  119 
  120         # initial setup of the answer
  121     my      $total=0;
  122         my %problem_result = ( score => 0,
  123                 errors => '',
  124                 type => 'custom_problem_grader',
  125                 msg => 'To get full credit, all answers must be correct.  Having
  126  all but one correct is worth 60%.  Two or more incorrect answers gives a score
  127 of 0%.',
  128                                );
  129 
  130 
  131     # Return unless answers have been submitted
  132     unless ($form_options{answers_submitted} == 1) {
  133 
  134     # Since this code is in a .pg file we must use double tildes
  135     # instead of Perl's backslash on the next line.
  136         return(\%problem_result,\%problem_state);
  137     }
  138         # Answers have been submitted -- process them.
  139 
  140         ########################################################
  141         # Here's where we compute the score.  The variable     #
  142         # $numright is the number of correct answers.          #
  143         ########################################################
  144 
  145 
  146     my      $numright=0;
  147 
  148 
  149     $numright += ($evaluated_answers{'AnSwEr0001'}->{score});
  150     $numright += ($evaluated_answers{'AnSwEr0002'}->{score});
  151     $numright += ($evaluated_answers{'AnSwEr0003'}->{score});
  152     $numright += ($evaluated_answers{'AnSwEr0004'}->{score});
  153     $numright += ($evaluated_answers{'AnSwEr0005'}->{score});
  154 
  155 
  156     if ($numright == 5) {
  157         $total = 1;
  158     } elsif ($numright == 4) {
  159         $total = 0.6;
  160     } else {
  161         $total = 0;
  162     }
  163 
  164 
  165     $problem_result{score} = $total;
  166         # increase recorded score if the current score is greater.
  167     $problem_state{recorded_score} = $problem_result{score} if $problem_result{score} > $problem_state{recorded_score};
  168 
  169 
  170 
  171     $problem_state{num_of_correct_ans}++ if $total == 1;
  172     $problem_state{num_of_incorrect_ans}++ if $total < 1 ;
  173 
  174         # Since this code is in a .pg file we must use double tildes
  175     # instead of Perl's backslash on the next line.
  176     (\%problem_result, \%problem_state);
  177 
  178 
  179 }
  180 
  181 =head3 NOTE:
  182 
  183 =pod
  184 
  185  ################################################################
  186  # This problem grader custom_problem_grader_fluid
  187  # was contributed by Prof. Zig Fiedorowicz,
  188  # Dept. of Mathematics, Ohio State University on 8/25/01.
  189  # As written, the problem grader should be put in a separate macro file.
  190  # If actually inserted into a problem, you need to replace a couple
  191  # of backslashes by double tildes.
  192  #
  193  # This is a generalization of the previous custom grader.
  194  # This grader expects two array references to be passed to it, eg.
  195  # $ENV['grader_numright'] = [2,5,7,10];
  196  # $ENV['grader_scores'] = [0.1,0.4,0.6,1]
  197  # Both arrays should be of the same length, and in strictly
  198  # increasing order. The first array is an array of possible
  199  # raw scores, the number of parts of the problem the student might
  200  # get right. The second array is the corresponding array of scores
  201  # the student would be credited with for getting that many parts
  202  # right. The scores should be real numbers between 0 and 1.
  203  # The last element of the 'grader_scores' array should be 1 (perfect
  204  # score). The corresponding last element of 'grader_numright' would
  205  # be the total number of parts of the problem the student would have
  206  # to get right for a perfect score. Normally this would be the total
  207  # number of parts to the problem. In the example shown above, the
  208  # student would get 10% credit for getting 2-4 parts right, 40%
  209  # credit for getting 5-6 parts right, 60% credit for getting 7-9 parts
  210  # right, and 100% credit for getting 10 (or more) parts right.
  211  # A message to be displayed to the student about the grading policy
  212  # for the problems should be passed via
  213  # $ENV{'grader_message'} = "The grading policy for this problem is...";
  214  # or something similar.
  215  ################################################################
  216 
  217 =cut
  218 
  219 sub custom_problem_grader_fluid {
  220     my $rh_evaluated_answers = shift;
  221     my $rh_problem_state = shift;
  222     my %form_options = @_;
  223     my %evaluated_answers = %{$rh_evaluated_answers};
  224         #  The hash $rh_evaluated_answers typically contains:
  225         #      'answer1' => 34, 'answer2'=> 'Mozart', etc.
  226 
  227         # By default the  old problem state is simply passed back out again.
  228     my %problem_state = %$rh_problem_state;
  229 
  230 
  231         # %form_options might include
  232         # The user login name
  233         # The permission level of the user
  234         # The studentLogin name for this psvn.
  235         # Whether the form is asking for a refresh or
  236         #     is submitting a new answer.
  237 
  238         # initial setup of the answer
  239     my      $total=0;
  240         my %problem_result = ( score => 0,
  241                 errors => '',
  242                 type => 'custom_problem_grader',
  243                 msg => $ENV{'grader_message'}
  244                                );
  245 
  246 
  247     # Return unless answers have been submitted
  248     unless ($form_options{answers_submitted} == 1) {
  249 
  250     # Since this code is in a .pg file we must use double tildes
  251     # instead of Perl's backslash on the next line.
  252         return(\%problem_result,\%problem_state);
  253     }
  254         # Answers have been submitted -- process them.
  255 
  256         ########################################################
  257         # Here's where we compute the score.  The variable     #
  258         # $numright is the number of correct answers.          #
  259         ########################################################
  260 
  261 
  262     my      $numright=0;
  263     my      $i;
  264     my      $ans_ref;
  265     my      @grader_numright = @{$ENV{'grader_numright'}};
  266     my      @grader_scores = @{$ENV{'grader_scores'}};
  267 
  268 
  269     if ($#grader_numright != $#grader_scores) {
  270         WARN("Scoring guidelines inconsistent: unequal arrays!");
  271     }
  272     for ($i=0;$i<$#grader_numright;$i++) {
  273       if($grader_numright[$i]>=$grader_numright[$i+1]) {
  274         WARN("Scoring guidelines inconsistent: raw scores not increasing!");
  275       }
  276       if($grader_scores[$i]>=$grader_scores[$i+1]) {
  277         WARN("Scoring guidelines inconsistent: scores not increasing!");
  278       }
  279     }
  280     if ($grader_scores[$#grader_scores] != 1) {
  281         WARN("Scoring guidelines inconsistent: best score < 1");
  282     }
  283 #    $i = 1;
  284 #    while (defined($ans_ref = $evaluated_answers{'AnSwEr'."$i"})) {
  285 #      $numright += $ans_ref->{score};
  286 #      $i++;
  287 #    }
  288 
  289   # Answers have been submitted -- process them.
  290   foreach my $ans_name (keys %evaluated_answers) {
  291       $numright += $evaluated_answers{$ans_name}->{score};
  292   }
  293 
  294 
  295     for($i=0;$i<=$#grader_numright;$i++) {
  296       if ($numright>=$grader_numright[$i]) {
  297          $total = $grader_scores[$i];
  298       }
  299     }
  300 
  301     $problem_state{num_of_correct_ans}++ if $total == 1;
  302     $problem_state{num_of_incorrect_ans}++ if $total < 1 ;
  303 
  304     $problem_result{score} = $total;
  305 
  306 # Determine if we are in the reduced scoring period and if the reduced scoring period is enabled and act accordingly
  307 #warn("enable_reduced_scoring is $enable_reduced_scoring");
  308 #warn("dueDate is $dueDate");
  309 
  310   my $reducedScoringPeriodSec = $reducedScoringPeriod*60;   # $reducedScoringPeriod is in minutes
  311   if (!$enable_reduced_scoring or time() < ($dueDate - $reducedScoringPeriodSec)) { # the reduced scoring period is disabled or it is before the reduced scoring period
  312     # increase recorded score if the current score is greater.
  313     $problem_state{recorded_score} = $problem_result{score} if $problem_result{score} > $problem_state{recorded_score};
  314     # the sub_recored_score holds the recored_score before entering the reduced scoring period
  315     $problem_state{sub_recorded_score} = $problem_state{recorded_score};
  316   }
  317 elsif (time() < $dueDate) { # we are in the reduced scoring period.
  318     # student gets credit for all work done before the reduced scoring period plus a portion of work done during period
  319     my $newScore = 0;
  320     $newScore =   $problem_state{sub_recorded_score} + $reducedScoringValue*($problem_result{score} - $problem_state{sub_recorded_score})  if ($problem_result{score} > $problem_state{sub_recorded_score});
  321     $problem_state{recorded_score} = $newScore if $newScore > $problem_state{recorded_score};
  322     my $reducedScoringPerCent = int(100*$reducedScoringValue+.5);
  323     $problem_result{msg} = $problem_result{msg}."<br />You are in the Reduced Credit Period: All additional work done counts $reducedScoringPerCent\% of the original.";
  324   }
  325 
  326     (\%problem_result, \%problem_state);
  327 }
  328 
  329 
  330 # return 1 so that this file can be included with require
  331 1

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9