[system] / branches / gage_dev / webwork2 / lib / WeBWorK / ContentGenerator / Grades.pm Repository:
ViewVC logotype

Diff of /branches/gage_dev/webwork2/lib/WeBWorK/ContentGenerator/Grades.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 1888 Revision 1889
1################################################################################ 1################################################################################
2# WeBWorK Online Homework Delivery System 2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Grades.pm,v 1.1 2004/03/06 18:50:31 gage Exp $ 4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Grades.pm,v 1.2 2004/03/07 02:29:25 gage Exp $
5# 5#
6# This program is free software; you can redistribute it and/or modify it under 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 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 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. 9# version, or (b) the "Artistic License" which comes with this package.
… …
30use WeBWorK::Utils qw(readDirectory list2hash max); 30use WeBWorK::Utils qw(readDirectory list2hash max);
31use WeBWorK::DB::Record::Set; 31use WeBWorK::DB::Record::Set;
32 32
33 33
34sub initialize { 34sub initialize {
35 my $self = shift; 35 my ($self) = @_;
36 # FIXME are there args here?
37 my @components = @_;
38 my $r = $self->{r}; 36 my $r = $self->r;
39 my $type = $r->urlpath->arg("statType") || '';
40 my $db = $self->{db}; 37 my $db = $r->db;
41 my $ce = $self->{ce}; 38 my $ce = $r->ce;
42 my $authz = $self->{authz}; 39 my $authz = $r->authz;
40
43 my $userName = $r->param('user'); 41 my $userName = $r->param('user');
44 my $effectiveUserName = defined($self->{r}->param("effectiveUser") ) ? $self->{r}->param("effectiveUser") : $userName; 42 my $effectiveUserName = defined($r->param("effectiveUser") ) ? $r->param("effectiveUser") : $userName;
45 $self->{userName} = $userName; 43 $self->{userName} = $userName;
46 $self->{studentName} = $effectiveUserName; 44 $self->{studentName} = $effectiveUserName;
47} 45}
48 46
49sub path {
50 my $self = shift;
51 my $args = $_[-1];
52 my $ce = $self->{ce};
53 my $root = $ce->{webworkURLs}->{root};
54 my $courseName = $ce->{courseName};
55
56 return $self->pathMacro($args,
57 "Home" => "$root",
58 $courseName => "$root/$courseName",
59 'Grades' => '',
60
61 );
62}
63
64sub title {
65 my $self = shift;
66 my $string = "Grades for ".$self->{studentName}." in course ". $self->{ce}->{courseName}." ";
67 return $string;
68}
69sub body { 47sub body {
70 my $self = shift; 48 my ($self) = @_;
71 my $args = pop(@_); 49
72 my $type = $self->{type};
73
74 $self->displayStudentStats($self->{studentName}); 50 $self->displayStudentStats($self->{studentName});
75 51
76 print $self->scoring_info(); 52 print $self->scoring_info();
77 53
78 return ''; 54 return '';
79 55
80} 56}
81
82 57
83############################################ 58############################################
84# Borrowed from SendMail.pm and Instructor.pm 59# Borrowed from SendMail.pm and Instructor.pm
85############################################ 60############################################
61
86sub getRecord { 62sub getRecord {
87 my $self = shift; 63 my $self = shift;
88 my $line = shift; 64 my $line = shift;
89 my $delimiter = shift; 65 my $delimiter = shift;
90 $delimiter = ',' unless defined($delimiter); 66 $delimiter = ',' unless defined($delimiter);
… …
102 $lineArray[0] =~s/^\s*//; # remove white space from first element 78 $lineArray[0] =~s/^\s*//; # remove white space from first element
103 @lineArray; 79 @lineArray;
104} 80}
105 81
106sub read_scoring_file { # used in SendMail and Grades?....? 82sub read_scoring_file { # used in SendMail and Grades?....?
107 my $self = shift; 83 my ($self, $fileName, $delimiter) = @_;
108 my $fileName = shift; 84 my $r = $self->r;
109 my $delimiter = shift; 85 my $ce = $r->ce;
86
110 $delimiter = ',' unless defined($delimiter); 87 $delimiter = ',' unless defined($delimiter);
111 my $scoringDirectory= $self->{ce}->{courseDirs}->{scoring}; 88 my $scoringDirectory= $ce->{courseDirs}->{scoring};
112 my $filePath = "$scoringDirectory/$fileName"; 89 my $filePath = "$scoringDirectory/$fileName";
113 # Takes a delimited file as a parameter and returns an 90 # Takes a delimited file as a parameter and returns an
114 # associative array with the first field as the key. 91 # associative array with the first field as the key.
115 # Blank lines are skipped. White space is removed 92 # Blank lines are skipped. White space is removed
116 my(@dbArray,$key,$dbString); 93 my(@dbArray,$key,$dbString);
… …
132 } else { 109 } else {
133 warn "Couldn't read file $filePath"; 110 warn "Couldn't read file $filePath";
134 } 111 }
135 return \%assocArray; 112 return \%assocArray;
136} 113}
114
137sub submission_error { 115sub submission_error {
138 my $self = shift; 116 my $self = shift;
139 my $msg = join( " ", @_); 117 my $msg = join( " ", @_);
140 $self->{submitError} .= CGI::br().$msg; 118 $self->{submitError} .= CGI::br().$msg;
141 return; 119 return;
142} 120}
121
143sub scoring_info { 122sub scoring_info {
144 my $self = shift; 123 my ($self) = @_;
124 my $r = $self->r;
125 my $db = $r->db;
126 my $ce = $r->ce;
127
145 my $userName = $self->{r}->param('effectiveUser') || $self->{r}->param('user'); 128 my $userName = $r->param('effectiveUser') || $r->param('user');
146 my $ur = $self->{db}->getUser($userName); 129 my $ur = $db->getUser($userName);
147 my $emailDirectory = $self->{ce}->{courseDirs}->{email}; 130 my $emailDirectory = $ce->{courseDirs}->{email};
148 my $filePath = "$emailDirectory/report_grades.msg"; 131 my $filePath = "$emailDirectory/report_grades.msg";
149 my $merge_file = "report_grades_data.csv"; 132 my $merge_file = "report_grades_data.csv";
150 my $delimiter = ','; 133 my $delimiter = ',';
151 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 134 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
152 my $text; 135 my $text;
… …
194 {style =>"background-color:#DDDDDD"}, "More scoring information goes here in \$emailDirectory/report_grades.msg. It 177 {style =>"background-color:#DDDDDD"}, "More scoring information goes here in \$emailDirectory/report_grades.msg. It
195 is merged with the file \$scoringDirectory/report_grades_data.csv. <p> 178 is merged with the file \$scoringDirectory/report_grades_data.csv. <p>
196 <pre>$msg</pre>" 179 <pre>$msg</pre>"
197 ); 180 );
198} 181}
199############################################################################## 182
200# sub index {
201# my $self = shift;
202# my $ce = $self->{ce};
203# my $r = $self->{r};
204# my $courseName = $ce->{courseName};
205# my $db = $self->{db};
206# my @studentList = sort $db->listUsers;
207# my @setList = sort $db->listGlobalSets;
208# my $uri = $r->uri;
209# my @setLinks = ();
210# my @studentLinks = ();
211# foreach my $set (@setList) {
212# push @setLinks, CGI::a({-href=>"${uri}set/$set/?".$self->url_authen_args },"set $set" );
213# }
214#
215# foreach my $student (@studentList) {
216# push @studentLinks, CGI::a({-href=>"${uri}student/$student/?".$self->url_authen_args}," $student" ),;
217# }
218# print join("",
219# CGI::start_table({-border=>2, -cellpadding=>20}),
220# CGI::Tr(
221# CGI::td({-valign=>'top'},
222# CGI::h3({-align=>'center'},'View statistics by set'),
223# CGI::ul( CGI::li( [@setLinks] ) ),
224# ),
225# CGI::td({-valign=>'top'},
226# CGI::h3({-align=>'center'},'View statistics by student'),
227# CGI::ul(CGI::li( [ @studentLinks ] ) ),
228# ),
229# ),
230# CGI::end_table(),
231# );
232#
233# }
234###################################################
235# Determines the percentage of students whose score is greater than a given value
236# The percentages are fixed at 75, 50, 25 and 5%
237# sub determine_percentiles {
238# my $percent_brackets = shift;
239# my @list_of_scores = @_;
240# @list_of_scores = sort {$a<=>$b} @list_of_scores;
241# my %percentiles = ();
242# my $num_students = $#list_of_scores;
243# foreach my $percentage (@{$percent_brackets}) {
244# $percentiles{$percentage} = @list_of_scores[int( (100-$percentage)*$num_students/100)];
245# }
246# # for example
247# # $percentiles{75} = @list_of_scores[int( 25*$num_students/100)];
248# # means that 75% of the students received this score ($percentiles{75}) or higher
249# %percentiles;
250# }
251# sub displaySets {
252# my $self = shift;
253# my $setName = shift;
254# my $r = $self->{r};
255# my $db = $self->{db};
256# my $ce = $self->{ce};
257# my $authz = $self->{authz};
258# my $user = $r->param('user');
259# my $courseName = $ce->{courseName};
260# my $setRecord = $self->{setRecord};
261# my $root = $ce->{webworkURLs}->{root};
262# my $url = $r->uri;
263# my $sort_method_name = $r->param('sort');
264# my @studentList = $db->listUsers;
265#
266# my @index_list = (); # list of all student index
267# my @score_list = (); # list of all student total percentage scores
268# my %attempts_list_for_problem = (); # a list of the number of attempts for each problem
269# my %number_ofstudents_attempting_problem = (); # the number of students attempting this problem.
270# my %correct_answers_for_problem = (); # the number of students correctly answering this problem (partial correctness allowed)
271# my $sort_method = sub {
272# my ($a,$b) = @_;
273# return 0 unless defined($sort_method_name);
274# return $b->{score} <=> $a->{score} if $sort_method_name eq 'score';
275# return $b->{index} <=> $a->{index} if $sort_method_name eq 'index';
276# return $a->{section} cmp $b->{section} if $sort_method_name eq 'section';
277# if ($sort_method_name =~/p(\d+)/) {
278# my $left = $b->{problemData}->{$1} ||0;
279# my $right = $a->{problemData}->{$1} ||0;
280# return $left <=> $right; # sort by number of attempts.
281# }
282#
283# };
284#
285# ###############################################################
286# # Print tables
287# ###############################################################
288#
289# my $max_num_problems = 0;
290# # get user records
291# $WeBWorK::timer->continue("Begin obtaining user records for set $setName") if defined($WeBWorK::timer);
292# my @userRecords = $db->getUsers(@studentList);
293# $WeBWorK::timer->continue("End obtaining user records for set $setName") if defined($WeBWorK::timer);
294# $WeBWorK::timer->continue("begin main loop") if defined($WeBWorK::timer);
295# my @augmentedUserRecords = ();
296# my $number_of_active_students;
297#
298# foreach my $studentRecord (@userRecords) {
299# next unless ref($studentRecord);
300# my $student = $studentRecord->user_id;
301# next if $studentRecord->last_name =~/^practice/i; # don't show practice users
302# next if $studentRecord->status !~/C/; # don't show dropped students FIXME
303# $number_of_active_students++;
304# my $status = 0;
305# my $attempted = 0;
306# my $longStatus = '';
307# my $string = '';
308# my $twoString = '';
309# my $totalRight = 0;
310# my $total = 0;
311# my $num_of_attempts = 0;
312# my %h_problemData = ();
313# my $probNum = 0;
314#
315# $WeBWorK::timer->continue("Begin obtaining problem records for user $student set $setName") if defined($WeBWorK::timer);
316#
317# my @problemRecords = sort {$a->problem_id <=> $b->problem_id } $db->getAllUserProblems( $student, $setName );
318# $WeBWorK::timer->continue("End obtaining problem records for user $student set $setName") if defined($WeBWorK::timer);
319# my $num_of_problems = @problemRecords;
320# my $max_num_problems = ($max_num_problems>= $num_of_problems) ? $max_num_problems : $num_of_problems;
321#
322# foreach my $problemRecord (@problemRecords) {
323# next unless ref($problemRecord);
324# my $probID = $problemRecord->problem_id;
325#
326# my $valid_status = 0;
327# unless (defined($problemRecord) ){
328# # warn "Can't find record for problem $prob in set $setName for $student";
329# # FIXME check the legitimate reasons why a student record might not be defined
330# next;
331# }
332# $status = $problemRecord->status || 0;
333# $attempted = $problemRecord->attempted;
334# if (!$attempted){
335# $longStatus = '. ';
336# }
337# elsif ($status >= 0 and $status <=1 ) {
338# $valid_status = 1;
339# $longStatus = int(100*$status+.5);
340# if ($longStatus == 100) {
341# $longStatus = 'C ';
342# }
343# else {
344# $longStatus = &threeSpaceFill($longStatus);
345# }
346# }
347# else {
348# $longStatus = 'X ';
349# }
350#
351# my $incorrect = $problemRecord->num_incorrect || 0;
352# # It's possible that $incorrect is an empty or blank string instead of 0 the || clause fixes this and prevents
353# # warning messages in the comparison below.
354# $string .= $longStatus;
355# $twoString .= threeSpaceFill($incorrect);
356# my $probValue = $problemRecord->value;
357# $probValue = 1 unless defined($probValue); # FIXME?? set defaults here?
358# $total += $probValue;
359# $totalRight += round_score($status*$probValue) if $valid_status;
360# my $num_correct = $problemRecord->num_incorrect || 0;
361# my $num_incorrect = $problemRecord->num_correct || 0;
362# $num_of_attempts += $num_correct + $num_incorrect;
363#
364# $correct_answers_for_problem{$probID} = 0 unless defined($correct_answers_for_problem{$probID});
365# # add on the scores for this problem
366# if (defined($attempted) and $attempted) {
367# $number_ofstudents_attempting_problem{$probID}++;
368# push( @{ $attempts_list_for_problem{$probID} } , $num_correct + $num_incorrect);
369# $correct_answers_for_problem{$probID} += $status;
370# }
371#
372# }
373#
374#
375# my $act_as_student_url = "$root/$courseName/$setName?user=".$r->param("user").
376# "&effectiveUser=".$studentRecord->user_id()."&key=".$r->param("key");
377# my $email = $studentRecord->email_address;
378# # FIXME this needs formatting
379#
380# my $avg_num_attempts = ($num_of_problems) ? $num_of_attempts/$num_of_problems : 0;
381# my $successIndicator = ($avg_num_attempts) ? ($totalRight/$total)**2/$avg_num_attempts : 0 ;
382# my $temp_hash = { user_id => $studentRecord->user_id,
383# last_name => $studentRecord->last_name,
384# first_name => $studentRecord->first_name,
385# score => $totalRight,
386# total => $total,
387# index => $successIndicator,
388# section => $studentRecord->section,
389# recitation => $studentRecord->recitation,
390# problemString => "<pre>$string\n$twoString</pre>",
391# act_as_student => $act_as_student_url,
392# email_address => $studentRecord->email_address,
393# problemData => {%h_problemData},
394# };
395# # add this data to the list of total scores (out of 100)
396# # add this data to the list of success indices.
397# push( @index_list, $temp_hash->{index});
398# push( @score_list, ($temp_hash->{total}) ?$temp_hash->{score}/$temp_hash->{total} : 0 ) ;
399# push( @augmentedUserRecords, $temp_hash );
400#
401# }
402# $WeBWorK::timer->continue("end mainloop") if defined($WeBWorK::timer);
403#
404# @augmentedUserRecords = sort { &$sort_method($a,$b)
405# ||
406# lc($a->{last_name}) cmp lc($b->{last_name} ) } @augmentedUserRecords;
407#
408# # sort the problem IDs
409# my @problemIDs = sort {$a<=>$b} keys %correct_answers_for_problem;
410# # determine index quartiles
411# my @brackets = (75, 50,25,5);
412# my %index_percentiles = determine_percentiles(\@brackets, @index_list);
413# my %score_percentiles = determine_percentiles(\@brackets, @score_list);
414# my %attempts_percentiles_for_problem = ();
415# foreach my $probID (@problemIDs) {
416# $attempts_percentiles_for_problem{$probID} = {
417# determine_percentiles([@brackets, 0], @{$attempts_list_for_problem{$probID}})
418# };
419# }
420#
421# #####################################################################################
422# # Table showing the percentage of students with correct answers for each problems
423# #####################################################################################
424# print
425#
426# CGI::p('The percentage of active students with correct answers for each problem'),
427# CGI::start_table({-border=>1}),
428# CGI::Tr(CGI::td(
429# ['Problem #', @problemIDs]
430# )),
431# CGI::Tr(CGI::td(
432# [ '% correct',map { sprintf("%0.0f",100*$correct_answers_for_problem{$_}/$number_ofstudents_attempting_problem{$_}) }
433# @problemIDs
434# ]
435# )),
436# CGI::end_table();
437#
438# #####################################################################################
439# # table showing percentile statistics for scores and success indices
440# #####################################################################################
441# print
442#
443# CGI::p('The percentage of active students whose percentage scores and success indices are greater than the given values.'),
444# CGI::start_table({-border=>1}),
445# CGI::Tr(
446# CGI::td( ['% students',
447# (map { "&nbsp;$_" } @brackets) ,
448# 'top score ',
449# ]
450# )
451# ),
452# CGI::Tr(
453# CGI::td( [
454# 'Score',
455# (map { '&ge; '.sprintf("%0.0f",100*$score_percentiles{$_}) } @brackets),
456# sprintf("%0.0f",100),
457# ]
458# )
459# ),
460# CGI::Tr(
461# CGI::td( [
462# 'Success Index',
463# (map { '&ge; '.sprintf("%0.0f",100*$index_percentiles{$_}) } @brackets),
464# sprintf("%0.0f",100),
465# ]
466# )
467# )
468# ;
469#
470# print CGI::end_table(),
471#
472# ;
473#
474# #####################################################################################
475# # table showing percentile statistics for scores and success indices
476# #####################################################################################
477# print
478#
479# CGI::p('The percentage of active students with no more than the indicated number of total attempts'),
480# CGI::start_table({-border=>1}),
481# CGI::Tr(
482# CGI::td( ['% students',
483# (map { "&nbsp;".(100-$_) } @brackets, 0) ,
484#
485# ]
486# )
487# );
488#
489#
490# foreach my $probID (@problemIDs) {
491# print CGI::Tr(
492# CGI::td( [
493# "Prob $probID",
494# (map { '&le; '.sprintf("%0.0f",$attempts_percentiles_for_problem{$probID}->{$_}) } @brackets, 0),
495#
496# ]
497# )
498# );
499#
500# }
501# print CGI::end_table();
502# #####################################################################################
503# # construct header
504# my $problem_header = '';
505#
506# foreach my $i (1..$max_num_problems) {
507# $problem_header .= CGI::a({"href"=>$url."?".$self->url_authen_args."&sort=p$i"},threeSpaceFill($i) );
508# }
509# print
510# CGI::p("Details"),
511# defined($sort_method_name) ?"sort method is $sort_method_name":"",
512# CGI::start_table({-border=>5,style=>'font-size:smaller'}),
513# CGI::Tr(CGI::th( {-align=>'center'},
514# [CGI::a({"href"=>$url."?".$self->url_authen_args."&sort=name"},'Name'),
515# CGI::a({"href"=>$url."?".$self->url_authen_args."&sort=score"},'Score'),
516# 'Out'.CGI::br().'Of',
517# CGI::a({"href"=>$url."?".$self->url_authen_args."&sort=index"},'Ind'),
518# '<pre>Problems'.CGI::br().$problem_header.'</pre>',
519# CGI::a({"href"=>$url."?".$self->url_authen_args."&sort=section"},'Section'),
520# 'Recitation',
521# 'login_name',
522# ])
523#
524# );
525#
526# foreach my $rec (@augmentedUserRecords) {
527# my $fullName = join("", $rec->{first_name}," ", $rec->{last_name});
528# my $email = $rec->{email_address};
529# my $twoString = $rec->{twoString};
530# print CGI::Tr(
531# CGI::td(CGI::a({-href=>$rec->{act_as_student}},$fullName), CGI::br(), CGI::a({-href=>"mailto:$email"},$email)),
532# CGI::td( sprintf("%0.2f",$rec->{score}) ), # score
533# CGI::td($rec->{total}), # out of
534# CGI::td(sprintf("%0.0f",100*($rec->{index}) )), # indicator
535# CGI::td($rec->{problemString}), # problems
536# CGI::td($self->nbsp($rec->{section})),
537# CGI::td($self->nbsp($rec->{recitation})),
538# CGI::td($rec->{user_id}),
539#
540# );
541# }
542#
543# print CGI::end_table();
544#
545#
546#
547#
548# return "";
549# }
550sub displayStudentStats { 183sub displayStudentStats {
551 my $self = shift; 184 my ($self, $studentName) = @_;
552 my $studentName = shift;
553 my $r = $self->{r}; 185 my $r = $self->r;
554 my $db = $self->{db}; 186 my $db = $r->db;
555 my $ce = $self->{ce}; 187 my $ce = $r->ce;
188
556 my $courseName = $ce->{courseName}; 189 my $courseName = $ce->{courseName};
557 my $studentRecord = $db->getUser($studentName); # checked 190 my $studentRecord = $db->getUser($studentName); # checked
558 die "record for user $studentName not found" unless $studentRecord; 191 die "record for user $studentName not found" unless $studentRecord;
559 my $root = $ce->{webworkURLs}->{root}; 192 my $root = $ce->{webworkURLs}->{root};
560 193
Legend:
Removed from v.1888  
changed lines
  Added in v.1889
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9