Return to lonpercentage.pm CVS log

Up to [LON-CAPA] / loncom / interface / statistics

&Apache::lonnet::unescape -> &unescape
&Apache::lonnet::escape -> &escape

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lonpercentage.pm,v 1.10 2006/05/30 12:46:49 www Exp $
    4: #
    5: # Copyright Michigan State University Board of Trustees
    6: #
    7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    8: #
    9: # LON-CAPA is free software; you can redistribute it and/or modify
   10: # it under the terms of the GNU General Public License as published by
   11: # the Free Software Foundation; either version 2 of the License, or
   12: # (at your option) any later version.
   13: #
   14: # LON-CAPA is distributed in the hope that it will be useful,
   15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17: # GNU General Public License for more details.
   18: #
   19: # You should have received a copy of the GNU General Public License
   20: # along with LON-CAPA; if not, write to the Free Software
   21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22: #
   23: # /home/httpd/html/adm/gpl.txt
   24: #
   25: # http://www.lon-capa.org/
   26: #
   27: ###
   28: 
   29: package Apache::lonpercentage;
   30: 
   31: use strict;
   32: use Apache::lonhtmlcommon;
   33: use Apache::loncoursedata;
   34: use GDBM_File;
   35: use lib '/home/httpd/lib/perl/';
   36: use LONCAPA;
   37:  
   38: 
   39: 
   40: sub BuildPercentageGraph {
   41:     my ($cacheDB, $students, $courseID, $c, $r)=@_;
   42: 
   43:     my %cache;
   44:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
   45:         $r->print('Unable to tie database.6');
   46:         return;
   47:     }
   48: 
   49:     $r->print(&CreateInterface(\%cache));
   50:     $r->rflush();
   51:     untie(%cache);
   52: 
   53:     my ($result) = &InitializeSelectedStudents($cacheDB, $students, 
   54: 					       $courseID, $c, $r);
   55:     if($result ne 'OK' || $c->aborted()) {
   56:         return;
   57:     }
   58: 
   59:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
   60:         $r->print('Unable to tie database.6');
   61:         return;
   62:     }
   63: 
   64:     my ($Ptr, $percentage) = &GraphData(\%cache, $students,$r);
   65:     $r->print($Ptr.'<br>');
   66: 
   67:     $r->print(&TableData(\%cache, $percentage));
   68: 
   69:     untie(%cache);
   70: 
   71:     return;
   72: }
   73: 
   74: sub CreateInterface {
   75:     my ($cache)=@_;
   76: 
   77:     my $Ptr = '';
   78:     $Ptr .= '<table border="0" cellspacing="5"><tbody>';
   79:     $Ptr .= '<tr><td align="right"><b>Select Map</b></td>'."\n";
   80:     $Ptr .= '<td align="left">';
   81:     $Ptr .= &Apache::lonhtmlcommon::MapOptions($cache, 'Statistics',
   82:                                                'Statistics');
   83:     $Ptr .= '</td>'."\n";
   84: 
   85:     my $sequence = $cache->{'StatisticsMaps'};
   86:     if($sequence ne 'All Maps') {
   87: 	$Ptr .= '<td align="right">'."\n";
   88: 	$Ptr .= &Apache::lonhtmlcommon::ProblemOptions($cache,
   89: 						       'Statistics',
   90: 						       $sequence,
   91: 						       'Statistics');
   92: 	$Ptr .= '<td>'."\n";
   93: 
   94: 	my $problem = $cache->{'StatisticsProblemSelect'};
   95: 	if($problem ne 'All Problems') {
   96: 	    my $parts = &GetParts($cache, $sequence, $problem);
   97: 	    if(scalar(@$parts) > 0) {
   98: 		$Ptr .= '<td align="right">'."\n";
   99: 		$Ptr .= &Apache::lonhtmlcommon::PartOptions($cache,
  100: 							'Statistics',
  101: 							$parts,
  102: 							'Statistics');
  103: 		$Ptr .= '</td>'."\n";
  104: 	    }
  105: 	}
  106:     }
  107: 
  108:     $Ptr .= '</tr>'."\n";
  109: 
  110:     $Ptr .= '<tr><td align="right"><b>Select Sections</b>';
  111:     $Ptr .= '</td>'."\n";
  112:     $Ptr .= '<td align="left">'."\n";
  113:     my @sections = split(':',$cache->{'sectionList'});
  114:     my @sectionsSelected = split(':',$cache->{'sectionsSelected'});
  115:     $Ptr .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
  116:     $Ptr .= '</td></tr>'."\n";
  117:     $Ptr .= '</table>';
  118: 
  119:     return $Ptr;
  120: }
  121: 
  122: sub GetParts {
  123:     my ($cache,$sequence,$problem)=@_;
  124:     my @parts = ();
  125: 
  126:     foreach my $sequenceNumber (split(':',$cache->{'orderedSequences'})) {
  127: 	if($cache->{$sequenceNumber.':title'} eq $sequence) {
  128: 	    foreach my $problemNumber (split(':', 
  129: 				     $cache->{$sequenceNumber.':problems'})) {
  130: 		if($cache->{$problemNumber.':title'} eq $problem) {
  131: 		    @parts = split(':', 
  132: 		       $cache->{$sequenceNumber.':'.$problemNumber.':parts'});
  133: 		}
  134: 	    }
  135: 	}
  136:     }
  137:     
  138:     return \@parts;
  139: }
  140: 
  141: sub InitializeSelectedStudents {
  142:     my ($cacheDB, $students, $courseID, $c, $r)=@_;
  143:     my %cache;
  144: 
  145:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
  146:         $r->print('Unable to tie database1.1.');
  147:         return ('ERROR');
  148:     }
  149: 
  150:     # Remove students who don't have the proper section.
  151:     my @sectionsSelected = split(':',$cache{'sectionsSelected'});
  152:     for(my $studentIndex=((scalar @$students)-1); $studentIndex>=0;
  153:         $studentIndex--) {
  154:         my $value = $cache{$students->[$studentIndex].':section'};
  155:         my $found = 0;
  156:         foreach (@sectionsSelected) {
  157:             if($_ eq 'none') {
  158:                 if($value eq '' || !defined($value) || $value eq ' ') {
  159:                     $found = 1;
  160:                     last;
  161:                 }
  162:             } else {
  163:                 if($value eq $_) {
  164:                     $found = 1;
  165:                     last;
  166:                 }
  167:             }
  168:         }
  169:         if($found == 0) {
  170:             splice(@$students, $studentIndex, 1);
  171:         }
  172:     }
  173: 
  174:     untie(%cache);
  175: 
  176:     &Apache::loncoursedata::DownloadStudentCourseDataSeparate($students,
  177: 							      'true',
  178: 							      $cacheDB,
  179: 							      'true', 
  180: 							      'true',
  181: 							      $courseID,
  182: 							      $r, $c);
  183: 
  184:     return ('OK');
  185: }
  186: 
  187: sub GraphData {
  188:     my ($cache,$students,$r)=@_;
  189: 
  190:     my $sequenceSelected = $cache->{'StatisticsMaps'};
  191:     my $problemSelected  = $cache->{'StatisticsProblemSelect'};
  192:     my $partSelected     = $cache->{'StatisticsPartSelect'};
  193: 
  194:     my %percentages;
  195:     my $Ptr = '';
  196:     my $totalProblems = 0;
  197: 
  198:     foreach(@$students) {
  199: 	my $totalCorrect = 0;
  200:         $totalProblems = 0;
  201: 
  202: 	foreach my $sequence (split(':',$cache->{'orderedSequences'})) {
  203: 	    next if($cache->{$sequence.':title'} ne $sequenceSelected &&
  204: 		    $sequenceSelected ne 'All Maps');
  205: 	    foreach my $problem (split(':',$cache->{$sequence.':problems'})) {
  206: 		next if($cache->{$problem.':title'} ne $problemSelected &&
  207: 			$problemSelected ne 'All Problems' && 
  208: 			$sequenceSelected ne 'All Maps');
  209: 		foreach my $part (split(':',$cache->{$sequence.':'.$problem.
  210: 						     ':parts'})) {
  211: 		    next if($part ne $partSelected && 
  212: 			    $partSelected ne 'All Parts' &&
  213: 			    $problemSelected ne 'All Problems' && 
  214: 			    $sequenceSelected ne 'All Maps');
  215: 		    my $code = $cache->{$_.':'.$problem.':'.$part.':code'};
  216: 		    if($code eq '*' || $code eq '+') {
  217: 			$totalCorrect++;
  218: 			$totalProblems++;
  219: 		    } elsif($code ne 'x') {
  220: 			$totalProblems++;
  221: 		    }
  222: 		}
  223: 	    }
  224: 	}
  225: 	my $percent;
  226: 	if ( $totalProblems >= 100 ) { 
  227:             $percent = sprintf("%d", ($totalProblems) ?
  228:                               (($totalCorrect/$totalProblems)*100) : 0);
  229: 	} else {
  230: 	    $percent = sprintf("%d", ($totalProblems) ? $totalCorrect : 0);
  231: 	}
  232: 	if(defined($percentages{$percent})) {
  233: 	    $percentages{$percent} .= ':::'.$_;
  234: 	} else {
  235: 	    $percentages{$percent} = $_;
  236: 	}
  237:     }
  238: 
  239:     my @percent = ();
  240:     my @percentCount = ();
  241:     my $max = 0;
  242:     my $pno = 0;
  243: 
  244:     foreach my $key (sort NumericSort keys(%percentages)) {
  245: 	push(@percent, $key);
  246: 	my @temp = split(':::', $percentages{$key});
  247: 	my $count = scalar(@temp);
  248: 	if($count > $max) {
  249: 	    $max = $count;
  250: 	}
  251: 	push(@percentCount, $count);
  252: 	$pno++;
  253:     }
  254: 
  255:     my $cId=0;
  256:     my @data1=();
  257:     my @data2=();
  258:     for (my $nIdx=0; $nIdx<$pno; $nIdx++ ) {
  259: 	$data1[$cId]=$percent[$nIdx];
  260:         $data2[$cId]=$percentCount[$nIdx];
  261: 	my $cr=$percent[$nIdx+1];
  262: 	while ($data1[$cId]<$cr) {
  263: 	    $cId++;
  264:             $data1[$cId]=$cId;
  265:             $data2[$cId]=0;
  266:         }
  267:     }
  268: 
  269:     my $xlabel;
  270:     my $Freq;
  271:     if ($totalProblems >= 100 ) {
  272:         $xlabel = 'Percentage_of_Problems_Correct';
  273:         $Freq=101;
  274:     } else {
  275:         $xlabel = 'Number_of_Problems_Correct';
  276:         $Freq = $cId;
  277:     }
  278: 
  279: #   $r->print('<br>Freq='.$Freq);
  280: #   $r->print('<br>max='.$max);
  281: #   $r->print('<br> percentcount='.join(',', @percentCount)); 
  282: #   $r->print('<br> percent='.join(',', @percent));
  283: #   $r->print('<br> percentcount='.join(',', @data1));
  284: #   $r->print('<br> percent='.join(',', @data2));
  285: 
  286:     my @GData = ("Percentage",$xlabel,
  287:                  'Number_of_Students',$max,$Freq,
  288:                  join(',',@data1), join(',', @data2));
  289: 
  290:     $Ptr .= '</form>'."\n";
  291:     $Ptr .= '<IMG src="/cgi-bin/graph.png?'.(join('&', @GData));
  292:     $Ptr .= '" border="1" />';
  293:     $Ptr .= '<form>'."\n";
  294: 
  295:     return ($Ptr, \%percentages);
  296: }
  297: 
  298: sub NumericSort {
  299:     $a <=> $b;
  300: }
  301: 
  302: sub TableData {
  303:     my($cache,$percentage)=@_;
  304:     my $Ptr;
  305: 
  306:     $Ptr .= '<table border="0"><tr><td bgcolor="#D7D7D7">'."\n";
  307:     $Ptr .= '<table border="0" cellpadding="3"><tr bgcolor="#e6ffff">'."\n";
  308: 
  309:     $Ptr .= '<tr>'."\n";
  310:     $Ptr .= '<td>% Correct</td>'.
  311:             '<td>Frequency</td>'.
  312:             '<td>Students</td>';
  313:     $Ptr .= '</tr>'."\n";
  314: 
  315:     my $alternate=0;
  316:     foreach (sort NumericSort keys(%$percentage)) {
  317: 
  318:         my @temp = split(':::', $percentage->{$_});
  319:         my $count = scalar(@temp);
  320: 
  321:         if($alternate) {
  322:             $Ptr .= '<tr bgcolor="#ffffe6">';
  323:         } else {
  324:             $Ptr .= '<tr bgcolor="#ffffc6">';
  325:         }
  326:         $alternate = ($alternate + 1) % 2;
  327: 
  328: 	$Ptr .= '<td>'.$_.'</td>';
  329:         $Ptr .= '<td>'.$count.'</td><td>';
  330: 
  331: 	foreach my $name (sort(split(':::', $percentage->{$_}))) {
  332: 	    $Ptr .= '<a href="/adm/statistics?reportSelected=';
  333: 	    $Ptr .= &escape('Student Assessment');
  334: 	    $Ptr .= '&StudentAssessmentStudent=';
  335: 	    $Ptr .= &escape($cache->{$name.':fullname'}).'">';
  336: 	    $Ptr .= $cache->{$name.':fullname'};
  337: 	    $Ptr .= '</a>,&nbsp&nbsp';
  338:         }
  339: 
  340: 	$Ptr .= '</td></tr>'."\n";
  341:     }
  342: 
  343:     $Ptr .= '</tr>'."\n";
  344:     $Ptr .= '</table></td></tr></table>'."\n";
  345: 
  346:     return $Ptr;
  347: }
  348: 
  349: 1;
  350: __END__