Return to lonpercentage.pm CVS log

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

- Improved and consistent layout:
    - Error style for error messages
    - data_table (implies simplified code), table header
- Internationalization: Added missing &mt() calls
- XHTML: action attribute required in <form>

# The LearningOnline Network with CAPA
#
# $Id: lonpercentage.pm,v 1.13 2013/12/04 11:20:07 bisitz Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###

package Apache::lonpercentage;

use strict;
use Apache::lonhtmlcommon;
use Apache::loncoursedata;
use GDBM_File;
use lib '/home/httpd/lib/perl/';
use LONCAPA;
 


sub BuildPercentageGraph {
    my ($cacheDB, $students, $courseID, $c, $r)=@_;

    my %cache;
    unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
        $r->print('<p class="LC_error">'.&mt('Unable to tie [_1]','database.6').'</p>');
        return;
    }

    $r->print(&CreateInterface(\%cache));
    $r->rflush();
    untie(%cache);

    my ($result) = &InitializeSelectedStudents($cacheDB, $students, 
					       $courseID, $c, $r);
    if($result ne 'OK' || $c->aborted()) {
        return;
    }

    unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
        $r->print('<p class="LC_error">'.&mt('Unable to tie [_1]','database.6').'</p>');
        return;
    }

    my ($Ptr, $percentage) = &GraphData(\%cache, $students,$r);
    $r->print($Ptr.'<br />');

    $r->print(&TableData(\%cache, $percentage));

    untie(%cache);

    return;
}

sub CreateInterface {
    my ($cache)=@_;

    my $Ptr = '';
    $Ptr .= '<table border="0" cellspacing="5"><tbody>';
    $Ptr .= '<tr><td align="right"><b>'.&mt('Select Map').'</b></td>'."\n";
    $Ptr .= '<td align="left">';
    $Ptr .= &Apache::lonhtmlcommon::MapOptions($cache, 'Statistics',
                                               'Statistics');
    $Ptr .= '</td>'."\n";

    my $sequence = $cache->{'StatisticsMaps'};
    if($sequence ne 'All Maps') {
	$Ptr .= '<td align="right">'."\n";
	$Ptr .= &Apache::lonhtmlcommon::ProblemOptions($cache,
						       'Statistics',
						       $sequence,
						       'Statistics');
	$Ptr .= '<td>'."\n";

	my $problem = $cache->{'StatisticsProblemSelect'};
	if($problem ne 'All Problems') {
	    my $parts = &GetParts($cache, $sequence, $problem);
	    if(scalar(@$parts) > 0) {
		$Ptr .= '<td align="right">'."\n";
		$Ptr .= &Apache::lonhtmlcommon::PartOptions($cache,
							'Statistics',
							$parts,
							'Statistics');
		$Ptr .= '</td>'."\n";
	    }
	}
    }

    $Ptr .= '</tr>'."\n";

    $Ptr .= '<tr><td align="right"><b>'.&mt('Select Sections').'</b>';
    $Ptr .= '</td>'."\n";
    $Ptr .= '<td align="left">'."\n";
    my @sections = split(':',$cache->{'sectionList'});
    my @sectionsSelected = split(':',$cache->{'sectionsSelected'});
    $Ptr .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
    $Ptr .= '</td></tr>'."\n";
    $Ptr .= '</table>';

    return $Ptr;
}

sub GetParts {
    my ($cache,$sequence,$problem)=@_;
    my @parts = ();

    foreach my $sequenceNumber (split(':',$cache->{'orderedSequences'})) {
	if($cache->{$sequenceNumber.':title'} eq $sequence) {
	    foreach my $problemNumber (split(':', 
				     $cache->{$sequenceNumber.':problems'})) {
		if($cache->{$problemNumber.':title'} eq $problem) {
		    @parts = split(':', 
		       $cache->{$sequenceNumber.':'.$problemNumber.':parts'});
		}
	    }
	}
    }
    
    return \@parts;
}

sub InitializeSelectedStudents {
    my ($cacheDB, $students, $courseID, $c, $r)=@_;
    my %cache;

    unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
        $r->print('<p class="LC_error">'.&mt('Unable to tie [_1]','database1.1.').'</p>');
        return ('ERROR');
    }

    # Remove students who don't have the proper section.
    my @sectionsSelected = split(':',$cache{'sectionsSelected'});
    for(my $studentIndex=((scalar @$students)-1); $studentIndex>=0;
        $studentIndex--) {
        my $value = $cache{$students->[$studentIndex].':section'};
        my $found = 0;
        foreach (@sectionsSelected) {
            if($_ eq 'none') {
                if($value eq '' || !defined($value) || $value eq ' ') {
                    $found = 1;
                    last;
                }
            } else {
                if($value eq $_) {
                    $found = 1;
                    last;
                }
            }
        }
        if($found == 0) {
            splice(@$students, $studentIndex, 1);
        }
    }

    untie(%cache);

    &Apache::loncoursedata::DownloadStudentCourseDataSeparate($students,
							      'true',
							      $cacheDB,
							      'true', 
							      'true',
							      $courseID,
							      $r, $c);

    return ('OK');
}

