Parent Directory
| 
Revision Log
Scoring.pm: make scoring honor include_in_scoring status
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm,v 1.62 2007/03/07 17:34:42 glarose Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::ContentGenerator::Instructor::Scoring; 18 use base qw(WeBWorK::ContentGenerator::Instructor); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::Instructor::Scoring - Generate scoring data files 23 24 =cut 25 26 use strict; 27 use warnings; 28 #use CGI qw(-nosticky ); 29 use WeBWorK::CGI; 30 use WeBWorK::Debug; 31 use WeBWorK::Utils qw(readFile); 32 33 our @userInfoColumnHeadings = ("STUDENT ID", "login ID", "LAST NAME", "FIRST NAME", "SECTION", "RECITATION"); 34 our @userInfoFields = ("student_id", "user_id","last_name", "first_name", "section", "recitation"); 35 36 sub initialize { 37 my ($self) = @_; 38 my $r = $self->r; 39 my $urlpath = $r->urlpath; 40 my $ce = $r->ce; 41 my $db = $r->db; 42 my $authz = $r->authz; 43 my $scoringDir = $ce->{courseDirs}->{scoring}; 44 my $courseName = $urlpath->arg("courseID"); 45 my $user = $r->param('user'); 46 47 # Check permission 48 return unless $authz->hasPermissions($user, "access_instructor_tools"); 49 return unless $authz->hasPermissions($user, "score_sets"); 50 51 my @selected = $r->param('selectedSet'); 52 my $scoreSelected = $r->param('scoreSelected'); 53 my $scoringFileName = $r->param('scoringFileName') || "${courseName}_totals"; 54 $scoringFileName =~ s/\.csv\s*$//; $scoringFileName .='.csv'; # must end in .csv 55 $self->{scoringFileName}=$scoringFileName; 56 57 $self->{padFields} = defined($r->param('padFields') ) ? 1 : 0; 58 59 if (defined $scoreSelected && @selected) { 60 61 my @totals = (); 62 my $recordSingleSetScores = $r->param('recordSingleSetScores'); 63 64 # pre-fetch users 65 debug("pre-fetching users"); 66 # DBFIXME shouldn't need ID list 67 my @Users = $db->getUsers($db->listUsers); 68 my %Users; 69 foreach my $User (@Users) { 70 next unless $User; 71 next unless $ce->status_abbrev_has_behavior($User->status, "include_in_scoring"); 72 $Users{$User->user_id} = $User; 73 } 74 # DBFIXME use an ORDER BY clause in the database 75 my @sortedUserIDs = sort { 76 lc($Users{$a}->last_name) cmp lc($Users{$b}->last_name) 77 || 78 lc($Users{$a}->first_name) cmp lc($Users{$b}->first_name) 79 || 80 lc($Users{$a}->user_id) cmp lc($Users{$b}->user_id) 81 } 82 83 keys %Users; 84 #my @userInfo = (\%Users, \@sortedUserIDs); 85 debug("done pre-fetching users"); 86 87 my $scoringType = ($recordSingleSetScores) ?'everything':'totals'; 88 my (@everything, @normal,@full,@info,@totalsColumn); 89 @info = $self->scoreSet($selected[0], "info", undef, \%Users, \@sortedUserIDs) if defined($selected[0]); 90 @totals = @info; 91 my $showIndex = defined($r->param('includeIndex')) ? defined($r->param('includeIndex')) : 0; 92 93 94 foreach my $setID (@selected) { 95 next unless defined $setID; 96 if ($scoringType eq 'everything') { 97 @everything = $self->scoreSet($setID, "everything", $showIndex, \%Users, \@sortedUserIDs); 98 @normal = $self->everything2normal(@everything); 99 @full = $self->everything2full(@everything); 100 @info = $self->everything2info(@everything); 101 @totalsColumn = $self->everything2totals(@everything); 102 $self->appendColumns(\@totals, \@totalsColumn); 103 $self->writeCSV("$scoringDir/s${setID}scr.csv", @normal); 104 $self->writeCSV("$scoringDir/s${setID}ful.csv", @full); 105 } else { 106 @totalsColumn = $self->scoreSet($setID, "totals", $showIndex, \%Users, \@sortedUserIDs); 107 $self->appendColumns(\@totals, \@totalsColumn); 108 } 109 } 110 my @sum_scores = $self->sumScores(\@totals, $showIndex, \%Users, \@sortedUserIDs); 111 $self->appendColumns( \@totals,\@sum_scores); 112 $self->writeCSV("$scoringDir/$scoringFileName", @totals); 113 114 } elsif (defined $scoreSelected) { 115 $self->addbadmessage("You must select one or more sets for scoring"); 116 } 117 118 # Obtaining list of sets: 119 my @setNames = $db->listGlobalSets(); 120 my @set_records = (); 121 # DBFIXME shouldn't need ID list 122 @set_records = $db->getGlobalSets( @setNames); 123 124 125 # store data 126 $self->{ra_sets} = \@setNames; # ra_sets IS NEVER USED AGAIN!!!!! 127 $self->{ra_set_records} = \@set_records; 128 } 129 130 131 sub body { 132 my ($self) = @_; 133 my $r = $self->r; 134 my $urlpath = $r->urlpath; 135 my $ce = $r->ce; 136 my $authz = $r->authz; 137 my $scoringDir = $ce->{courseDirs}->{scoring}; 138 my $courseName = $urlpath->arg("courseID"); 139 my $user = $r->param('user'); 140 141 my $scoringPage = $urlpath->newFromModule($urlpath->module, $r, courseID => $courseName); 142 my $scoringURL = $self->systemLink($scoringPage, authen=>0); 143 144 my $scoringDownloadPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ScoringDownload", $r, 145 courseID => $courseName 146 ); 147 148 my $scoringFileName = $self->{scoringFileName}; 149 150 # Check permissions 151 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to access the Instructor tools.") 152 unless $authz->hasPermissions($user, "access_instructor_tools"); 153 154 return CGI::div({class=>"ResultsWithError"}, "You are not authorized to score sets.") 155 unless $authz->hasPermissions($user, "score_sets"); 156 157 print join("", 158 CGI::start_form(-method=>"POST", -action=>$scoringURL),"\n", 159 $self->hidden_authen_fields,"\n", 160 CGI::hidden({-name=>'scoreSelected', -value=>1}), 161 CGI::start_table({border=>1,}), 162 CGI::Tr({}, 163 CGI::td($self->popup_set_form), 164 CGI::td({}, 165 CGI::checkbox({ -name=>'includeIndex', 166 -value=>1, 167 -label=>'Include Index', 168 -checked=>0, 169 }, 170 ), 171 CGI::br(), 172 # These are not yet implemented 173 #CGI::checkbox({ -name=>'includeTotals', 174 # -value=>1, 175 # -label=>'Include Total score column', 176 # -checked=>1, 177 # }, 178 #), 179 #CGI::br(), 180 #CGI::checkbox({ -name=>'includePercent', 181 # -value=>1, 182 # -label=>'Include Percent correct column', 183 # -checked=>1, 184 # }, 185 #), 186 #CGI::br(), 187 CGI::checkbox({ -name=>'recordSingleSetScores', 188 -value=>1, 189 -label=>'Record Scores for Single Sets', 190 -checked=>0, 191 }, 192 'Record Scores for Single Sets' 193 ), 194 CGI::br(), 195 CGI::checkbox({ -name=>'padFields', 196 -value=>1, 197 -label=>'Pad Fields', 198 -checked=>1, 199 }, 200 'Pad Fields' 201 ), 202 ), 203 ), 204 CGI::Tr(CGI::td({colspan =>2,align=>'center'}, 205 CGI::input({type=>'submit',value=>'Score selected set(s) and save to: ',name=>'score-sets'}), 206 CGI::input({type=>'text', name=>'scoringFileName', size=>'40',value=>"$scoringFileName"}) 207 )), 208 209 CGI::end_table(), 210 CGI::end_form(), 211 ); 212 213 214 if ($authz->hasPermissions($user, "score_sets")) { 215 my @selected = $r->param('selectedSet'); 216 if (@selected) { 217 print CGI::p("All of these files will also be made available for mail merge"); 218 } 219 foreach my $setID (@selected) { 220 221 my @validFiles; 222 foreach my $type ("scr", "ful") { 223 my $filename = "s$setID$type.csv"; 224 my $path = "$scoringDir/$filename"; 225 push @validFiles, $filename if -f $path; 226 } 227 if (@validFiles) { 228 print CGI::h2("$setID"); 229 foreach my $filename (@validFiles) { 230 #print CGI::a({href=>"../scoringDownload/?getFile=${filename}&".$self->url_authen_args}, $filename); 231 print CGI::a({href=>$self->systemLink($scoringDownloadPage, 232 params=>{getFile => $filename } )}, $filename); 233 print CGI::br(); 234 } 235 print CGI::hr(); 236 } 237 } 238 if (-f "$scoringDir/$scoringFileName") { 239 print CGI::h2("Totals"); 240 #print CGI::a({href=>"../scoringDownload/?getFile=${courseName}_totals.csv&".$self->url_authen_args}, "${courseName}_totals.csv"); 241 print CGI::a({href=>$self->systemLink($scoringDownloadPage, 242 params=>{getFile => "$scoringFileName" } )}, "$scoringFileName"); 243 print CGI::hr(); 244 print CGI::pre({style=>'font-size:smaller'},WeBWorK::Utils::readFile("$scoringDir/$scoringFileName")); 245 } 246 } 247 248 return ""; 249 } 250 251 # If, some day, it becomes possible to assign a different number of problems to each student, this code 252 # will have to be rewritten some. 253 # $format can be any of "normal", "full", "everything", "info", or "totals". An undefined value defaults to "normal" 254 # normal: student info, the status of each problem in the set, and a "totals" column 255 # full: student info, the status of each problem, and the number of correct and incorrect attempts 256 # everything: "full" plus a totals column 257 # info: student info columns only 258 # totals: total column only 259 sub scoreSet { 260 my ($self, $setID, $format, $showIndex, $UsersRef, $sortedUserIDsRef) = @_; 261 my $r = $self->r; 262 my $db = $r->db; 263 my @scoringData; 264 my $scoringItems = { info => 0, 265 successIndex => 0, 266 setTotals => 0, 267 problemScores => 0, 268 problemAttempts => 0, 269 header => 0, 270 }; 271 $format = "normal" unless defined $format; 272 $format = "normal" unless $format eq "full" or $format eq "everything" or $format eq "totals" or $format eq "info"; 273 my $columnsPerProblem = ($format eq "full" or $format eq "everything") ? 3 : 1; 274 275 # DBFIXME these have already been fetched in ra_set_records 276 my $setRecord = $db->getGlobalSet($setID); #checked 277 die "global set $setID not found. " unless $setRecord; 278 #my %users; 279 #my %userStudentID=(); 280 #foreach my $userID ($db->listUsers()) { 281 # my $userRecord = $db->getUser($userID); # checked 282 # die "user record for $userID not found" unless $userID; 283 # # FIXME: if two users have the same student ID, the second one will 284 # # clobber the first one. this is bad! 285 # # The key is what we'd like to sort by. 286 # $users{$userRecord->student_id} = $userRecord; 287 # $userStudentID{$userID} = $userRecord->student_id; 288 #} 289 290 my %Users = %$UsersRef; # user objects hashed on user ID 291 my @sortedUserIDs = @$sortedUserIDsRef; # user IDs sorted by student ID 292 293 my @problemIDs = $db->listGlobalProblems($setID); 294 295 # determine what information will be returned 296 if ($format eq 'normal') { 297 $scoringItems = { info => 1, 298 successIndex => $showIndex, 299 setTotals => 1, 300 problemScores => 1, 301 problemAttempts => 0, 302 header => 1, 303 }; 304 } elsif ($format eq 'full') { 305 $scoringItems = { info => 1, 306 successIndex => $showIndex, 307 setTotals => 0, 308 problemScores => 1, 309 problemAttempts => 1, 310 header => 1, 311 }; 312 } elsif ($format eq 'everything') { 313 $scoringItems = { info => 1, 314 successIndex => $showIndex, 315 setTotals => 1, 316 problemScores => 1, 317 problemAttempts => 1, 318 header => 1, 319 }; 320 } elsif ($format eq 'totals') { 321 $scoringItems = { info => 0, 322 successIndex => $showIndex, 323 setTotals => 1, 324 problemScores => 0, 325 problemAttempts => 0, 326 header => 0, 327 }; 328 } elsif ($format eq 'info') { 329 $scoringItems = { info => 0, 330 successIndex => 0, 331 setTotals => 0, 332 problemScores => 0, 333 problemAttempts => 0, 334 header => 1, 335 }; 336 } else { 337 warn "unrecognized format"; 338 } 339 340 # Initialize a two-dimensional array of the proper size 341 for (my $i = 0; $i < @sortedUserIDs + 7; $i++) { # 7 is how many descriptive fields there are in each column 342 push @scoringData, []; 343 } 344 345 #my @userKeys = sort keys %users; # list of "student IDs" NOT user IDs 346 347 if ($scoringItems->{header}) { 348 $scoringData[0][0] = "NO OF FIELDS"; 349 $scoringData[1][0] = "SET NAME"; 350 $scoringData[2][0] = "PROB NUMBER"; 351 $scoringData[3][0] = "DUE DATE"; 352 $scoringData[4][0] = "DUE TIME"; 353 $scoringData[5][0] = "PROB VALUE"; 354 355 356 357 # Write identifying information about the users 358 359 for (my $field=0; $field < @userInfoFields; $field++) { 360 if ($field > 0) { 361 for (my $i = 0; $i < 6; $i++) { 362 $scoringData[$i][$field] = ""; 363 } 364 } 365 $scoringData[6][$field] = $userInfoColumnHeadings[$field]; 366 for (my $user = 0; $user < @sortedUserIDs; $user++) { 367 my $fieldName = $userInfoFields[$field]; 368 $scoringData[$user + 7][$field] = $Users{$sortedUserIDs[$user]}->$fieldName; 369 } 370 } 371 } 372 return @scoringData if $format eq "info"; 373 374 # pre-fetch global problems 375 debug("pre-fetching global problems for set $setID"); 376 my %GlobalProblems = map { $_->problem_id => $_ } 377 $db->getAllGlobalProblems($setID); 378 debug("done pre-fetching global problems for set $setID"); 379 380 # pre-fetch user problems 381 debug("pre-fetching user problems for set $setID"); 382 my %UserProblems; # $UserProblems{$userID}{$problemID} 383 384 # Gateway change here: for non-gateway (non-versioned) sets, we just 385 # get each user's problems. For gateway (versioned) sets, we get the 386 # user's best version and return that 387 if ( ! defined( $setRecord->assignment_type() ) || 388 $setRecord->assignment_type() !~ /gateway/ ) { 389 foreach my $userID (@sortedUserIDs) { 390 my %CurrUserProblems = map { $_->problem_id => $_ } 391 $db->getAllMergedUserProblems($userID, $setID); 392 $UserProblems{$userID} = \%CurrUserProblems; 393 } 394 } else { # versioned sets; get the problems for the best version 395 396 foreach my $userID (@sortedUserIDs) { 397 my $CurrUserProblems = {}; 398 my @versionNums = $db->listSetVersions($userID,$setID); 399 400 my $bestScore = -1; 401 402 if ( @versionNums ) { 403 for my $i ( @versionNums ) { 404 my %versionUserProblems = map { $_->problem_id => $_ } 405 $db->getAllMergedProblemVersions( $userID, $setID, $i ); 406 my $score = 0; 407 foreach ( values ( %versionUserProblems ) ) { 408 my $status = $_->status || 0; 409 my $value = $_->value || 1; 410 # some of these are coming in null; I'm not 411 # why, or if this should be necessary 412 $_->status($status); 413 $_->value($value); 414 $score += $status*$value; 415 } 416 if ( $score > $bestScore ) { 417 $CurrUserProblems = \%versionUserProblems; 418 $bestScore = $score; 419 } 420 } 421 } else { 422 my %cp = map { $_->problem_id => $_ } 423 $db->getAllMergedUserProblems($userID, $setID); 424 $CurrUserProblems = \%cp; 425 } 426 $UserProblems{$userID} = { %{$CurrUserProblems} }; 427 } 428 } 429 debug("done pre-fetching user problems for set $setID"); 430 431 # Write the problem data 432 my $dueDateString = $self->formatDateTime($setRecord->due_date); 433 my ($dueDate, $dueTime) = $dueDateString =~ m/^([^\s]*)\s*([^\s]*)$/; 434 my $valueTotal = 0; 435 my %userStatusTotals = (); 436 my %userSuccessIndex = (); 437 my %numberOfAttempts = (); 438 my $num_of_problems = @problemIDs; 439 for (my $problem = 0; $problem < @problemIDs; $problem++) { 440 441 #my $globalProblem = $db->getGlobalProblem($setID, $problemIDs[$problem]); #checked 442 my $globalProblem = $GlobalProblems{$problemIDs[$problem]}; 443 die "global problem $problemIDs[$problem] not found for set $setID" unless $globalProblem; 444 445 my $column = 5 + $problem * $columnsPerProblem; 446 if ($scoringItems->{header}) { 447 $scoringData[0][$column] = ""; 448 $scoringData[1][$column] = $setRecord->set_id; 449 $scoringData[2][$column] = $globalProblem->problem_id; 450 $scoringData[3][$column] = $dueDate; 451 $scoringData[4][$column] = $dueTime; 452 $scoringData[5][$column] = $globalProblem->value; 453 $scoringData[6][$column] = "STATUS"; 454 if ($scoringItems->{header} and $scoringItems->{problemAttempts}) { # Fill in with blanks, or maybe the problem number 455 for (my $row = 0; $row < 6; $row++) { 456 for (my $col = $column+1; $col <= $column + 2; $col++) { 457 if ($row == 2) { 458 $scoringData[$row][$col] = $globalProblem->problem_id; 459 } else { 460 $scoringData[$row][$col] = ""; 461 } 462 } 463 } 464 $scoringData[6][$column + 1] = "#corr"; 465 $scoringData[6][$column + 2] = "#incorr"; 466 } 467 } 468 $valueTotal += $globalProblem->value; 469 470 471 for (my $user = 0; $user < @sortedUserIDs; $user++) { 472 #my $userProblem = $userProblems{ $users{$userKeys[$user]}->user_id }; 473 #my $userProblem = $UserProblems{$sers{$userKeys[$user]}->user_id}{$problemIDs[$problem]}; 474 my $userProblem = $UserProblems{$sortedUserIDs[$user]}{$problemIDs[$problem]}; 475 unless (defined $userProblem) { # assume an empty problem record if the problem isn't assigned to this user 476 $userProblem = $db->newUserProblem; 477 $userProblem->status(0); 478 $userProblem->value(0); 479 $userProblem->num_correct(0); 480 $userProblem->num_incorrect(0); 481 } 482 $userStatusTotals{$user} = 0 unless exists $userStatusTotals{$user}; 483 my $user_problem_status = ($userProblem->status =~/^[\d\.]+$/) ? $userProblem->status : 0; # ensure it's numeric 484 $userStatusTotals{$user} += $user_problem_status * $userProblem->value; 485 if ($scoringItems->{successIndex}) { 486 $numberOfAttempts{$user} = 0 unless defined($numberOfAttempts{$user}); 487 my $num_correct = $userProblem->num_correct; 488 my $num_incorrect = $userProblem->num_incorrect; 489 $num_correct = ( defined($num_correct) and $num_correct) ? $num_correct : 0; 490 $num_incorrect = ( defined($num_incorrect) and $num_incorrect) ? $num_incorrect : 0; 491 $numberOfAttempts{$user} += $num_correct + $num_incorrect; 492 } 493 if ($scoringItems->{problemScores}) { 494 $scoringData[7 + $user][$column] = $userProblem->status; 495 if ($scoringItems->{problemAttempts}) { 496 $scoringData[7 + $user][$column + 1] = $userProblem->num_correct; 497 $scoringData[7 + $user][$column + 2] = $userProblem->num_incorrect; 498 } 499 } 500 } 501 } 502 if ($scoringItems->{successIndex}) { 503 for (my $user = 0; $user < @sortedUserIDs; $user++) { 504 my $avg_num_attempts = ($num_of_problems) ? $numberOfAttempts{$user}/$num_of_problems : 0; 505 $userSuccessIndex{$user} = ($avg_num_attempts && $valueTotal) ? ($userStatusTotals{$user}/$valueTotal)**2/$avg_num_attempts : 0; 506 } 507 } 508 # write the status totals 509 if ($scoringItems->{setTotals}) { # Ironic, isn't it? 510 my $totalsColumn = $format eq "totals" ? 0 : 5 + @problemIDs * $columnsPerProblem; 511 $scoringData[0][$totalsColumn] = ""; 512 $scoringData[1][$totalsColumn] = $setRecord->set_id; 513 $scoringData[2][$totalsColumn] = ""; 514 $scoringData[3][$totalsColumn] = ""; 515 $scoringData[4][$totalsColumn] = ""; 516 $scoringData[5][$totalsColumn] = $valueTotal; 517 $scoringData[6][$totalsColumn] = "total"; 518 if ($scoringItems->{successIndex}) { 519 $scoringData[0][$totalsColumn+1] = ""; 520 $scoringData[1][$totalsColumn+1] = $setRecord->set_id; 521 $scoringData[2][$totalsColumn+1] = ""; 522 $scoringData[3][$totalsColumn+1] = ""; 523 $scoringData[4][$totalsColumn+1] = ""; 524 $scoringData[5][$totalsColumn+1] = '100'; 525 $scoringData[6][$totalsColumn+1] = "index" ; 526 } 527 for (my $user = 0; $user < @sortedUserIDs; $user++) { 528 $userStatusTotals{$user} =$userStatusTotals{$user} ||0; 529 $scoringData[7+$user][$totalsColumn] = sprintf("%.1f",$userStatusTotals{$user}) if $scoringItems->{setTotals}; 530 $scoringData[7+$user][$totalsColumn+1] = sprintf("%.0f",100*$userSuccessIndex{$user}) if $scoringItems->{successIndex}; 531 532 } 533 } 534 debug("End set $setID"); 535 return @scoringData; 536 } 537 538 sub sumScores { # Create a totals column for each student 539 my $self = shift; 540 my $r_totals = shift; 541 my $showIndex = shift; 542 my $r_users = shift; 543 my $r_sorted_user_ids =shift; 544 my $r = $self->r; 545 my $db = $r->db; 546 my @scoringData = (); 547 my $index_increment = ($showIndex) ? 2 : 1; 548 # This whole thing is a hack, but here goes. We're going to sum the appropriate columns of the totals file: 549 # I believe we have $r_totals->[rows]->[cols] -- the way it's printed out. 550 my $start_column = 6; #The problem column 551 my $last_column = $#{$r_totals->[1]}; # try to figure out the number of the last column in the array. 552 my $row_count = $#{$r_totals}; 553 554 # Calculate total number of problems for the course. 555 my $totalPoints = 0; 556 my $problemValueRow = 5; 557 for( my $j = $start_column;$j<=$last_column;$j+= $index_increment) { 558 my $score = $r_totals->[$problemValueRow]->[$j]; 559 $totalPoints += ($score =~/^\s*[\d\.]+\s*$/)? $score : 0; 560 } 561 foreach my $i (0..$row_count) { 562 my $studentTotal = 0; 563 for( my $j = $start_column;$j<=$last_column;$j+= $index_increment) { 564 my $score = $r_totals->[$i]->[$j]; 565 $studentTotal += ($score =~/^\s*[\d\.]+\s*$/)? $score : 0; 566 567 } 568 $scoringData[$i][0] =sprintf("%.1f",$studentTotal); 569 $scoringData[$i][1] =($totalPoints) ?sprintf("%.1f",100*$studentTotal/$totalPoints) : 0; 570 } 571 $scoringData[0] = ['','']; 572 $scoringData[1] = ['summary', '%score']; 573 $scoringData[2] = ['','']; 574 $scoringData[3] = ['','']; 575 $scoringData[4] = ['','']; 576 $scoringData[6] = ['','']; 577 578 579 return @scoringData; 580 } 581 582 583 # Often it's more efficient to just get everything out of the database 584 # and then pick out what you want later. Hence, these "everything2*" functions 585 sub everything2info { 586 my ($self, @everything) = @_; 587 my @result = (); 588 foreach my $row (@everything) { 589 push @result, [@{$row}[0..4]]; 590 } 591 return @result; 592 } 593 594 sub everything2normal { 595 my ($self, @everything) = @_; 596 my @result = (); 597 foreach my $row (@everything) { 598 my @row = @$row; 599 my @newRow = (); 600 push @newRow, @row[0..4]; 601 for (my $i = 5; $i < @row; $i+=3) { 602 push @newRow, $row[$i]; 603 } 604 #push @newRow, $row[$#row]; 605 push @result, [@newRow]; 606 } 607 return @result; 608 } 609 610 sub everything2full { 611 my ($self, @everything) = @_; 612 my @result = (); 613 foreach my $row (@everything) { 614 push @result, [@{$row}[0..($#{$row}-1)]]; 615 } 616 return @result; 617 } 618 619 sub everything2totals { 620 my ($self, @everything) = @_; 621 my @result = (); 622 foreach my $row (@everything) { 623 push @result, [${$row}[$#{$row}]]; 624 } 625 return @result; 626 } 627 628 sub appendColumns { 629 my ($self, $a1, $a2) = @_; 630 my @a1 = @$a1; 631 my @a2 = @$a2; 632 for (my $i = 0; $i < @a1; $i++) { 633 push @{$a1[$i]}, @{$a2[$i]}; 634 } 635 } 636 637 # Reads a CSV file and returns an array of arrayrefs, each containing a 638 # row of data: 639 # (["c1r1", "c1r2", "c1r3"], ["c2r1", "c2r2", "c2r3"]) 640 sub readCSV { 641 my ($self, $fileName) = @_; 642 my @result = (); 643 my @rows = split m/\n/, readFile($fileName); 644 foreach my $row (@rows) { 645 push @result, [split m/\s*,\s*/, $row]; 646 } 647 return @result; 648 } 649 650 # Write a CSV file from an array in the same format that readCSV produces 651 sub writeCSV { 652 my ($self, $filename, @csv) = @_; 653 654 my @lengths = (); 655 for (my $row = 0; $row < @csv; $row++) { 656 for (my $column = 0; $column < @{$csv[$row]}; $column++) { 657 $lengths[$column] = 0 unless defined $lengths[$column]; 658 $lengths[$column] = length $csv[$row][$column] if defined($csv[$row][$column]) and length $csv[$row][$column] > $lengths[$column]; 659 } 660 } 661 662 # Before writing a new totals file, we back up an existing totals file keeping any previous backups. 663 # We do not backup any other type of scoring files (e.g. ful or scr). 664 665 if (($filename =~ m|(.*)/(.*_totals)\.csv$|) and (-e $filename)) { 666 my $scoringDir = $1; 667 my $short_filename = $2; 668 my $i=1; 669 while(-e "${scoringDir}/${short_filename}_bak$i.csv") {$i++;} #don't overwrite existing backups 670 my $bakFileName ="${scoringDir}/${short_filename}_bak$i.csv"; 671 rename $filename, $bakFileName or warn "Unable to rename $filename to $bakFileName"; 672 } 673 674 open my $fh, ">", $filename or warn "Unable to open $filename for writing"; 675 foreach my $row (@csv) { 676 my @rowPadded = (); 677 foreach (my $column = 0; $column < @$row; $column++) { 678 push @rowPadded, $self->pad($row->[$column], $lengths[$column] + 1); 679 } 680 print $fh join(",", @rowPadded); 681 print $fh "\n"; 682 } 683 close $fh; 684 } 685 686 # As soon as backwards compatability is no longer a concern and we don't expect to have 687 # to use old ww1.x code to read the output anymore, I recommend switching to using 688 # these routines, which are more versatile and compatable with other programs which 689 # deal with CSV files. 690 sub readStandardCSV { 691 my ($self, $fileName) = @_; 692 my @result = (); 693 my @rows = split m/\n/, readFile($fileName); 694 foreach my $row (@rows) { 695 push @result, [$self->splitQuoted($row)]; 696 } 697 return @result; 698 } 699 700 sub writeStandardCSV { 701 my ($self, $filename, @csv) = @_; 702 open my $fh, ">", $filename; 703 foreach my $row (@csv) { 704 print $fh (join ",", map {$self->quote($_)} @$row); 705 print $fh "\n"; 706 } 707 close $fh; 708 } 709 710 ### 711 712 # This particular unquote method unquotes (optionally) quoted strings in the 713 # traditional CSV style (double-quote for literal quote, etc.) 714 sub unquote { 715 my ($self, $string) = @_; 716 if ($string =~ m/^"(.*)"$/) { 717 $string = $1; 718 $string =~ s/""/"/; 719 } 720 return $string; 721 } 722 723 # Should you wish to treat whitespace differently, this routine has been designed 724 # to make it easy to do so. 725 sub splitQuoted { 726 my ($self, $string) = @_; 727 my ($leadingSpace, $preText, $quoted, $postText, $trailingSpace, $result); 728 my @result = (); 729 my $continue = 1; 730 while ($continue) { 731 $string =~ m/\G(\s*)/gc; 732 $leadingSpace = $1; 733 $string =~ m/\G([^",]*)/gc; 734 $preText = $1; 735 if ($string =~ m/\G"((?:[^"]|"")*)"/gc) { 736 $quoted = $1; 737 } 738 $string =~ m/\G([^,]*?)(\s*)(,?)/gc; 739 ($postText, $trailingSpace, $continue) = ($1, $2, $3); 740 741 $preText = "" unless defined $preText; 742 $postText = "" unless defined $postText; 743 $quoted = "" unless defined $quoted; 744 745 if ($quoted and (not $preText and not $postText)) { 746 $quoted =~ s/""/"/; 747 $result = $quoted; 748 } else { 749 $result = "$preText$quoted$postText"; 750 } 751 push @result, $result; 752 } 753 return @result; 754 } 755 756 # This particular quoting method does CSV-style (double a quote to escape it) quoting when necessary. 757 sub quote { 758 my ($self, $string) = @_; 759 if ($string =~ m/[", ]/) { 760 $string =~ s/"/""/; 761 $string = "\"$string\""; 762 } 763 return $string; 764 } 765 766 sub pad { 767 my ($self, $string, $padTo) = @_; 768 $string = '' unless defined $string; 769 return $string unless $self->{padFields}==1; 770 my $spaces = $padTo - length $string; 771 772 # return " "x$spaces.$string; 773 return $string." "x$spaces; 774 } 775 776 sub maxLength { 777 my ($self, $arrayRef) = @_; 778 my $max = 0; 779 foreach my $cell (@$arrayRef) { 780 $max = length $cell unless length $cell < $max; 781 } 782 return $max; 783 } 784 785 sub popup_set_form { 786 my $self = shift; 787 my $r = $self->r; 788 my $db = $r->db; 789 my $ce = $r->ce; 790 my $authz = $r->authz; 791 my $user = $r->param('user'); 792 793 my $root = $ce->{webworkURLs}->{root}; 794 my $courseName = $ce->{courseName}; 795 796 # return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools"); 797 798 # This code will require changing if the permission and user tables ever have different keys. 799 my @setNames = (); 800 my $ra_set_records = $self->{ra_set_records}; 801 my %setLabels = ();# %$hr_classlistLabels; 802 my @set_records = sort {$a->set_id cmp $b->set_id } @{$ra_set_records}; 803 foreach my $sr (@set_records) { 804 $setLabels{$sr->set_id} = $sr->set_id; 805 push(@setNames, $sr->set_id); # reorder sets 806 } 807 return CGI::popup_menu(-name=>'selectedSet', 808 -values=>\@setNames, 809 -labels=>\%setLabels, 810 -size => 10, 811 -multiple => 1, 812 #-default=>$user 813 ), 814 815 816 } 817 1; 818 819 __END__ 820 821 Here's pretty much everything I can think of that we can get out of the database 822 or calculate: 823 824 for each set, we have a few rows of non-user-specific data above the student rows 825 (we could just have additional columns for these values, but they'd have the same value in every row) 826 set_id 827 optional other set data (dates, etc) 828 per-problem data (usually not shown, but available if needed) 829 problem_id 830 problem value 831 for all problems in the set 832 total value 833 for each student (one row) we need columns for: 834 user_id and/or student_id 835 optional other user data (first_name/last_name, section, recitation, etc) 836 per-set data 837 per-problem data (usually not shown, but available if needed) 838 status 839 score = value*status 840 number of attempts 841 number of correct attempts 842 number of incorrect attempts 843 for all problems in the set 844 total status 845 total score 846 total number of attempts 847 average number of attempts 848 total number of correct attempts 849 average number of correct attempts 850 total number of incorrect attempts 851 average number of incorrect attempts 852 index = ( total_status / total_value )**2 / average_number_of_attempts 853 854 "value" is the weight of the problem, in the range [0,inf), usually 1. 855 "status" is the correctness of a problem, in the range [0,1].
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |