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