sub GraphData {
    my ($cache,$students,$r)=@_;

    my $sequenceSelected = $cache->{'StatisticsMaps'};
    my $problemSelected  = $cache->{'StatisticsProblemSelect'};
    my $partSelected     = $cache->{'StatisticsPartSelect'};

    my %percentages;
    my $Ptr = '';
    my $totalProblems = 0;

    foreach(@$students) {
	my $totalCorrect = 0;
        $totalProblems = 0;

	foreach my $sequence (split(':',$cache->{'orderedSequences'})) {
	    next if($cache->{$sequence.':title'} ne $sequenceSelected &&
		    $sequenceSelected ne 'All Maps');
	    foreach my $problem (split(':',$cache->{$sequence.':problems'})) {
		next if($cache->{$problem.':title'} ne $problemSelected &&
			$problemSelected ne 'All Problems' && 
			$sequenceSelected ne 'All Maps');
		foreach my $part (split(':',$cache->{$sequence.':'.$problem.
						     ':parts'})) {
		    next if($part ne $partSelected && 
			    $partSelected ne 'All Parts' &&
			    $problemSelected ne 'All Problems' && 
			    $sequenceSelected ne 'All Maps');
		    my $code = $cache->{$_.':'.$problem.':'.$part.':code'};
		    if($code eq '*' || $code eq '+') {
			$totalCorrect++;
			$totalProblems++;
		    } elsif($code ne 'x') {
			$totalProblems++;
		    }
		}
	    }
	}
	my $percent;
	if ( $totalProblems >= 100 ) { 
            $percent = sprintf("%d", ($totalProblems) ?
                              (($totalCorrect/$totalProblems)*100) : 0);
	} else {
	    $percent = sprintf("%d", ($totalProblems) ? $totalCorrect : 0);
	}
	if(defined($percentages{$percent})) {
	    $percentages{$percent} .= ':::'.$_;
	} else {
	    $percentages{$percent} = $_;
	}
    }

    my @percent = ();
    my @percentCount = ();
    my $max = 0;
    my $pno = 0;

    foreach my $key (sort NumericSort keys(%percentages)) {
	push(@percent, $key);
	my @temp = split(':::', $percentages{$key});
	my $count = scalar(@temp);
	if($count > $max) {
	    $max = $count;
	}
	push(@percentCount, $count);
	$pno++;
    }

    my $cId=0;
    my @data1=();
    my @data2=();
    for (my $nIdx=0; $nIdx<$pno; $nIdx++ ) {
	$data1[$cId]=$percent[$nIdx];
        $data2[$cId]=$percentCount[$nIdx];
	my $cr=$percent[$nIdx+1];
	while ($data1[$cId]<$cr) {
	    $cId++;
            $data1[$cId]=$cId;
            $data2[$cId]=0;
        }
    }

    my $xlabel;
    my $Freq;
    if ($totalProblems >= 100 ) {
        $xlabel = 'Percentage_of_Problems_Correct';
        $Freq=101;
    } else {
        $xlabel = 'Number_of_Problems_Correct';
        $Freq = $cId;
    }

#   $r->print('<br>Freq='.$Freq);
#   $r->print('<br>max='.$max);
#   $r->print('<br> percentcount='.join(',', @percentCount)); 
#   $r->print('<br> percent='.join(',', @percent));
#   $r->print('<br> percentcount='.join(',', @data1));
#   $r->print('<br> percent='.join(',', @data2));

    my @GData = ("Percentage",$xlabel,
                 'Number_of_Students',$max,$Freq,
                 join(',',@data1), join(',', @data2));

    $Ptr .= '</form>'."\n";
    $Ptr .= '<IMG src="/cgi-bin/graph.png?'.(join('&', @GData));
    $Ptr .= '" border="1" />';
    $Ptr .= '<form action="">'."\n";

    return ($Ptr, \%percentages);
}

sub NumericSort {
    $a <=> $b;
}

sub TableData {
    my($cache,$percentage)=@_;
    my $Ptr =
        &Apache::loncommon::start_data_table()
       .&Apache::loncommon::start_data_table_header_row()
       .'<th>'&mt('% Correct').'</th>'
       .'<th>'&mt('Frequency').'</th>'
       .'<th>'&mt('Students').'</th>'
       .&Apache::loncommon::end_data_table_header_row();

    foreach (sort NumericSort keys(%$percentage)) {

        my @temp = split(':::', $percentage->{$_});
        my $count = scalar(@temp);

        $Ptr .=
            &Apache::loncommon::start_data_table_row()
           .'<td>'.$_.'</td>'
           .'<td>'.$count.'</td><td>';

        foreach my $name (sort(split(':::', $percentage->{$_}))) {
            $Ptr .=
                '<a href="/adm/statistics?reportSelected='
               .&escape('Student Assessment')
               .'&StudentAssessmentStudent='
               .&escape($cache->{$name.':fullname'}).'">'
               .$cache->{$name.':fullname'}
               .'</a>,&nbsp;&nbsp;';
        }
        $Ptr .= '</td>'.&Apache::loncommon::end_data_table_row();
    }
    $Ptr .= &Apache::loncommon::end_data_table();

    return $Ptr;
}

1;
__END__