Parent Directory
| 
Revision Log
Replaced "getuserProblems by getAllUserProblems when printing statistics for a single user (many sets) The time when from 178 to 35 using GDBM. It went from 15sec to 16sec (on a different course) when using sql. --Mike
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.16 2004/01/31 04:08:57 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); 31 use WeBWorK::DB::Record::Set; 32 33 34 sub initialize { 35 my $self = shift; 36 # FIXME are there args here? 37 my $type = shift || ''; 38 my @components = @_; 39 my $r = $self->{r}; 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 #FIXME these don't appear to be used any where 46 # $setName = 0 unless defined($setName); #FIXME relay to index page for statistics 47 # my $setRecord = $db->getGlobalSet($setName); # checked 48 # # die "global set $setName not found." unless $setRecord; 49 # 50 # $self->{set} = $setRecord; 51 ##################################### 52 $self->{type} = $type; 53 if ($type eq 'student') { 54 $self->{studentName } = $components[0] || $user; 55 56 } elsif ($type eq 'set') { 57 $self->{setName} = $components[0] || 0 ; 58 } 59 60 61 } 62 63 sub path { 64 my $self = shift; 65 my $args = $_[-1]; 66 my $ce = $self->{ce}; 67 my $root = $ce->{webworkURLs}->{root}; 68 my $courseName = $ce->{courseName}; 69 70 return $self->pathMacro($args, 71 "Home" => "$root", 72 $courseName => "$root/$courseName", 73 'Instructor Tools' => "$root/$courseName/instructor", 74 'Statistics' => 75 ($self->{type} 76 ? "$root/$courseName/instructor/stats/" 77 : "" 78 ), 79 ($self->{type} eq 'set' 80 ? ("set ".$self->{setName} => '') 81 : () 82 ), 83 ($self->{type} eq 'student' 84 ? ("user ".$self->{studentName} => '') 85 : () 86 ), 87 ); 88 } 89 90 sub title { 91 my ($self, @components) = @_; 92 my $type = $self->{type}; 93 my $string = "Statistics for ".$self->{ce}->{courseName}." "; 94 if ($type eq 'student') { 95 $string .= "student ".$self->{studentName}; 96 } elsif ($type eq 'set' ) { 97 $string .= "set ".$self->{setName}; 98 } 99 return $string; 100 } 101 sub body { 102 my $self = shift; 103 my $args = pop(@_); 104 my $type = $self->{type}; 105 if ($type eq 'student') { 106 $self->displayStudents($self->{studentName}); 107 } elsif( $type eq 'set') { 108 my $setName = $self->{setName}; 109 $self->displaySets($self->{setName}); 110 } elsif ($type eq '') { 111 $self->index; 112 } else { 113 warn "Don't recognize statistics display type: |$type|"; 114 115 } 116 117 118 return ''; 119 120 } 121 sub index { 122 my $self = shift; 123 my $ce = $self->{ce}; 124 my $r = $self->{r}; 125 my $courseName = $ce->{courseName}; 126 my $db = $self->{db}; 127 my @studentList = sort $db->listUsers; 128 my @setList = sort $db->listGlobalSets; 129 my $uri = $r->uri; 130 my @setLinks = (); 131 my @studentLinks = (); 132 foreach my $set (@setList) { 133 push @setLinks, CGI::a({-href=>"${uri}set/$set/?".$self->url_authen_args },"set $set" ); 134 } 135 136 foreach my $student (@studentList) { 137 push @studentLinks, CGI::a({-href=>"${uri}student/$student/?".$self->url_authen_args}," $student" ),; 138 } 139 print join("", 140 CGI::start_table({-border=>2, -cellpadding=>20}), 141 CGI::Tr( 142 CGI::td({-valign=>'top'}, 143 CGI::h3({-align=>'center'},'View statistics by set'), 144 CGI::ul( CGI::li( [@setLinks] ) ), 145 ), 146 CGI::td({-valign=>'top'}, 147 CGI::h3({-align=>'center'},'View statistics by student'), 148 CGI::ul(CGI::li( [ @studentLinks ] ) ), 149 ), 150 ), 151 CGI::end_table(), 152 ); 153 154 } 155 sub displaySets { 156 my $self = shift; 157 #FIXME 158 my $setName = shift; 159 160 my $r = $self->{r}; 161 my $db = $self->{db}; 162 my $ce = $self->{ce}; 163 my $authz = $self->{authz}; 164 my $user = $r->param('user'); 165 my $courseName = $ce->{courseName}; 166 my $setRecord = $db->getGlobalSet($setName); # checked 167 die "global set $setName not found." unless $setRecord; 168 my $root = $ce->{webworkURLs}->{root}; 169 my $url = $r->uri; 170 my $sort_method_name = $r->param('sort'); 171 my @studentList = $db->listUsers; 172 173 my $sort_method = sub { 174 my ($a,$b) = @_; 175 return 0 unless defined($sort_method_name); 176 return $b->{score} <=> $a->{score} if $sort_method_name eq 'score'; 177 return $b->{index} <=> $a->{index} if $sort_method_name eq 'index'; 178 return $a->{section} cmp $b->{section} if $sort_method_name eq 'section'; 179 if ($sort_method_name =~/p(\d+)/) { 180 my $left = $b->{problemData}->{$1} ||0; 181 my $right = $a->{problemData}->{$1} ||0; 182 return $left <=> $right; # sort by number of attempts. 183 } 184 185 }; 186 #FIXME need to be able to sort by index and score as well. 187 ############################################################### 188 # Print table 189 ############################################################### 190 my @problems = sort {$a <=> $b } $db->listUserProblems($user, $setName); 191 192 # FIXME I'm assuming the problems are all the same 193 194 my $num_of_problems = @problems; 195 # get user records 196 $WeBWorK::timer->continue("Begin obtaining user records for set $setName") if defined($WeBWorK::timer); 197 my @userRecords = $db->getUsers(@studentList); 198 $WeBWorK::timer->continue("End obtaining user records for set $setName") if defined($WeBWorK::timer); 199 $WeBWorK::timer->continue("begin main loop") if defined($WeBWorK::timer); 200 my @augmentedUserRecords = (); 201 foreach my $studentRecord (@userRecords) { 202 next unless ref($studentRecord); 203 my $student = $studentRecord->user_id; 204 next if $studentRecord->last_name =~/^practice/i; # don't show practice users 205 next if $studentRecord->status !~/C/; # don't show dropped students FIXME 206 my $status = 0; 207 my $attempted = 0; 208 my $longStatus = ''; 209 my $string = ''; 210 my $twoString = ''; 211 my $totalRight = 0; 212 my $total = 0; 213 my $num_of_attempts = 0; 214 my %h_problemData = (); 215 my $probNum = 0; 216 my @triplets = map {[$student, $setName, $_ ]} @problems; 217 $WeBWorK::timer->continue("Begin obtaining problem records for user $student set $setName") if defined($WeBWorK::timer); 218 #my @problemRecords = $db->getUserProblems( @triplets ); 219 my @problemRecords = $db->getAllUserProblems( $student, $setName ); 220 $WeBWorK::timer->continue("End obtaining problem records for user $student set $setName") if defined($WeBWorK::timer); 221 222 foreach my $problemRecord (@problemRecords) { 223 next unless ref($problemRecord); 224 my $prob = $problemRecord->problem_id; 225 #foreach my $prob (@problems) { 226 #my $problemRecord = $db->getUserProblem($student, $setName, $prob); 227 $probNum++; 228 my $valid_status = 0; 229 unless (defined($problemRecord) ){ 230 # warn "Can't find record for problem $prob in set $setName for $student"; 231 # FIXME check the legitimate reasons why a student record might not be defined 232 next; 233 } 234 $status = $problemRecord->status || 0; 235 $attempted = $problemRecord->attempted; 236 if (!$attempted){ 237 $longStatus = '. '; 238 } 239 elsif ($status >= 0 and $status <=1 ) { 240 $valid_status = 1; 241 $longStatus = int(100*$status+.5); 242 if ($longStatus == 100) { 243 $longStatus = 'C '; 244 } 245 else { 246 $longStatus = &threeSpaceFill($longStatus); 247 } 248 } 249 else { 250 $longStatus = 'X '; 251 } 252 253 my $incorrect = $problemRecord->num_incorrect || 0; 254 # It's possible that $incorrect is an empty or blank string instead of 0 the || clause fixes this and prevents 255 # warning messages in the comparison below. 256 $incorrect = ($incorrect < 99) ? $incorrect: 99; # take min 257 $string .= $longStatus; 258 $twoString .= threeSpaceFill($incorrect); 259 my $probValue = $problemRecord->value; 260 $probValue = 1 unless defined($probValue); # FIXME?? set defaults here? 261 $total += $probValue; 262 $totalRight += round_score($status*$probValue) if $valid_status; 263 my $num_correct = $problemRecord->num_incorrect || 0; 264 my $num_incorrect = $problemRecord->num_correct || 0; 265 $num_of_attempts += $num_correct + $num_incorrect; 266 $h_problemData{$probNum} = $incorrect; 267 } 268 # FIXME we can do this more effficiently get the list first 269 270 271 my $act_as_student_url = "$root/$courseName/$setName?user=".$r->param("user"). 272 "&effectiveUser=".$studentRecord->user_id()."&key=".$r->param("key"); 273 my $email = $studentRecord->email_address; 274 # FIXME this needs formatting 275 276 my $avg_num_attempts = ($num_of_problems) ? $num_of_attempts/$num_of_problems : 0; 277 my $successIndicator = ($avg_num_attempts) ? ($totalRight/$total)**2/$avg_num_attempts : 0 ; 278 my $temp_hash = { user_id => $studentRecord->user_id, 279 last_name => $studentRecord->last_name, 280 first_name => $studentRecord->first_name, 281 score => $totalRight, 282 total => $total, 283 index => $successIndicator, 284 section => $studentRecord->section, 285 recitation => $studentRecord->recitation, 286 problemString => "<pre>$string\n$twoString</pre>", 287 act_as_student => $act_as_student_url, 288 email_address => $studentRecord->email_address, 289 problemData => {%h_problemData}, 290 }; 291 push( @augmentedUserRecords, $temp_hash ); 292 293 } 294 $WeBWorK::timer->continue("end mainloop") if defined($WeBWorK::timer); 295 296 @augmentedUserRecords = sort { &$sort_method($a,$b) 297 || 298 lc($a->{last_name}) cmp lc($b->{last_name} ) } @augmentedUserRecords; 299 300 # construct header 301 my $problem_header = ''; 302 my $i=0; 303 foreach (@problems) { 304 $i++; 305 $problem_header .= CGI::a({"href"=>$url."?".$self->url_authen_args."&sort=p$i"},threeSpaceFill($i) ); 306 } 307 print 308 defined($sort_method_name) ?"sort method is $sort_method_name":"", 309 CGI::start_table({-border=>5,style=>'font-size:smaller'}), 310 CGI::Tr(CGI::th( {-align=>'center'}, 311 [CGI::a({"href"=>$url."?".$self->url_authen_args."&sort=name"},'Name'), 312 CGI::a({"href"=>$url."?".$self->url_authen_args."&sort=score"},'Score'), 313 'Out'.CGI::br().'Of', 314 CGI::a({"href"=>$url."?".$self->url_authen_args."&sort=index"},'Ind'), 315 '<pre>Problems'.CGI::br().$problem_header.'</pre>', 316 CGI::a({"href"=>$url."?".$self->url_authen_args."&sort=section"},'Section'), 317 'Recitation', 318 'login_name', 319 ]) 320 321 ); 322 323 foreach my $rec (@augmentedUserRecords) { 324 my $fullName = join("", $rec->{first_name}," ", $rec->{last_name}); 325 my $email = $rec->{email_address}; 326 my $twoString = $rec->{twoString}; 327 print CGI::Tr( 328 CGI::td(CGI::a({-href=>$rec->{act_as_student}},$fullName), CGI::br(), CGI::a({-href=>"mailto:$email"},$email)), 329 CGI::td( sprintf("%0.2f",$rec->{score}) ), # score 330 CGI::td($rec->{total}), # out of 331 CGI::td(sprintf("%0.0f",100*($rec->{index}) )), # indicator 332 CGI::td($rec->{problemString}), # problems 333 CGI::td($rec->{section}), 334 CGI::td($rec->{recitation}), 335 CGI::td($rec->{user_id}), 336 337 ); 338 } 339 340 print CGI::end_table(); 341 342 343 344 345 return ""; 346 } 347 sub displayStudents { 348 my $self = shift; 349 my $studentName = shift; 350 my $r = $self->{r}; 351 my $db = $self->{db}; 352 my $ce = $self->{ce}; 353 my $courseName = $ce->{courseName}; 354 my $studentRecord = $db->getUser($studentName); # checked 355 die "record for user $studentName not found" unless $studentRecord; 356 my $root = $ce->{webworkURLs}->{root}; 357 358 my @setIDs = sort $db->listUserSets($studentName); 359 my $fullName = join("", $studentRecord->first_name," ", $studentRecord->last_name); 360 my $act_as_student_url = "$root/$courseName/?user=".$r->param("user"). 361 "&effectiveUser=".$studentRecord->user_id()."&key=".$r->param("key"); 362 363 my $email = $studentRecord->email_address; 364 print CGI::h3($fullName ), 365 CGI::a({-href=>"mailto:$email"},$email),CGI::br(), 366 "Section: ", $studentRecord->section, CGI::br(), 367 "Recitation: ", $studentRecord->recitation,CGI::br(), 368 CGI::a({-href=>$act_as_student_url},$studentRecord->user_id); 369 370 ############################################################### 371 # Print table 372 ############################################################### 373 374 # FIXME I'm assuming the problems are all the same 375 # FIXME what does this mean? 376 377 my @rows; 378 my $max_problems=0; 379 380 foreach my $setName (@setIDs) { 381 my $status = 0; 382 my $attempted = 0; 383 my $longStatus = ''; 384 my $string = ''; 385 my $twoString = ''; 386 my $totalRight = 0; 387 my $total = 0; 388 my $num_of_attempts = 0; 389 my @problems = sort {$a <=> $b } $db->listUserProblems($studentName, $setName); 390 my $num_of_problems = @problems; 391 $max_problems = $num_of_problems if $num_of_problems > $max_problems; 392 # construct header 393 $WeBWorK::timer->continue("Begin collecting problems for set $setName") if defined($WeBWorK::timer); 394 #my @problemRecords = $db->getUserProblems( map {[$studentName, $setName,$_]} @problems); 395 my @problemRecords = $db->getAllUserProblems( $studentName, $setName ); 396 $WeBWorK::timer->continue("End collecting problems for set $setName") if defined($WeBWorK::timer); 397 foreach my $problemRecord (@problemRecords) { 398 my $prob = $problemRecord->problem_id; 399 #foreach my $prob (@problems) { 400 #my $problemRecord = $db->getUserProblem($studentName, $setName, $prob); 401 402 my $valid_status = 0; 403 unless (defined($problemRecord) ){ 404 # warn "Can't find record for problem $prob in set $setName for $student"; 405 # FIXME check the legitimate reasons why a student record might not be defined 406 next; 407 } 408 $status = $problemRecord->status || 0; 409 $attempted = $problemRecord->attempted; 410 if (!$attempted){ 411 $longStatus = '. '; 412 } 413 elsif ($status >= 0 and $status <=1 ) { 414 $valid_status = 1; 415 $longStatus = int(100*$status+.5); 416 if ($longStatus == 100) { 417 $longStatus = 'C '; 418 } 419 else { 420 $longStatus = &threeSpaceFill($longStatus); 421 } 422 } 423 else { 424 $longStatus = 'X '; 425 } 426 427 my $incorrect = $problemRecord->num_incorrect; 428 $incorrect = ($incorrect < 99) ? $incorrect: 99; # take min 429 $string .= $longStatus; 430 $twoString .= threeSpaceFill($incorrect); 431 my $probValue = $problemRecord->value; 432 $probValue = 1 unless defined($probValue); # FIXME?? set defaults here? 433 $total += $probValue; 434 $totalRight += round_score($status*$probValue) if $valid_status; 435 my $num_correct = $problemRecord->num_incorrect || 0; 436 my $num_incorrect = $problemRecord->num_correct || 0; 437 $num_of_attempts += $num_correct + $num_incorrect; 438 } 439 440 # FIXME we can do this more effficiently get the list first 441 442 443 # FIXME this needs formatting 444 445 my $avg_num_attempts = ($num_of_problems) ? $num_of_attempts/$num_of_problems : 0; 446 my $successIndicator = ($avg_num_attempts) ? ($totalRight/$total)**2/$avg_num_attempts : 0 ; 447 448 push @rows, CGI::Tr( 449 CGI::td($setName), 450 CGI::td(sprintf("%0.2f",$totalRight)), # score 451 CGI::td($total), # out of 452 CGI::td(sprintf("%0.0f",100*$successIndicator)), # indicator 453 CGI::td("<pre>$string\n$twoString</pre>"), # problems 454 #CGI::td($studentRecord->section), 455 #CGI::td($studentRecord->recitation), 456 #CGI::td($studentRecord->user_id), 457 458 ); 459 460 } 461 462 my $problem_header = ""; 463 foreach (1 .. $max_problems) { 464 $problem_header .= &threeSpaceFill($_); 465 } 466 467 my $table_header = join("\n", 468 CGI::start_table({-border=>5}), 469 CGI::Tr( 470 CGI::th({ -align=>'center',},'Set'), 471 CGI::th({ -align=>'center', },'Score'), 472 CGI::th({ -align=>'center', },'Out'.CGI::br().'Of'), 473 CGI::th({ -align=>'center', },'Ind'), 474 CGI::th({ -align=>'center', },'Problems'.CGI::br().CGI::pre($problem_header)), 475 #CGI::th({ -align=>'center', },'Section'), 476 #CGI::th({ -align=>'center', },'Recitation'), 477 #CGI::th({ -align=>'center', },'login_name'), 478 #CGI::th({ -align=>'center', },'ID'), 479 ) 480 ); 481 482 print $table_header; 483 print @rows; 484 print CGI::end_table(); 485 486 return ""; 487 } 488 489 ################################# 490 # Utility function NOT a method 491 ################################# 492 sub threeSpaceFill { 493 my $num = shift @_ || 0; 494 495 if ($num < 10) {return "$num".' ';} 496 elsif ($num < 100) {return "$num".' ';} 497 else {return "$num";} 498 } 499 sub round_score{ 500 return shift; 501 } 502 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |