--- loncom/interface/lonquickgrades.pm 2011/05/22 21:53:52 1.88 +++ loncom/interface/lonquickgrades.pm 2014/05/20 20:32:16 1.104 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Quick Student Grades Display # -# $Id: lonquickgrades.pm,v 1.88 2011/05/22 21:53:52 www Exp $ +# $Id: lonquickgrades.pm,v 1.104 2014/05/20 20:32:16 musolffc Exp $ # # Copyright Michigan State University Board of Trustees # @@ -29,12 +29,30 @@ package Apache::lonquickgrades; use strict; -use Apache::Constants qw(:common :http); +use Apache::Constants qw(:common :http REDIRECT); use POSIX; use Apache::loncommon; use Apache::lonlocal; use Apache::lonnet; use Apache::grades; +use Apache::loncoursedata; +use Apache::lonstudentassessment; + +use Time::HiRes; +use Spreadsheet::WriteExcel; +use Spreadsheet::WriteExcel::Utility(); +# +# Excel data +# +my $excel_sheet; +my $excel_workbook; +my $filename; +my $format; +my $request_aborted; +my $header_row; +my $cols_output; +my %prog_state; + sub handler { my $r = shift; @@ -44,6 +62,14 @@ sub handler { sub real_handler { my $r = shift; + # Check for critical messages and redirect if present. + my ($redirect,$url) = &Apache::loncommon::critical_redirect(300); + if ($redirect) { + &Apache::loncommon::content_type($r,'text/html'); + $r->header_out(Location => $url); + return REDIRECT; + } + &Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING}); # Handle header-only request @@ -89,6 +115,39 @@ sub real_handler { my $udom; my $stdid; if ($cangrade) { + $r->print("

".&mt("Download Multiple")."

". + ''."\n". + ''. + ''. + ''. + ''. + ''. + ''."\n". + ''."\n". + '
'.&mt('Sections').''. + &Apache::loncommon::help_open_topic("Chart_Sections"). + ''.&mt('Groups').''. + ''.&mt('Student Data').''. + &Apache::loncommon::help_open_topic("Chart_Student_Data"). + ''.&mt('Access Status').''. + &Apache::loncommon::help_open_topic("Chart_Enrollment_Status"). + ''.&mt('Output Format').''. + &Apache::loncommon::help_open_topic("Chart_Output_Formats"). + ' 
'."\n". + &Apache::lonstatistics::SectionSelect('Section','multiple',5). + ''. + &Apache::lonstatistics::GroupSelect('Group','multiple',5). + ''. + &Apache::lonstatistics::StudentDataSelect('StudentData','multiple',5,undef). + ''."\n". + &Apache::lonhtmlcommon::StatusOptions(undef,undef,5). + ''."\n". + &Apache::lonstudentassessment::CreateAndParseOutputSelector(). + ''. + ''. + '
'."\n" + ); + $r->print("

".&mt("Display Individual")."

"); if ($env{'form.uname'}) { $uname=$env{'form.uname'}; } if ($env{'form.udom'}) { $udom=$env{'form.udom'}; } if ($env{'form.id'}) { $stdid=$env{'form.id'}; } @@ -106,8 +165,8 @@ sub real_handler { $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]' ,'' ,' ' - ,$chooseopt).'
'. - '

'); + ,$chooseopt). + '  

'); if (($uname) && ($udom)) { $r->print('

'.&mt('Full Name: [_1]',&Apache::loncommon::plainname($uname,$udom)).'

