File:  [LON-CAPA] / loncom / interface / statistics / lonpercentage.pm
Revision 1.5: download - view: text, annotated - select for diffs
Sat Jan 11 06:31:26 2003 UTC (21 years, 5 months ago) by minaeibi
Branches: MAIN
CVS tags: HEAD
Fixed bug #1052.
The graph of percentage of correct problems shows zeroz, so the distribution of corrected problems are shown better.
If get more feedback I will complete it.

    1: # The LearningOnline Network with CAPA
    2: # (Publication Handler
    3: #
    4: # $Id: lonpercentage.pm,v 1.5 2003/01/11 06:31:26 minaeibi Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ###
   29: 
   30: package Apache::lonpercentage;
   31: 
   32: use strict;
   33: use Apache::lonhtmlcommon;
   34: use Apache::loncoursedata;
   35: use GDBM_File;
   36: 
   37: 
   38: sub BuildPercentageGraph {
   39:     my ($cacheDB, $students, $courseID, $c, $r)=@_;
   40: 
   41:     my %cache;
   42:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
   43:         $r->print('Unable to tie database.6');
   44:         return;
   45:     }
   46: 
   47:     $r->print(&CreateInterface(\%cache));
   48:     $r->rflush();
   49:     untie(%cache);
   50: 
   51:     my ($result) = &InitializeSelectedStudents($cacheDB, $students, 
   52: 					       $courseID, $c, $r);
   53:     if($result ne 'OK' || $c->aborted()) {
   54:         return;
   55:     }
   56: 
   57:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
   58:         $r->print('Unable to tie database.6');
   59:         return;
   60:     }
   61: 
   62:     my ($Ptr, $percentage) = &GraphData(\%cache, $students,$r);
   63:     $r->print($Ptr.'<br>');
   64: 
   65:     $r->print(&TableData(\%cache, $percentage));
   66: 
   67:     untie(%cache);
   68: 
   69:     return;
   70: }
   71: 
   72: sub CreateInterface {
   73:     my ($cache)=@_;
   74: 
   75:     my $Ptr = '';
   76:     $Ptr .= '<table border="0" cellspacing="5"><tbody>';
   77:     $Ptr .= '<tr><td align="right"><b>Select Map</b></td>'."\n";
   78:     $Ptr .= '<td align="left">';
   79:     $Ptr .= &Apache::lonhtmlcommon::MapOptions($cache, 'Statistics',
   80:                                                'Statistics');
   81:     $Ptr .= '</td>'."\n";
   82: 
   83:     my $sequence = $cache->{'StatisticsMaps'};
   84:     if($sequence ne 'All Maps') {
   85: 	$Ptr .= '<td align="right">'."\n";
   86: 	$Ptr .= &Apache::lonhtmlcommon::ProblemOptions($cache,
   87: 						       'Statistics',
   88: 						       $sequence,
   89: 						       'Statistics');
   90: 	$Ptr .= '<td>'."\n";
   91: 
   92: 	my $problem = $cache->{'StatisticsProblemSelect'};
   93: 	if($problem ne 'All Problems') {
   94: 	    my $parts = &GetParts($cache, $sequence, $problem);
   95: 	    if(scalar(@$parts) > 0) {
   96: 		$Ptr .= '<td align="right">'."\n";
   97: 		$Ptr .= &Apache::lonhtmlcommon::PartOptions($cache,
   98: 							'Statistics',
   99: 							$parts,
  100: 							'Statistics');
  101: 		$Ptr .= '</td>'."\n";
  102: 	    }
  103: 	}
  104:     }
  105: 
  106:     $Ptr .= '</tr>'."\n";
  107: 
  108:     $Ptr .= '<tr><td align="right"><b>Select Sections</b>';
  109:     $Ptr .= '</td>'."\n";
  110:     $Ptr .= '<td align="left">'."\n";
  111:     my @sections = split(':',$cache->{'sectionList'});
  112:     my @sectionsSelected = split(':',$cache->{'sectionsSelected'});
  113:     $Ptr .= &Apache::lonhtmlcommon::MultipleSectionSelect(\@sections,
  114:                                                           \@sectionsSelected,
  115:                                                           'Statistics');
  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: 
  197:     foreach(@$students) {
  198: 	my $totalCorrect = 0;
  199: 	my $totalProblems = 0;
  200: 
  201: 	foreach my $sequence (split(':',$cache->{'orderedSequences'})) {
  202: 	    next if($cache->{$sequence.':title'} ne $sequenceSelected &&
  203: 		    $sequenceSelected ne 'All Maps');
  204: 	    foreach my $problem (split(':',$cache->{$sequence.':problems'})) {
  205: 		next if($cache->{$problem.':title'} ne $problemSelected &&
  206: 			$problemSelected ne 'All Problems' && 
  207: 			$sequenceSelected ne 'All Maps');
  208: 		foreach my $part (split(':',$cache->{$sequence.':'.$problem.
  209: 						     ':parts'})) {
  210: 		    next if($part ne $partSelected && 
  211: 			    $partSelected ne 'All Parts' &&
  212: 			    $problemSelected ne 'All Problems' && 
  213: 			    $sequenceSelected ne 'All Maps');
  214: 		    my $code = $cache->{$_.':'.$problem.':'.$part.':code'};
  215: 		    if($code eq '*' || $code eq '+') {
  216: 			$totalCorrect++;
  217: 			$totalProblems++;
  218: 		    } elsif($code ne 'x') {
  219: 			$totalProblems++;
  220: 		    }
  221: 		}
  222: 	    }
  223: 	}
  224: 
  225: 	my $percent = sprintf("%d", ($totalProblems) ?
  226: 			      (($totalCorrect/$totalProblems)*100) : 0);
  227: 	if(defined($percentages{$percent})) {
  228: 	    $percentages{$percent} .= ':::'.$_;
  229: 	} else {
  230: 	    $percentages{$percent} = $_;
  231: 	}
  232:     }
  233: 
  234:     my @percent = ();
  235:     my @percentCount = ();
  236:     my $max = 0;
  237:     my $pno = 0;
  238:     foreach my $key (sort NumericSort keys(%percentages)) {
  239: 	push(@percent, $key);
  240: 	my @temp = split(':::', $percentages{$key});
  241: 	my $count = scalar(@temp);
  242: 	if($count > $max) {
  243: 	    $max = $count;
  244: 	}
  245: 	push(@percentCount, $count);
  246: 	$pno++;
  247:     }
  248: 
  249: #   $r->print('<br>max='.$max);
  250: #   $r->print('<br> percentcount='.join(',', @percentCount));
  251: #   $r->print('<br> percent='.join(',', @percent));
  252: 
  253:     my $cId=0;
  254:     my @data1=();
  255:     my @data2=();
  256:     for (my $nIdx=0; $nIdx<$pno; $nIdx++ ) {
  257: 	$data1[$cId]=$percent[$nIdx];
  258:         $data2[$cId]=$percentCount[$nIdx];
  259: 	my $cr=$percent[$nIdx+1];
  260: 	while ($data1[$cId]<$cr) {
  261: 	    $cId++;
  262:             $data1[$cId]=$cId;
  263:             $data2[$cId]=0;
  264:         }
  265:     }
  266: 
  267: #   $r->print('<br> percentcount='.join(',', @data1));
  268: #   $r->print('<br> percent='.join(',', @data2));
  269: 
  270: 
  271:     my @GData = ('','Percentage','Number_of_Students',$max,101 ,
  272:                  join(',',@data1), join(',', @data2));
  273: 
  274:     $Ptr .= '</form>'."\n";
  275:     $Ptr .= '<IMG src="/cgi-bin/graph.png?'.(join('&', @GData));
  276:     $Ptr .= '" border="1" />';
  277:     $Ptr .= '<form>'."\n";
  278: 
  279:     return ($Ptr, \%percentages);
  280: }
  281: 
  282: sub NumericSort {
  283:     $a <=> $b;
  284: }
  285: 
  286: sub TableData {
  287:     my($cache,$percentage)=@_;
  288:     my $Ptr;
  289: 
  290:     $Ptr .= '<table border="0"><tr><td bgcolor="#D7D7D7">'."\n";
  291:     $Ptr .= '<table border="0" cellpadding="3"><tr bgcolor="#e6ffff">'."\n";
  292: 
  293:     $Ptr .= '<tr>'."\n";
  294:     $Ptr .= '<td>% Correct</td>'.
  295:             '<td>Frequency</td>'.
  296:             '<td>Students</td>';
  297:     $Ptr .= '</tr>'."\n";
  298: 
  299:     my $alternate=0;
  300:     foreach (sort NumericSort keys(%$percentage)) {
  301: 
  302:         my @temp = split(':::', $percentage->{$_});
  303:         my $count = scalar(@temp);
  304: 
  305:         if($alternate) {
  306:             $Ptr .= '<tr bgcolor="#ffffe6">';
  307:         } else {
  308:             $Ptr .= '<tr bgcolor="#ffffc6">';
  309:         }
  310:         $alternate = ($alternate + 1) % 2;
  311: 
  312: 	$Ptr .= '<td>'.$_.'</td>';
  313:         $Ptr .= '<td>'.$count.'</td><td>';
  314: 
  315: 	foreach my $name (sort(split(':::', $percentage->{$_}))) {
  316: 	    $Ptr .= '<a href="/adm/statistics?reportSelected=';
  317: 	    $Ptr .= &Apache::lonnet::escape('Student Assessment');
  318: 	    $Ptr .= '&StudentAssessmentStudent=';
  319: 	    $Ptr .= &Apache::lonnet::escape($cache->{$name.':fullname'}).'">';
  320: 	    $Ptr .= $cache->{$name.':fullname'};
  321: 	    $Ptr .= '</a>,&nbsp&nbsp';
  322:         }
  323: 
  324: 	$Ptr .= '</td></tr>'."\n";
  325:     }
  326: 
  327:     $Ptr .= '</tr>'."\n";
  328:     $Ptr .= '</table></td></tr></table>'."\n";
  329: 
  330:     return $Ptr;
  331: }
  332: 
  333: 1;
  334: __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>