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