Parent Directory
| 
Revision Log
Revision 6438 - (view) (download) (as text)
| 1 : | sh002i | 1050 | |
| 2 : | gage | 4997 | =head1 PGgraders.pl DESCRIPTION |
| 3 : | sh002i | 1050 | |
| 4 : | gage | 4997 | Grader Plug-ins |
| 5 : | |||
| 6 : | =cut | ||
| 7 : | |||
| 8 : | =head3 full_partial_grader | ||
| 9 : | |||
| 10 : | gage | 6140 | =pod |
| 11 : | |||
| 12 : | gage | 6147 | ########################################################### |
| 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 : | gage | 4997 | |
| 18 : | =cut | ||
| 19 : | |||
| 20 : | sh002i | 1050 | 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 : | gage | 6438 | # 'AnSwEr0001' => 34, 'AnSwEr0002'=> 'Mozart', etc. |
| 28 : | sh002i | 1050 | |
| 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 : | gage | 6438 | |
| 34 : | my @answer_labels = keys %{$rh_evaluated_answers}; | ||
| 35 : | my $count = @answer_labels; | ||
| 36 : | sh002i | 1050 | |
| 37 : | gage | 6438 | # Get the last label |
| 38 : | sh002i | 1050 | |
| 39 : | gage | 6438 | # 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 : | sh002i | 1050 | |
| 41 : | gage | 6438 | my $last_label = 'AnSwEr0001'; |
| 42 : | |||
| 43 : | foreach my $answer_label (@answer_labels) { | ||
| 44 : | if ($answer_label gt $last_label) {$last_label = $answer_label;}; | ||
| 45 : | } | ||
| 46 : | |||
| 47 : | sh002i | 1050 | 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 : | gage | 4997 | =head3 custom_problem_grader_0_60_100(@rh_evaluated_answers,$rh_problem_state,%form_options) |
| 80 : | sh002i | 1050 | |
| 81 : | gage | 6140 | =pod |
| 82 : | |||
| 83 : | gage | 6147 | ################################################################ |
| 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 : | sh002i | 1050 | |
| 99 : | gage | 4997 | =cut |
| 100 : | sh002i | 1050 | |
| 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 : | gage | 6433 | $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 : | sh002i | 1050 | |
| 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 : | gage | 4997 | =head3 NOTE: |
| 182 : | |||
| 183 : | gage | 6140 | =pod |
| 184 : | |||
| 185 : | gage | 6147 | ################################################################ |
| 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 : | sh002i | 1050 | |
| 217 : | gage | 4997 | =cut |
| 218 : | sh002i | 1050 | |
| 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 : | gage | 6433 | # $i = 1; |
| 284 : | # while (defined($ans_ref = $evaluated_answers{'AnSwEr'."$i"})) { | ||
| 285 : | # $numright += $ans_ref->{score}; | ||
| 286 : | # $i++; | ||
| 287 : | # } | ||
| 288 : | gage | 6438 | |
| 289 : | gage | 6433 | # Answers have been submitted -- process them. |
| 290 : | foreach my $ans_name (keys %evaluated_answers) { | ||
| 291 : | $numright += $evaluated_answers{$ans_name}->{score}; | ||
| 292 : | gage | 6438 | } |
| 293 : | gage | 6433 | |
| 294 : | gage | 6438 | |
| 295 : | sh002i | 1050 | |
| 296 : | for($i=0;$i<=$#grader_numright;$i++) { | ||
| 297 : | if ($numright>=$grader_numright[$i]) { | ||
| 298 : | $total = $grader_scores[$i]; | ||
| 299 : | } | ||
| 300 : | } | ||
| 301 : | |||
| 302 : | gage | 6438 | <<<<<<< .working |
| 303 : | gage | 6433 | $problem_state{num_of_correct_ans}++ if $total == 1; |
| 304 : | $problem_state{num_of_incorrect_ans}++ if $total < 1 ; | ||
| 305 : | sh002i | 1050 | |
| 306 : | gage | 6438 | ======= |
| 307 : | $problem_state{num_of_correct_ans}++ if $total == 1; | ||
| 308 : | $problem_state{num_of_incorrect_ans}++ if $total < 1 ; | ||
| 309 : | |||
| 310 : | >>>>>>> .merge-right.r6437 | ||
| 311 : | sh002i | 1050 | $problem_result{score} = $total; |
| 312 : | gage | 6438 | <<<<<<< .working |
| 313 : | ======= | ||
| 314 : | |||
| 315 : | # Determine if we are in the reduced scoring period and if the reduced scoring period is enabled and act accordingly | ||
| 316 : | #warn("enable_reduced_scoring is $enable_reduced_scoring"); | ||
| 317 : | #warn("dueDate is $dueDate"); | ||
| 318 : | >>>>>>> .merge-right.r6437 | ||
| 319 : | sh002i | 1050 | |
| 320 : | gage | 6438 | <<<<<<< .working |
| 321 : | gage | 6433 | # Determine if we are in the reduced scoring period and if the reduced scoring period is enabled and act accordingly |
| 322 : | #warn("enable_reduced_scoring is $enable_reduced_scoring"); | ||
| 323 : | #warn("dueDate is $dueDate"); | ||
| 324 : | sh002i | 1050 | |
| 325 : | gage | 6433 | my $reducedScoringPeriodSec = $reducedScoringPeriod*60; # $reducedScoringPeriod is in minutes |
| 326 : | if (!$enable_reduced_scoring or time() < ($dueDate - $reducedScoringPeriodSec)) { # the reduced scoring period is disabled or it is before the reduced scoring period | ||
| 327 : | # increase recorded score if the current score is greater. | ||
| 328 : | $problem_state{recorded_score} = $problem_result{score} if $problem_result{score} > $problem_state{recorded_score}; | ||
| 329 : | # the sub_recored_score holds the recored_score before entering the reduced scoring period | ||
| 330 : | $problem_state{sub_recorded_score} = $problem_state{recorded_score}; | ||
| 331 : | } | ||
| 332 : | elsif (time() < $dueDate) { # we are in the reduced scoring period. | ||
| 333 : | # student gets credit for all work done before the reduced scoring period plus a portion of work done during period | ||
| 334 : | my $newScore = 0; | ||
| 335 : | $newScore = $problem_state{sub_recorded_score} + $reducedScoringValue*($problem_result{score} - $problem_state{sub_recorded_score}) if ($problem_result{score} > $problem_state{sub_recorded_score}); | ||
| 336 : | $problem_state{recorded_score} = $newScore if $newScore > $problem_state{recorded_score}; | ||
| 337 : | my $reducedScoringPerCent = int(100*$reducedScoringValue+.5); | ||
| 338 : | $problem_result{msg} = $problem_result{msg}."<br />You are in the Reduced Credit Period: All additional work done counts $reducedScoringPerCent\% of the original."; | ||
| 339 : | } | ||
| 340 : | sh002i | 1050 | |
| 341 : | gage | 6438 | ======= |
| 342 : | my $reducedScoringPeriodSec = $reducedScoringPeriod*60; # $reducedScoringPeriod is in minutes | ||
| 343 : | if (!$enable_reduced_scoring or time() < ($dueDate - $reducedScoringPeriodSec)) { # the reduced scoring period is disabled or it is before the reduced scoring period | ||
| 344 : | # increase recorded score if the current score is greater. | ||
| 345 : | $problem_state{recorded_score} = $problem_result{score} if $problem_result{score} > $problem_state{recorded_score}; | ||
| 346 : | # the sub_recored_score holds the recored_score before entering the reduced scoring period | ||
| 347 : | $problem_state{sub_recorded_score} = $problem_state{recorded_score}; | ||
| 348 : | } | ||
| 349 : | elsif (time() < $dueDate) { # we are in the reduced scoring period. | ||
| 350 : | # student gets credit for all work done before the reduced scoring period plus a portion of work done during period | ||
| 351 : | my $newScore = 0; | ||
| 352 : | $newScore = $problem_state{sub_recorded_score} + $reducedScoringValue*($problem_result{score} - $problem_state{sub_recorded_score}) if ($problem_result{score} > $problem_state{sub_recorded_score}); | ||
| 353 : | $problem_state{recorded_score} = $newScore if $newScore > $problem_state{recorded_score}; | ||
| 354 : | my $reducedScoringPerCent = int(100*$reducedScoringValue+.5); | ||
| 355 : | $problem_result{msg} = $problem_result{msg}."<br />You are in the Reduced Credit Period: All additional work done counts $reducedScoringPerCent\% of the original."; | ||
| 356 : | } | ||
| 357 : | |||
| 358 : | >>>>>>> .merge-right.r6437 | ||
| 359 : | sh002i | 1050 | (\%problem_result, \%problem_state); |
| 360 : | } | ||
| 361 : | |||
| 362 : | |||
| 363 : | # return 1 so that this file can be included with require | ||
| 364 : | gage | 6438 | 1 |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |