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