'); } @@ -130,6 +189,35 @@ sub real_handler { } +sub getStudentCatGrade { + my ($uname,$udom,%categories)=@_; + my ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)= + &getData(1,$uname,$udom); + return &output_category_table(undef,0,$navmap,0,%categories); +} + +sub getAllStudentData { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + + my %categories=&Apache::lonnet::dump('grading_categories',$cdom,$cnum); + + my $classlist = &Apache::loncoursedata::get_classlist(); + + my $statusidx = &Apache::loncoursedata::CL_STATUS(); + my $usernameidx = &Apache::loncoursedata::CL_SNAME(); + my $domainidx = &Apache::loncoursedata::CL_SDOM(); + my $fullnameidx = &Apache::loncoursedata::CL_FULLNAME(); + + foreach my $key (keys(%{$classlist})) { + my $student = $classlist->{$key}; + my $perc=&getStudentCatGrade($classlist->{$student}->[$usernameidx], + $classlist->{$student}->[$domainidx], + %categories); + } +} + + sub startGradeScreen { my ($r,$mode)=@_; @@ -181,7 +269,7 @@ sub startGradeScreen { if ($env{'form.symb'}) { $r->print("\n".'    '. + '&command=gradingmenu">    '. &mt('Problem Grading').'    '); } @@ -195,6 +283,68 @@ sub endGradeScreen { $r->print(''.&Apache::loncommon::end_page()); } +# ----------- + + +sub excel_cleanup { + undef ($excel_sheet); + undef ($excel_workbook); + undef ($filename); + undef ($format); +} + + +sub excel_initialize { + my ($r) = @_; + + &excel_cleanup(); + + # Create sheet + ($excel_workbook,$filename,$format)= + &Apache::loncommon::create_workbook($r); + return if (! defined($excel_workbook)); + # + # Add a worksheet + my $sheetname = $env{'course.'.$env{'request.course.id'}.'.description'}; + $sheetname = &Apache::loncommon::clean_excel_name($sheetname); + $excel_sheet = $excel_workbook->addworksheet($sheetname); + # + # Put the course description in the header + $excel_sheet->write($header_row,$cols_output++, + $env{'course.'.$env{'request.course.id'}.'.description'}, + $format->{'h1'}); +} + +sub excel_finish { + my ($r) = @_; + if ($request_aborted || ! defined($excel_sheet)) { + &excel_cleanup(); + return; + } + # + # Write the excel file + $excel_workbook->close(); + # + # Close the progress window + &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); + # + # Tell the user where to get their excel file + $r->print('
'. + ''.&mt('Your Excel spreadsheet').''."\n"); + $r->rflush(); + &excel_cleanup(); + return; +} + + +# +# CSV data +# +# ----------- + +# +# Go through the complete course and collect data +# sub getData { @@ -242,39 +392,40 @@ sub getData { my $stack = $iterator->getStack(); for my $part (@{$parts}) { - my $completionStatus = $curRes->getCompletionStatus($part); my $dateStatus = $curRes->getDateStatus($part); - - if ($completionStatus == $curRes->EXCUSED()) { + my $weight = $curRes->weight($part); + my $problemstatus = $curRes->problemstatus($part); + + if ($curRes->solved($part) eq 'excused') { next; } if ($showPoints) { my $score = 0; # If we're not telling status and the answer date isn't passed yet, # it's an "attempted" point - if ((($curRes->problemstatus($part) eq 'no') || - ($curRes->problemstatus($part) eq 'no_feedback_ever')) && + if ((($problemstatus eq 'no') || + ($problemstatus eq 'no_feedback_ever')) && ($dateStatus != $curRes->ANSWER_OPEN)) { my $status = $curRes->simpleStatus($part); if ($status == $curRes->ATTEMPTED) { - $partsAttempted += $curRes->weight($part); + $partsAttempted += $weight; $totalAttempted += $partsAttempted; } } else { - $score = &Apache::grades::compute_points($curRes->weight($part), $curRes->awarded($part)); + $score = &Apache::grades::compute_points($weight, $curRes->awarded($part)); } $partsRight += $score; $totalRight += $score; - $partsCount += $curRes->weight($part); + $partsCount += $weight; $curRes->{DATA}->{PROB_SCORE} += $score; - $curRes->{DATA}->{PROB_WEIGHT} += $curRes->weight($part); + $curRes->{DATA}->{PROB_WEIGHT} += $weight; if ($curRes->opendate($part) < $now) { - $totalPossible += $curRes->weight($part); - $curRes->{DATA}->{PROB_POSSIBLE} += $curRes->weight($part); + $totalPossible += $weight; + $curRes->{DATA}->{PROB_POSSIBLE} += $weight; } - $totalParts += $curRes->weight($part); + $totalParts += $weight; } else { my $status = $curRes->simpleStatus($part); my $thisright = 0; @@ -291,7 +442,6 @@ sub getData { $totalAttempted++; } - my $dateStatus = $curRes->getDateStatus($part); $totalParts++; if ($curRes->opendate($part) < $now) { $totalPossible++; @@ -461,7 +611,7 @@ sub outputCategories { &Apache::lonnet::put('grading_categories',\%categories,$cdom,$cnum); } # new categories loaded now - &output_category_table($r,$cangrade,$navmap,%categories); + &output_category_table($r,$cangrade,$navmap,1,%categories); # if ($cangrade) { $r->print(&Apache::loncommon::resourcebrowser_javascript(). @@ -471,13 +621,6 @@ sub outputCategories { ''. ''); } -# -# Debug -# -# my %data=&dumpdata($navmap); -# foreach (keys(%data)) { -# $r->print("\n
".$_.'='.$data{$_}); -# } } # @@ -560,27 +703,36 @@ sub process_category_edits { # sub output_category_table { - my ($r,$cangrade,$navmaps,%categories)=@_; - my $sum=0; - my $total=0; - $r->print(&Apache::loncommon::start_data_table()); + my ($r,$cangrade,$navmaps,$output,%categories)=@_; + + my $totalweight=0; + my $totalpoints=0; + + if ($output) { + $r->print(&Apache::loncommon::start_data_table()); # - &output_category_table_header($r,$cangrade); + &output_category_table_header($r,$cangrade); + } # my @order=split(/\,/,$categories{'order'}); # my %performance=&dumpdata($navmaps); my $maxpos=$#order; for (my $i=0;$i<=$maxpos;$i++) { - my ($value,$weight)=&output_and_calc_category($r,$cangrade,$navmaps,$order[$i],$i,$maxpos,\%performance,%categories); - $sum+=$value*$weight; - $total+=$weight; + my ($correct,$possible,$type,$weight)=&output_and_calc_category($r,$cangrade,$navmaps,$order[$i],$i,$maxpos,\%performance,$output,%categories); + unless ($possible) { next; } + $totalpoints+=$weight*$correct/$possible; + $totalweight+=$weight; } # - &bottom_line_category($r,$cangrade,$sum,$total); -# - $r->print(&Apache::loncommon::end_data_table()); - return $sum; + my $perc=0; + if ($totalweight) { $perc=100.*$totalpoints/$totalweight; } + + if ($output) { + &bottom_line_category($r,$cangrade,$perc); + $r->print(&Apache::loncommon::end_data_table()); + } + return $perc; } sub output_category_table_header { @@ -604,16 +756,16 @@ sub output_category_table_header { # sub output_and_calc_category { - my ($r,$cangrade,$navmaps,$id,$currentpos,$maxpos,$performance,%categories)=@_; - my $value=0; - my $weight=0; - my $iconpath = &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL') . "/"); - my %lt=&Apache::lonlocal::texthash( + my ($r,$cangrade,$navmaps,$id,$currentpos,$maxpos,$performance,$output,%categories)=@_; + + if ($output) { $r->print("\n".&Apache::loncommon::start_data_table_row()); } + + if ($output && $cangrade) { + my $iconpath = &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL') . "/"); + my %lt=&Apache::lonlocal::texthash( 'up' => 'Move Up', 'dw' => 'Move Down'); - $r->print("\n".&Apache::loncommon::start_data_table_row()); - if ($cangrade) { $r->print(<
@@ -640,96 +792,212 @@ ENDMOVE $r->print(''.&mt('Delete').''); $r->print(''); - } else { + } elsif ($output) { $r->print(''.$categories{$id.'_name'}.''); } -# Content - $r->print('
    '); +# Content display and summing up of points + my $totalpossible=0; + my $totalcorrect=0; + my @individual=(); + if ($output) { $r->print('
      '); } foreach my $contentid (split(/\,/,$categories{$id.'_content'})) { - $r->print('
    • '); - $r->print(&Apache::lonnet::gettitle($contentid).' '.$$performance{$contentid}); - if ($cangrade) { - $r->print(' '.&mt('Delete').''); + my ($type,$possible,$attempted,$correct)=split(/\:/,$$performance{$contentid}); + $totalpossible+=$possible; + $totalcorrect+=$correct; + if ($possible>0) { push(@individual,"$possible:$correct"); } + if ($output) { + $r->print('
    • '); + $r->print(&Apache::lonnet::gettitle($contentid).' ('.&numberout($correct).'/'.&numberout($possible).')'); + if ($cangrade) { + $r->print(' '.&mt('Delete').''); + } + $r->print('
      • '); } - $r->print(''); } - $r->print('
    '); - if ($cangrade) { - $r->print('
    '.&Apache::loncommon::selectresource_link('quickform','addcont_'.$id,&mt('Add Problem or Folder')).'
    '); + if ($output) { + $r->print('
'); + if ($cangrade) { + $r->print('
'.&Apache::loncommon::selectresource_link('quickform','addcont_'.$id,&mt('Add Problem or Folder')).'
'); + } + $r->print('

'.&mt('Total raw points: [_1]/[_2]',&numberout($totalcorrect),&numberout($totalpossible)).'

'); + $r->print(''); } - $r->print(''); - # Total + if ($output) { $r->print(''); } if ($cangrade) { - $r->print(''. + if ($output) { + $r->print( ''. ''); + '" value="'.&Apache::lonhtmlcommon::entity_encode($categories{$id.'_total'}).'" />'); + } } else { - $r->print(''.($categories{$id.'_totaltype'} eq 'default'?&mt('default'):$categories{$id.'_total'}).''); + if ($output) { + $r->print(''.($categories{$id.'_totaltype'} eq 'default'?&mt('default'):$categories{$id.'_total'})); + } + } +# Adjust total points + if ($categories{$id.'_totaltype'} eq 'typein') { + $totalpossible=1.*$categories{$id.'_total'}; + } + if ($output) { + $r->print('

'.&mt('Adjusted raw points: [_1]/[_2]',&numberout($totalcorrect),&numberout($totalpossible)).'

'); } # Calculation - $r->print('
    '); + if ($output) { $r->print('
      '); } foreach my $calcrule (split(/\,/,$categories{$id.'_calculations'})) { - $r->print('
    • '); + if ($output) { $r->print('
    • '); } my ($code,$value)=split(/\:/,$calcrule); - $r->print(&pretty_prt_rule($cangrade,$id,$code,$value)); + if ($output) { $r->print(&pretty_prt_rule($cangrade,$id,$code,$value)); } if ($cangrade) { - $r->print(' '.&mt('Delete').''); + if ($output) { $r->print(' '.&mt('Delete').''); } + } + if ($code eq 'capabove') { + if ($totalpossible>0) { + if ($totalcorrect/$totalpossible>$value/100.) { + $totalcorrect=$totalpossible*$value/100.; + } + } + } elsif ($code eq 'capbelow') { + if ($totalpossible>0) { + if ($totalcorrect/$totalpossible<$value/100.) { + $totalcorrect=$totalpossible*$value/100.; + } + } + } elsif ($code eq 'droplow') { + ($totalpossible,$totalcorrect,@individual)=&drop(0,0,$value,@individual); + } elsif ($code eq 'drophigh') { + ($totalpossible,$totalcorrect,@individual)=&drop(1,0,$value,@individual); + } elsif ($code eq 'droplowperc') { + ($totalpossible,$totalcorrect,@individual)=&drop(0,1,$value,@individual); + } elsif ($code eq 'drophighperc') { + ($totalpossible,$totalcorrect,@individual)=&drop(1,1,$value,@individual); } - $r->print('
      • '); + if ($output) { $r->print(''); } } - $r->print('
    '); - if ($cangrade) { - $r->print('
    '.&new_calc_rule_form($id)); +# Re-adjust total points if force total + if ($categories{$id.'_totaltype'} eq 'typein') { + $totalpossible=1.*$categories{$id.'_total'}; } - $r->print(''); + if ($output) { + $r->print('
'); + if ($cangrade) { $r->print('
'.&new_calc_rule_form($id)); } + $r->print('

'.&mt('Calculated points: [_1]/[_2]',&numberout($totalcorrect),&numberout($totalpossible)).'

'); + $r->print(''); + } +# +# Prepare for export +# # Weight + my $weight=$categories{$id.'_weight'}; + unless (1.*$weight>0) { $weight=0; } if ($cangrade) { - $r->print(''. + if ($output) { + $r->print(''. ''); + '" value="'.&Apache::lonhtmlcommon::entity_encode($weight).'" />'); + } } else { - $r->print(''.$categories{$id.'_weight'}.''); + if ($output) { + $r->print(''.$weight.''); + } } # Achieved - $r->print(''); + my $type=$categories{$id.'_displayachieved'}; + unless (($type eq 'percent') || ($type eq 'points')) { $type='points'; } + if ($output) { $r->print(''); } if ($cangrade) { - $r->print(''. + ''. + ''. ''); - } else { - if ($categories{$id.'_displayachieved'} eq 'percent') { - $r->print(&mt('percent')); + } + } + if ($output) { + $r->print('

'); + if ($type eq 'percent') { + my $perc='---'; + if ($totalpossible) { + $perc=100.*$totalcorrect/$totalpossible; + } + $r->print(&mt('[_1] percent',&numberout($perc))); } else { - $r->print(&mt('points')); + $r->print(&mt('[_1]/[_2] points',&numberout($totalcorrect),&numberout($totalpossible))); } + $r->print('

'); } - $r->print(''); + if ($output) { $r->print(''); } - return ($value,$weight); + return ($totalcorrect,$totalpossible,$type,$weight); } # +# Drop folders and problems +# + +sub drop { + my ($high,$percent,$n,@individual)=@_; +# Sort assignments by points or percent + my @newindividual=sort { + my ($pa,$ca)=split(/\:/,$a); + my ($pb,$cb)=split(/\:/,$b); + if ($percent) { + my $perca=0; + if ($pa>0) { $perca=$ca/$pa; } + my $percb=0; + if ($pb>0) { $percb=$cb/$pb; } + $perca<=>$percb; + } else { + $ca<=>$cb; + } + } @individual; +# Drop the ones we don't want + if ($#newindividual>=$n) { + if ($high) { + splice(@newindividual,$#newindividual+1-$n,$n); + } else { + splice(@newindividual,0,$n); + } + } else { + @newindividual=(); + } +# Re-calculate how many points possible and achieved + my $newpossible=0; + my $newcorrect=0; + for my $score (@newindividual) { + my ($thispossible,$thiscorrect)=(split(/\:/,$score)); + $newpossible+=$thispossible; + $newcorrect+=$thiscorrect; + } + return ($newpossible,$newcorrect,@newindividual); +} +# # Bottom line with grades # sub bottom_line_category { - my ($r,$cangrade,$sum,$total)=@_; + my ($r,$cangrade,$perc)=@_; $r->print(&Apache::loncommon::start_data_table_row()); if ($cangrade) { $r->print(''.&mt('Create New Category').''); } - $r->print(''.&mt('Current:').$sum.'
'.&mt('Total:').$total.'
'); + $r->print(''.&mt('Total: [_1] percent',&numberout($perc)).''); } +sub numberout { + my ($number)=@_; + my $printout=sprintf("%.3f", $number); + $printout=~s/0+$//; + $printout=~s/\.$//; + return $printout; +} # # Make one new category # @@ -760,8 +1028,10 @@ sub make_new_category { sub category_rule_codes { return &Apache::lonlocal::texthash( - 'droplow' => 'Drop N lowest grade assignments', - 'drophigh' => 'Drop N highest grade assignments', + 'droplowperc' => 'Drop N lowest grade percentage problems/folders', + 'drophighperc' => 'Drop N highest grade percentage problems/folderss', + 'droplow' => 'Drop N lowest point problems/folders', + 'drophigh' => 'Drop N highest point problems/folders', 'capabove' => 'Cap percentage above N percent', 'capbelow' => 'Cap percentage below N percent'); }