Parent Directory
| 
Revision Log
Bring HEAD and rel-2-1-patches in line with each other.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm,v 1.52 2005/05/19 20:53:18 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::Stats; 18 use base qw(WeBWorK::ContentGenerator::Instructor); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::Instructor::Stats - Display statistics by user or 23 problem set. 24 25 =cut 26 27 use strict; 28 use warnings; 29 use CGI qw(); 30 use WeBWorK::Utils qw(readDirectory list2hash max sortByName); 31 use WeBWorK::DB::Record::Set; 32 use WeBWorK::ContentGenerator::Grades; 33 # The table format has been borrowed from the Grades.pm module 34 sub initialize { 35 my $self = shift; 36 # FIXME are there args here? 37 my @components = @_; 38 my $r = $self->{r}; 39 my $urlpath = $r->urlpath; 40 my $type = $urlpath->arg("statType") || ''; 41 my $db = $self->{db}; 42 my $ce = $self->{ce}; 43 my $authz = $self->{authz}; 44 my $courseName = $urlpath->arg('courseID'); 45 my $user = $r->param('user'); 46 47 # Check permissions 48 return unless $authz->hasPermissions($user, "access_instructor_tools"); 49 50 $self->{type} = $type; 51 if ($type eq 'student') { 52 my $studentName = $r->urlpath->arg("userID") || $user; 53 $self->{studentName } = $studentName; 54 55 } elsif ($type eq 'set') { 56 my $setName = $r->urlpath->arg("setID") || 0; 57 $self->{setName} = $setName; 58 my $setRecord = $db->getGlobalSet($setName); # checked 59 die "global set $setName not found." unless $setRecord; 60 $self->{set_due_date} = $setRecord->due_date; 61 $self->{setRecord} = $setRecord; 62 } 63 64 65 } 66 67 68 sub title { 69 my ($self) = @_; 70 my $r = $self->r; 71 my $authz = $r->authz; 72 my $user = $r->param('user'); 73 74 return "" unless $authz->hasPermissions($user, "access_instructor_tools"); 75 76 my $type = $self->{type}; 77 my $string = "Statistics for ".$self->{ce}->{courseName}." "; 78 79 if ($type eq 'student') { 80 $string .= "student ".$self->{studentName}; 81 } elsif ($type eq 'set' ) { 82 $string .= "set ".$self->{setName}; 83 $string .= ". Due ". $self->formatDateTime($self->{set_due_date}); 84 } 85 return $string; 86 } 87 sub siblings { 88 my ($self) = @_; 89 my $r = $self->r; 90 my $db = $r->db; 91 my $authz = $r->authz; 92 my $user = $r->param('user'); 93 my $urlpath = $r->urlpath; 94 95 # Check permissions 96 return "" unless $authz->hasPermissions($user, "access_instructor_tools"); 97 98 my $courseID = $urlpath->arg("courseID"); 99 my $eUserID = $r->param("effectiveUser"); 100 my @setIDs = sort $db->listGlobalSets; 101 102 my $stats = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::Stats", 103 courseID => $courseID); 104 105 print CGI::start_ul({class=>"LinksMenu"}); 106 print CGI::start_li(); 107 print CGI::span({style=>"font-size:larger"}, CGI::a({href=>$self->systemLink($stats)}, 'Statistics')); 108 print CGI::start_ul(); 109 110 foreach my $setID (@setIDs) { 111 my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::Stats", 112 courseID => $courseID, setID => $setID,statType => 'set',); 113 print CGI::li(CGI::a({href=>$self->systemLink($problemPage)}, underscore2nbsp($setID))); 114 } 115 116 print CGI::end_ul(); 117 print CGI::end_li(); 118 print CGI::end_ul(); 119 120 return ""; 121 } 122 sub body { 123 my $self = shift; 124 my $r = $self->r; 125 my $urlpath = $r->urlpath; 126 my $db = $r->db; 127 my $ce = $r->ce; 128 my $authz = $r->authz; 129 my $courseName = $urlpath->arg("courseID"); 130 my $user = $r->param('user'); 131 my $type = $self->{type}; 132 133 # Check permissions 134 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to access instructor tools")) 135 unless $authz->hasPermissions($user, "access_instructor_tools"); 136 137 if ($type eq 'student') { 138 my $studentName = $self->{studentName}; 139 140 my $studentRecord = $db->getUser($studentName); # checked 141 die "record for user $studentName not found" unless $studentRecord; 142 143 my $fullName = join("", $studentRecord->first_name," ", $studentRecord->last_name); 144 145 my $courseHomePage = $urlpath->new(type => 'set_list', 146 args => {courseID => $courseName} 147 ); 148 my $act_as_student_url = $self->systemLink($courseHomePage, 149 params => { effectiveUser => $studentName } 150 ); 151 152 my $email = $studentRecord->email_address; 153 print 154 CGI::a({-href=>"mailto:$email"},$email),CGI::br(), 155 "Section: ", $studentRecord->section, CGI::br(), 156 "Recitation: ", $studentRecord->recitation,CGI::br(), 157 'Act as: ', 158 CGI::a({-href=>$act_as_student_url},$studentRecord->user_id); 159 WeBWorK::ContentGenerator::Grades::displayStudentStats($self,$studentName); 160 161 # The table format has been borrowed from the Grades.pm module 162 } elsif( $type eq 'set') { 163 my $setName = $self->{setName}; 164 $self->displaySets($self->{setName}); 165 } elsif ($type eq '') { 166 $self->index; 167 } else { 168 warn "Don't recognize statistics display type: |$type|"; 169 170 } 171 172 173 return ''; 174 175 } 176 sub index { 177 my $self = shift; 178 my $r = $self->r; 179 my $urlpath = $r->urlpath; 180 my $ce = $r->ce; 181 my $db = $r->db; 182 my $courseName = $urlpath->arg("courseID"); 183 184 my @studentList = sort $db->listUsers; 185 my @setList = sort $db->listGlobalSets; 186 187 188 my @setLinks = (); 189 my @studentLinks = (); 190 foreach my $set (@setList) { 191 my $setStatisticsPage = $urlpath->newFromModule($urlpath->module, 192 courseID => $courseName, 193 statType => 'set', 194 setID => $set 195 ); 196 push @setLinks, CGI::a({-href=>$self->systemLink($setStatisticsPage) }, underscore2nbsp($set)); 197 } 198 199 foreach my $student (@studentList) { 200 my $userStatisticsPage = $urlpath->newFromModule($urlpath->module, 201 courseID => $courseName, 202 statType => 'student', 203 userID => $student 204 ); 205 push @studentLinks, CGI::a({-href=>$self->systemLink($userStatisticsPage, 206 prams=>{effectiveUser => $student} 207 )}," $student" ),; 208 } 209 print join("", 210 CGI::start_table({-border=>2, -cellpadding=>20}), 211 CGI::Tr( 212 CGI::td({-valign=>'top'}, 213 CGI::h3({-align=>'center'},'View statistics by set'), 214 CGI::ul( CGI::li( [@setLinks] ) ), 215 ), 216 CGI::td({-valign=>'top'}, 217 CGI::h3({-align=>'center'},'View statistics by student'), 218 CGI::ul(CGI::li( [ @studentLinks ] ) ), 219 ), 220 ), 221 CGI::end_table(), 222 ); 223 224 } 225 ################################################### 226 # Determines the percentage of students whose score is greater than a given value 227 # The percentages are fixed at 75, 50, 25 and 5% 228 sub determine_percentiles { 229 my $percent_brackets = shift; 230 my @list_of_scores = @_; 231 @list_of_scores = sort {$a<=>$b} @list_of_scores; 232 my %percentiles = (); 233 my $num_students = $#list_of_scores; 234 foreach my $percentage (@{$percent_brackets}) { 235 $percentiles{$percentage} = @list_of_scores[int( (100-$percentage)*$num_students/100)]; 236 $percentiles{$percentage} =0 unless defined($percentiles{$percentage}); #in case no students have tried this question 237 } 238 # for example 239 # $percentiles{75} = @list_of_scores[int( 25*$num_students/100)]; 240 # means that 75% of the students received this score ($percentiles{75}) or higher 241 %percentiles; 242 } 243 sub prevent_repeats { # replace a string such as 0 0 0 86 86 100 100 100 by 0 - - 86 - 100 - - 244 my @inarray = @_; 245 my @outarray = (); 246 my $saved_item = shift @inarray; 247 push @outarray, $saved_item; 248 while (@inarray ) { 249 my $current_item = shift @inarray; 250 if ( $current_item == $saved_item ) { 251 push @outarray, ' -'; 252 } else { 253 push @outarray, $current_item; 254 $saved_item = $current_item; 255 } 256 } 257 @outarray; 258 } 259 260 sub displaySets { 261 my $self = shift; 262 my $r = $self->r; 263 my $urlpath = $r->urlpath; 264 my $db = $r->db; 265 my $ce = $r->ce; 266 my $authz = $r->authz; 267 my $courseName = $urlpath->arg("courseID"); 268 my $setName = $urlpath->arg("setID"); 269 my $user = $r->param('user'); 270 my $setRecord = $self->{setRecord}; 271 my $root = $ce->{webworkURLs}->{root}; 272 273 my $setStatsPage = $urlpath->newFromModule($urlpath->module,courseID=>$courseName,statType=>'sets',setID=>$setName); 274 my $sort_method_name = $r->param('sort'); 275 my @studentList = $db->listUsers; 276 277 my @index_list = (); # list of all student index 278 my @score_list = (); # list of all student total percentage scores 279 my %attempts_list_for_problem = (); # a list of the number of attempts for each problem 280 my %number_of_attempts_for_problem = (); # the total number of attempst for this problem (sum of above list) 281 my %number_of_students_attempting_problem = (); # the number of students attempting this problem. 282 my %correct_answers_for_problem = (); # the number of students correctly answering this problem (partial correctness allowed) 283 my $sort_method = sub { 284 my ($a,$b) = @_; 285 return 0 unless defined($sort_method_name); 286 return $b->{score} <=> $a->{score} if $sort_method_name eq 'score'; 287 return $b->{index} <=> $a->{index} if $sort_method_name eq 'index'; 288 return $a->{section} cmp $b->{section} if $sort_method_name eq 'section'; 289 if ($sort_method_name =~/p(\d+)/) { 290 my $left = $b->{problemData}->{$1} ||0; 291 my $right = $a->{problemData}->{$1} ||0; 292 return $left <=> $right; # sort by number of attempts. 293 } 294 295 }; 296 297 ############################################################### 298 # Print tables 299 ############################################################### 300 301 my $max_num_problems = 0; 302 # get user records 303 $WeBWorK::timer->continue("Begin obtaining user records for set $setName") if defined($WeBWorK::timer); 304 my @userRecords = $db->getUsers(@studentList); 305 $WeBWorK::timer->continue("End obtaining user records for set $setName") if defined($WeBWorK::timer); 306 $WeBWorK::timer->continue("begin main loop") if defined($WeBWorK::timer); 307 my @augmentedUserRecords = (); 308 my $number_of_active_students; 309 310 ######################################## 311 # Notes for factoring this calculation 312 # 313 # Inputs include: 314 # $user 315 # $setName 316 # @userRecords 317 # @problemRecords these are fetched for each student in @userRecords 318 # 319 ################################### 320 321 foreach my $studentRecord (@userRecords) { 322 next unless ref($studentRecord); 323 my $student = $studentRecord->user_id; 324 next if $studentRecord->last_name =~/^practice/i; # don't show practice users 325 next if $studentRecord->status !~/C/; # don't show dropped students FIXME 326 $number_of_active_students++; 327 my $string = ''; 328 my $twoString = ''; 329 my $totalRight = 0; 330 my $total = 0; 331 my $total_num_of_attempts_for_set = 0; 332 my %h_problemData = (); 333 my $probNum = 0; 334 335 $WeBWorK::timer->continue("Begin obtaining problem records for user $student set $setName") if defined($WeBWorK::timer); 336 337 my @problemRecords = sort {$a->problem_id <=> $b->problem_id } $db->getAllUserProblems( $student, $setName ); 338 $WeBWorK::timer->continue("End obtaining problem records for user $student set $setName") if defined($WeBWorK::timer); 339 my $num_of_problems = @problemRecords; 340 $max_num_problems = ($max_num_problems>= $num_of_problems) ? $max_num_problems : $num_of_problems; 341 ######################################## 342 # Notes for factoring the calculation in this loop. 343 # 344 # Inputs include: 345 # 346 # 347 # @problemRecords 348 # returns 349 # $num_of_attempts 350 # $status 351 # updates 352 # $number_of_students_attempting_problem{$probID}++; 353 # @{ $attempts_list_for_problem{$probID} } 354 # $number_of_attempts_for_problem{$probID} 355 # $total_num_of_attempts_for_set 356 # $correct_answers_for_problem{$probID} 357 # 358 # $string (formatting output) 359 # $twoString (more formatted output) 360 # $total 361 # $totalRight 362 ################################### 363 364 foreach my $problemRecord (@problemRecords) { 365 next unless ref($problemRecord); 366 367 # warn "Can't find record for problem $prob in set $setName for $student"; 368 # FIXME check the legitimate reasons why a student record might not be defined 369 #################################################################### 370 # Grab data from the database 371 #################################################################### 372 # It's possible that $problemRecord->num_correct or $problemRecord->num_correct 373 # or $problemRecord->status is an empty 374 # or blank string instead of 0. The || clause fixes this and prevents 375 # warning messages in the comparisons below. 376 377 my $probID = $problemRecord->problem_id; 378 my $attempted = $problemRecord->attempted; 379 my $num_correct = $problemRecord->num_correct || 0; 380 my $num_incorrect = $problemRecord->num_incorrect || 0; 381 my $num_of_attempts = $num_correct + $num_incorrect; 382 383 # initialize the number of correct answers for this problem 384 # if the value has not been defined. 385 $correct_answers_for_problem{$probID} = 0 unless defined($correct_answers_for_problem{$probID}); 386 387 388 my $probValue = $problemRecord->value; 389 # set default problem value here 390 $probValue = 1 unless defined($probValue) and $probValue ne ""; # FIXME?? set defaults here? 391 392 my $status = $problemRecord->status || 0; 393 # sanity check that the status (score) is between 0 and 1 394 my $valid_status = ($status >= 0 and $status <=1 ) ? 1 : 0; 395 396 ################################################################### 397 # Determine the string $longStatus which will display the student's current score 398 ################################################################### 399 my $longStatus = ''; 400 if (!$attempted){ 401 $longStatus = '.'; 402 } elsif ($valid_status) { 403 $longStatus = int(100*$status+.5); 404 $longStatus = ($longStatus == 100) ? 'C' : $longStatus; 405 } else { 406 $longStatus = 'X'; 407 } 408 409 $string .= threeSpaceFill($longStatus); 410 $twoString .= threeSpaceFill($num_incorrect); 411 412 $total += $probValue; 413 $totalRight += round_score($status*$probValue) if $valid_status; 414 415 416 417 418 419 420 # add on the scores for this problem 421 if (defined($attempted) and $attempted) { 422 $number_of_students_attempting_problem{$probID}++; 423 push( @{ $attempts_list_for_problem{$probID} } , $num_of_attempts); 424 $number_of_attempts_for_problem{$probID} += $num_of_attempts; 425 $h_problemData{$probID} = $num_incorrect; 426 $total_num_of_attempts_for_set += $num_of_attempts; 427 $correct_answers_for_problem{$probID} += $status; 428 } 429 430 } 431 432 433 my $act_as_student_url = $self->systemLink($urlpath->new(type=>'set_list',args=>{courseID=>$courseName}), 434 params=>{effectiveUser => $studentRecord->user_id} 435 ); 436 my $email = $studentRecord->email_address; 437 # FIXME this needs formatting 438 439 my $avg_num_attempts = ($num_of_problems) ? $total_num_of_attempts_for_set/$num_of_problems : 0; 440 my $successIndicator = ($avg_num_attempts) ? ($totalRight/$total)**2/$avg_num_attempts : 0 ; 441 442 my $temp_hash = { user_id => $studentRecord->user_id, 443 last_name => $studentRecord->last_name, 444 first_name => $studentRecord->first_name, 445 score => $totalRight, 446 total => $total, 447 index => $successIndicator, 448 section => $studentRecord->section, 449 recitation => $studentRecord->recitation, 450 problemString => "<pre>$string\n$twoString</pre>", 451 act_as_student => $act_as_student_url, 452 email_address => $studentRecord->email_address, 453 problemData => {%h_problemData}, 454 }; 455 # add this data to the list of total scores (out of 100) 456 # add this data to the list of success indices. 457 push( @index_list, $temp_hash->{index}); 458 push( @score_list, ($temp_hash->{total}) ?$temp_hash->{score}/$temp_hash->{total} : 0 ) ; 459 push( @augmentedUserRecords, $temp_hash ); 460 461 } 462 $WeBWorK::timer->continue("end mainloop") if defined($WeBWorK::timer); 463 464 @augmentedUserRecords = sort { &$sort_method($a,$b) 465 || 466 lc($a->{last_name}) cmp lc($b->{last_name} ) } @augmentedUserRecords; 467 468 # sort the problem IDs 469 my @problemIDs = sort {$a<=>$b} keys %correct_answers_for_problem; 470 # determine index quartiles 471 my @brackets1 = (90,80,70,60,50,40,30,20,10); #% students having scores or indices above this cutoff value 472 my @brackets2 = (95, 75,50,25,5,1); # % students having this many incorrect attempts or more 473 my %index_percentiles = determine_percentiles(\@brackets1, @index_list); 474 my %score_percentiles = determine_percentiles(\@brackets1, @score_list); 475 my %attempts_percentiles_for_problem = (); 476 my %problemPage = (); # link to the problem page 477 foreach my $probID (@problemIDs) { 478 $attempts_percentiles_for_problem{$probID} = { 479 determine_percentiles([@brackets2], @{$attempts_list_for_problem{$probID}}) 480 481 }; 482 $problemPage{$probID} = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem", 483 courseID => $courseName, setID => $setName, problemID => $probID); 484 485 } 486 487 ##################################################################################### 488 # Table showing the percentage of students with correct answers for each problems 489 ##################################################################################### 490 491 print 492 493 CGI::p('The percentage of active students with correct answers for each problem'), 494 CGI::start_table({-border=>1}), 495 CGI::Tr(CGI::td( 496 ['Problem #', 497 map {CGI::a({ href=>$self->systemLink($problemPage{$_}) },$_)} @problemIDs 498 ] 499 )), 500 CGI::Tr(CGI::td( 501 [ '% correct',map {($number_of_students_attempting_problem{$_}) 502 ? sprintf("%0.0f",100*$correct_answers_for_problem{$_}/$number_of_students_attempting_problem{$_}) 503 : '-'} 504 @problemIDs 505 ] 506 )), 507 CGI::Tr(CGI::td( 508 [ 'avg attempts',map {($number_of_students_attempting_problem{$_}) 509 ? sprintf("%0.1f",$number_of_attempts_for_problem{$_}/$number_of_students_attempting_problem{$_}) 510 : '-'} 511 @problemIDs 512 ] 513 )), 514 CGI::end_table(); 515 516 ##################################################################################### 517 # table showing percentile statistics for scores and success indices 518 ##################################################################################### 519 print 520 521 CGI::p(CGI::i('The percentage of students receiving at least these scores.<br/> 522 The median score is in the 50% column. ')), 523 CGI::start_table({-border=>1}), 524 CGI::Tr( 525 CGI::td( ['% students', 526 (map { " ".$_ } @brackets1) , 527 'top score ', 528 529 ] 530 ) 531 ), 532 CGI::Tr( 533 CGI::td( [ 534 'Score', 535 (prevent_repeats map { sprintf("%0.0f",100*$score_percentiles{$_}) } @brackets1), 536 sprintf("%0.0f",100), 537 ] 538 ) 539 ), 540 CGI::Tr( 541 CGI::td( [ 542 'Success Index', 543 (prevent_repeats map { sprintf("%0.0f",100*$index_percentiles{$_}) } @brackets1), 544 sprintf("%0.0f",100), 545 ] 546 ) 547 ) 548 ; 549 550 print CGI::end_table(), 551 552 ; 553 554 ##################################################################################### 555 # table showing percentile statistics for scores and success indices 556 ##################################################################################### 557 print 558 559 CGI::p(CGI::i('Percentile cutoffs for number of attempts. <br/> The 50% column shows the median number of attempts')), 560 CGI::start_table({-border=>1}), 561 CGI::Tr( 562 CGI::td( ['% students', 563 (map { " ".($_) } @brackets2) , 564 565 ] 566 ) 567 ); 568 569 570 foreach my $probID (@problemIDs) { 571 print CGI::Tr( 572 CGI::td( [ 573 CGI::a({ href=>$self->systemLink($problemPage{$probID}) },"Prob $probID"), 574 ( prevent_repeats reverse map { sprintf("%0.0f",$attempts_percentiles_for_problem{$probID}->{$_}) } @brackets2), 575 576 ] 577 ) 578 ); 579 580 } 581 print CGI::end_table(); 582 583 return ""; 584 } 585 586 587 ################################# 588 # Utility function NOT a method 589 ################################# 590 sub threeSpaceFill { 591 my $num = shift @_ || 0; 592 593 if (length($num)<=1) {return "$num".' ';} 594 elsif (length($num)==2) {return "$num".' ';} 595 else {return "## ";} 596 } 597 sub round_score{ 598 return shift; 599 } 600 601 sub underscore2nbsp { 602 my $str = shift; 603 $str =~ s/_/ /g; 604 return($str); 605 } 606 607 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |