[system] / trunk / webwork2 / lib / WeBWorK / ContentGenerator / Instructor / Stats.pm Repository:
ViewVC logotype

Annotation of /trunk/webwork2/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1667 - (view) (download) (as text)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9