File:  [LON-CAPA] / loncom / interface / statistics / lonproblemstatistics.pm
Revision 1.25: download - view: text, annotated - select for diffs
Wed Aug 14 16:18:55 2002 UTC (21 years, 10 months ago) by stredwic
Branches: MAIN
CVS tags: HEAD
Added section selection to problem statistics and problem analysis.
Fixed some divide by zeros in lonproblemstatistics.
Broke up the table of option response problems and gave them the
heading of the sequence in which they lie.

# The LearningOnline Network with CAPA
# (Publication Handler
#
# $Id: lonproblemstatistics.pm,v 1.25 2002/08/14 16:18:55 stredwic 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/
#
# (Navigate problems for statistical reports
# YEAR=2001
# 5/5,7/9,7/25/1,8/11,9/13,9/26,10/5,10/9,10/22,10/26 Behrouz Minaei
# 11/1,11/4,11/16,12/14,12/16,12/18,12/20,12/31 Behrouz Minaei
# YEAR=2002
# 1/22,2/1,2/6,2/25,3/2,3/6,3/17,3/21,3/22,3/26,4/7,5/6 Behrouz Minaei
# 5/12,5/14,5/15,5/19,5/26,7/16,7/25,7/29,8/5  Behrouz Minaei
#
###

package Apache::lonproblemstatistics; 

use strict;
use Apache::lonnet();
use Apache::lonhtmlcommon;
use Apache::loncoursedata;
use GDBM_File;

my $jr;

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

    $jr = $r;

    unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
        $r->print('Unable to tie database.');
        return;
    }

    # 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);
        }
    }

    my $Ptr = '';
    $Ptr .= '<table border="0"><tbody>';
    $Ptr .= '<tr><td align="right"><b>Select Map</b></td>'."\n";
    $Ptr .= '<td align="left">';
    $Ptr .= &Apache::lonhtmlcommon::MapOptions(\%cache, 'ProblemStatistics',
                                               'Statistics');
    $Ptr .= '</td></tr>'."\n";
    $Ptr .= '<tr><td align="right"><b>Sorting Type:</b></td>'."\n";
    $Ptr .= '<td align="left">'."\n";
    $Ptr .= &Apache::lonhtmlcommon::AscendOrderOptions(
                                            $cache{'ProblemStatisticsAscend'}, 
                                            'ProblemStatistics',
                                            'Statistics');
    $Ptr .= '</td></tr>'."\n";
    $Ptr .= '<tr><td align="right"><b>Select Sections</b>';
    $Ptr .= '</td>'."\n";
    $Ptr .= '<td align="left">'."\n";
    my @sections = split(':',$cache{'sectionList'});
    $Ptr .= &Apache::lonhtmlcommon::MultipleSectionSelect(\@sections,
                                                          \@sectionsSelected,
                                                          'Statistics');
    $Ptr .= '</td></tr>'."\n";
    $Ptr .= &ProblemStatisticsButtons($cache{'DisplayFormat'}, 
                                      $cache{'DisplayLegend'});
    $Ptr .= '</table>';
    if($cache{'DisplayLegend'} eq 'Show Legend') {
        $Ptr .= &ProblemStatisticsLegend();
    }
    $r->print($Ptr);
    $r->rflush();

    my @Header = ("Homework Sets Order","#Stdnts","Tries","Mod",
                  "Mean","#YES","#yes","%Wrng","DoDiff",
                  "S.D.","Skew.","D.F.1st","D.F.2nd","Disc.");
    my $color=&setbgcolor(0);

#    my %Discuss=&Apache::loncoursedata::LoadDiscussion($courseID);
    my $lastStatus = (defined($cache{'StatisticsLastStatus'})) ?
                     $cache{'StatisticsLastStatus'} : 'Nothing';
    my $whichStudents = join(':::',sort(@$students));
    if(!defined($cache{'StatisticsCached'}) || 
       $lastStatus ne $cache{'Status'} ||
       $whichStudents ne $cache{'StatisticsWhichStudents'}) {
        if(defined($cache{'StatisticsCached'})) {
            untie(%cache);
            unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
                $r->print('Unable to tie database.');
                return;
            }
            my @statkeys = split(':::', $cache{'StatisticsKeys'});
            delete $cache{'StatisticsKeys'};
            delete $cache{'StatisticsCached'};
            foreach(@statkeys) {
                delete $cache{$_};
            }
        }
        untie(%cache);
        &Apache::loncoursedata::DownloadStudentCourseDataSeparate($students,
                                                                  'true',
                                                                  $cacheDB,
                                                                  'true', 
                                                                  'true',
                                                                  $courseID,
                                                                  $r, $c);
        if($c->aborted()) { return; }

        unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
            $r->print('Unable to tie database.');
            return;
        }
        my ($problemData) = &ExtractStudentData(\%cache, $students);
        &CalculateStatistics($problemData, \%cache);
        untie(%cache);

        unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
            $r->print('Unable to tie database.');
            return;
        }
        foreach(keys(%$problemData)) {
            $cache{$_} = $problemData->{$_};
        }
        $cache{'StatisticsKeys'} = join(':::', keys(%$problemData));
        $cache{'StatisticsCached'} = 'true';
        $cache{'StatisticsLastStatus'} = $cache{'Status'};
        $cache{'StatisticsWhichStudents'} = $whichStudents;
        untie(%cache);

        unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
            $r->print('Unable to tie database.');
            return;
        }
    }

    my $orderedProblems = &SortProblems(\%cache, 
                                        $cache{'ProblemStatisticsSort'},
                                        $cache{'ProblemStatisticsAscend'});
    &BuildStatisticsTable(\%cache, $cache{'DisplayFormat'}, $orderedProblems, 
                          \@Header, $r, $color);
    untie(%cache);

    return;
}

sub BuildGraphicChart {
    my ($graph,$cacheDB,$courseDescription,$r)=@_;
    my %cache;
    my $max = 0;

    unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
        return '<html><body>Unable to tie database.</body></html>';
    }
   
    my @problems = split(':::', $cache{'problemList'});
    my @values = ();
    foreach (@problems) {
        my $data = 0;
        if($graph eq 'DoDiffGraph') {
            $data = sprintf("%.2f", $cache{$_.':degreeOfDifficulty'}),
        } else {
            $data = sprintf("%.1f", $cache{$_.':percentWrong'}),
        }
        if($max < $data) {
            $max = $data;
        }
        push(@values, $data);
    }
    untie(%cache);

    my $sendValues = join(',', @values);
    my $sendCount = scalar(@values);

    my $title = '';
    if($graph eq 'DoDiffGraph') {
	$title = 'Degree-of-Difficulty';
    } else {
	$title = 'Wrong-Percentage';
    }
    my @GData = ($courseDescription, 'Problems', $title, $max, $sendCount, 
                 $sendValues);

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

    return;
}

#---- Problem Statistics Web Page ---------------------------------------

sub CreateProblemStatisticsTableHeading {
    my ($headings,$r)=@_;

    my $Str='';
    $Str .= '<tr>'."\n";
    $Str .= '<th bgcolor="#ffffe6">P#</th>'."\n";
    foreach(@$headings) {
	$Str .= '<th bgcolor="#ffffe6">'.'<a href="/adm/statistics?reportSelected=';
        $Str .= &Apache::lonnet::escape('Problem Statistics');
        $Str .= '&ProblemStatisticsSort=';
        $Str .= &Apache::lonnet::escape($_).'">'.$_.'</a>&nbsp</th>'."\n";
    }
    $Str .= "\n".'</tr>'."\n";    

    return $Str;
}

sub BuildStatisticsTable {
    my ($cache,$displayFormat,$orderedProblems,$headings,$r,$color)=@_;

#6666666
#    my $file="/home/httpd/perl/tmp/183d.txt";
#    open(OUT, ">$file");
#6666666
##     &Apache::lonstatistics::Create_PrgWin($r);
##777777
##    my (%Activity) = &LoadActivityLog();
##    $r->print('<script>popwin.document.popremain.remaining.value="'.
##              'Loading Discussion...";</script>');
##    my ($doDiffFile) = &LoadDoDiffFile();

##777777
##    $Str .= &Classify($discriminantFactor, $students);

     if($displayFormat ne 'Display CSV Format') {
        $r->print('<table border="0"><tr><td bgcolor="#777777">'."\n");
        $r->print('<table border="0" cellpadding="3">'."\n");
        $r->print(&CreateProblemStatisticsTableHeading($headings, $r));
    } else {
        $r->print('<br>');
    }

    my $count = 1;
    foreach(@$orderedProblems) {
        my ($sequence,$problem,$part)=split(':', $_);
        if($cache->{'StatisticsMaps'} ne 'All Maps'  &&
           $cache->{'StatisticsMaps'} ne $cache->{$sequence.':title'}) {
            next;
        }

        my $ref = '<a href="'.$cache->{$problem.':source'}.
                  '" target="_blank">'.$cache->{$problem.':title'}.'</a>';
#        my $ref = $cache->{$problem.':title'};
        my $title = $cache->{$problem.':title'};
        my $source = 'source';
        my $tableData = join('&', $ref, $title, $source,
                       $cache->{$_.':studentCount'},
                       $cache->{$_.':totalTries'},
                       $cache->{$_.':maxTries'},
                       sprintf("%.2f", $cache->{$_.':mean'}),
                       $cache->{$_.':correct'},
                       $cache->{$_.':correctByOverride'},
                       sprintf("%.1f", $cache->{$_.':percentWrong'}),
                       sprintf("%.2f", $cache->{$_.':degreeOfDifficulty'}),
                       sprintf("%.1f", $cache->{$_.':standardDeviation'}),
                       sprintf("%.1f", $cache->{$_.':skewness'}),
                       sprintf("%.2f", $cache->{$_.':discriminationFactor1'}),
                       sprintf("%.2f", $cache->{$_.':discriminationFactor2'}),
                       0); # 0 is for discussion, need to figure out

        &TableRow($displayFormat,$tableData,$count,$r,$color);
        $count++;
    }
    if($cache->{'DisplayFormat'} ne 'Display CSV Format') {
        $r->print('</table>'."\n");
    }
    $r->print('</td></tr></table>');
#6666666
#	    $r->print('<br>'.$out.'&'.$DoD);
#            print (OUT $out.'@'.$DoD.'&');
#6666666

#6666666
#    close( OUT );
#666666
    return;
}

sub TableRow {
    my ($displayFormat,$Str,$RealIdx,$r,$color)=@_;
    my($ref,$title,$source,$StdNo,$TotalTries,$MxTries,$Avg,$YES,$Override,
       $Wrng,$DoD,$SD,$Sk,$_D1,$_D2,$DiscNo,$Prob)=split(/\&/,$Str);	
    my $Ptr;
    if($displayFormat eq 'Display CSV Format') {
        $Ptr="\n".'<br>'.
             "\n".'"'.$RealIdx.'",'.
             "\n".'"'.$title.'",'.
             "\n".'"'.$source.'",'.
             "\n".'"'.$StdNo.'",'.
             "\n".'"'.$TotalTries.'",'.
             "\n".'"'.$MxTries.'",'.
             "\n".'"'.$Avg.'",'.
             "\n".'"'.$YES.'",'.
             "\n".'"'.$Override.'",'.
             "\n".'"'.$Wrng.'",'.
             "\n".'"'.$DoD.'",'.
             "\n".'"'.$SD.'",'.
             "\n".'"'.$Sk.'",'.
             "\n".'"'.$_D1.'",'.
	     "\n".'"'.$_D2.'"'.
	     "\n".'"'.$DiscNo.'"';

        $r->print("\n".$Ptr);
    } else {
        $Ptr="\n".'<tr>'.
             "\n".'<td bgcolor="#ffffe6">'.$RealIdx.'</td>'.
             "\n".'<td bgcolor="#ffffe6">'.$ref.'</td>'.
             "\n".'<td bgcolor='.$color->{"yellow"}.'> '.$StdNo.'</td>'.
             "\n".'<td bgcolor='.$color->{"yellow"}.'>'.$TotalTries.'</td>'.
             "\n".'<td bgcolor='.$color->{"yellow"}.'>'.$MxTries.'</td>'.
             "\n".'<td bgcolor='.$color->{"gb"}.'>'.$Avg.'</td>'.
             "\n".'<td bgcolor='.$color->{"gb"}.'> '.$YES.'</td>'.
             "\n".'<td bgcolor='.$color->{"gb"}.'> '.$Override.'</td>'.
             "\n".'<td bgcolor='.$color->{"red"}.'> '.$Wrng.'</td>'.
             "\n".'<td bgcolor='.$color->{"red"}.'> '.$DoD.'</td>'.
             "\n".'<td bgcolor='.$color->{"green"}.'> '.$SD.'</td>'.
             "\n".'<td bgcolor='.$color->{"green"}.'> '.$Sk.'</td>'.
             "\n".'<td bgcolor='.$color->{"purple"}.'> '.$_D1.'</td>'.
	     "\n".'<td bgcolor='.$color->{"purple"}.'> '.$_D2.'</td>'.
             "\n".'<td bgcolor='.$color->{"yellow"}.'> '.$DiscNo.'</td>';
        $r->print("\n".$Ptr.'</tr>' );
    }

    return;
}

# For loading the colored table for display or un-colored for print
sub setbgcolor {
    my $PrintTable=shift;
    my %color;
    if ($PrintTable){
	$color{"gb"}="#FFFFFF";
	$color{"red"}="#FFFFFF";
	$color{"yellow"}="#FFFFFF";
	$color{"green"}="#FFFFFF";
	$color{"purple"}="#FFFFFF";
    } else {
	$color{"gb"}="#DDFFFF";
	$color{"red"}="#FFDDDD";
	$color{"yellow"}="#EEFFCC";
	$color{"green"}="#DDFFDD";
	$color{"purple"}="#FFDDFF";
    }

    return \%color;
}

sub ProblemStatisticsButtons {
    my ($displayFormat, $displayLegend)=@_;

    my $Ptr = '<tr><td></td><td align="left">';
    $Ptr .= '<input type="submit" name="DoDiffGraph" ';
    $Ptr .= 'value="DoDiff Graph" />'."\n";
    $Ptr .= '&nbsp;&nbsp;&nbsp;';
    $Ptr .= '<input type="submit" name="PercentWrongGraph" ';
    $Ptr .= 'value="%Wrong Graph" />'."\n";
    $Ptr .= '</td></tr><tr><td></td><td>'."\n";
    $Ptr .= '<input type="submit" name="DisplayLegend" ';
    if($displayLegend eq 'Show Legend') {
        $Ptr .= 'value="Hide Legend" />'."\n";
    } else {
        $Ptr .= 'value="Show Legend" />'."\n";
    }
    $Ptr .= '&nbsp;&nbsp;&nbsp;';
    $Ptr .= '<input type="submit" name="DisplayCSVFormat" ';
    if($displayFormat eq 'Display CSV Format') {
        $Ptr .= 'value="Display Table Format" />'."\n";
    } else {
        $Ptr .= 'value="Display CSV Format" />'."\n";
    }
    $Ptr .= '</td></tr>';

    return $Ptr;
}

sub ProblemStatisticsLegend {
    my $Ptr = '';
    $Ptr = '<table border="0">';
    $Ptr .= '<tr><td>';
    $Ptr .= '<b>#Stdnts</b></td>';
    $Ptr .= '<td>Total number of students attempted the problem.';
    $Ptr .= '</td></tr><tr><td>';
    $Ptr .= '<b>Tries</b></td>';
    $Ptr .= '<td>Total number of tries for solving the problem.';
    $Ptr .= '</td></tr><tr><td>';
    $Ptr .= '<b>Mod</b></td>';
    $Ptr .= '<td>Largest number of tries for solving the problem by a student.';
    $Ptr .= '</td></tr><tr><td>';
    $Ptr .= '<b>Mean</b></td>';
    $Ptr .= '<td>Average number of tries. [ Tries / #Stdnts ]';
    $Ptr .= '</td></tr><tr><td>';
    $Ptr .= '<b>#YES</b></td>';
    $Ptr .= '<td>Number of students solved the problem correctly.';
    $Ptr .= '</td></tr><tr><td>';
    $Ptr .= '<b>#yes</b></td>';
    $Ptr .= '<td>Number of students solved the problem by override.';
    $Ptr .= '</td></tr><tr><td>';
    $Ptr .= '<b>%Wrong</b></td>';
    $Ptr .= '<td>Percentage of students who tried to solve the problem ';
    $Ptr .= 'but is still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]';
    $Ptr .= '</td></tr><tr><td>';
    $Ptr .= '<b>DoDiff</b></td>';
    $Ptr .= '<td>Degree of Difficulty of the problem.  ';
    $Ptr .= '[ 1 - ((#YES+#yes) / Tries) ]';
    $Ptr .= '</td></tr><tr><td>';
    $Ptr .= '<b>S.D.</b></td>';
    $Ptr .= '<td>Standard Deviation of the tries.  ';
    $Ptr .= '[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1) ';
    $Ptr .= 'where Xi denotes every student\'s tries ]';
    $Ptr .= '</td></tr><tr><td>';
    $Ptr .= '<b>Skew.</b></td>';
    $Ptr .= '<td>Skewness of the students tries.';
    $Ptr .= '[(sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3)]';
    $Ptr .= '</td></tr><tr><td>';
    $Ptr .= '<b>Dis.F.</b></td>';
    $Ptr .= '<td>Discrimination Factor: A Standard for evaluating the ';
    $Ptr .= 'problem according to a Criterion<br>';
    $Ptr .= '<b>[Applied Criterion in %27 Upper Students - ';
    $Ptr .= 'Applied the same Criterion in %27 Lower Students]</b><br>';
    $Ptr .= '<b>1st Criterion</b> for Sorting the Students: ';
    $Ptr .= '<b>Sum of Partial Credit Awarded / Total Number of Tries</b><br>';
    $Ptr .= '<b>2nd Criterion</b> for Sorting the Students: ';
    $Ptr .= '<b>Total number of Correct Answers / Total Number of Tries</b>';
    $Ptr .= '</td></tr>';
    $Ptr .= '<tr><td><b>Disc.</b></td>';
    $Ptr .= '<td>Number of Students had at least one discussion.';
    $Ptr .= '</td></tr></table>';

    return $Ptr;
}

#------- Processing upperlist and lowerlist according to each problem

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

#$Apache::lonxml::debug=1;
#&Apache::lonhomework::showhash(%$cache);
#$Apache::lonxml::debug=0;

    my @problemList=();
    my %problemData;
    foreach my $sequence (split(':', $cache->{'orderedSequences'})) {
        foreach my $problemID (split(':', $cache->{$sequence.':problems'})) {
            foreach my $part (split(/\:/,$cache->{$sequence.':'.
                                                  $problemID.
                                                  ':parts'})) {
                my $id = $sequence.':'.$problemID.':'.$part;
                push(@problemList, $id);
                my $totalTries = 0;
                my $totalAwarded = 0;
                my $correct = 0;
                my $correctByOverride = 0;
                my $studentCount = 0;
                my $maxTries = 0;
                my $totalFirst = 0;
                my @studentTries=();
                foreach(@$students) {
                    my $code = $cache->{"$_:$problemID:$part:code"};

                    if(defined($cache->{$_.':error'}) || $code eq ' ' ||
                       $cache->{"$_:$problemID:NoVersion"} eq 'true') {
                        next;
                    }

                    $studentCount++;
                    my $tries =  $cache->{"$_:$problemID:$part:tries"};
                    if($maxTries < $tries) {
                        $maxTries = $tries;
                    }
                    $totalTries += $tries;
                    push(@studentTries, $tries);

                    my $awarded = $cache->{"$_:$problemID:$part:awarded"};
                    $totalAwarded += $awarded;

                    if($code eq '*') {
                        $correct++;
                        if($tries == 1) {
                            $totalFirst++;
                        }
                    } elsif($code eq '+') {
                        $correctByOverride++;
                    }
                }

                $problemData{$id.':sequenceTitle'} = 
                    $cache->{$sequence.':title'};
                $problemData{$id.':studentCount'} = $studentCount;
                $problemData{$id.':totalTries'} = $totalTries;
                $problemData{$id.':studentTries'} = \@studentTries;
                $problemData{$id.':totalAwarded'} = $totalAwarded;
                $problemData{$id.':correct'} = $correct;
                $problemData{$id.':correctByOverride'} = $correctByOverride;
                $problemData{$id.':wrong'} = $studentCount - 
                                             ($correct + $correctByOverride);
                $problemData{$id.':maxTries'} = $maxTries;
                $problemData{$id.':totalFirst'} = $totalFirst;
            }
        }
    }

    my @upperStudents1=();
    my @lowerStudents1=();
    my @upperStudents2=();
    my @lowerStudents2=();
    my $upperCount = int(0.27*scalar(@$students));
    # Discriminant Factor criterion 1
    my $sortedStudents = &SortDivideByTries($students,$cache,':totalAwarded');

    for(my $i=0; $i<$upperCount; $i++) {
        push(@lowerStudents1, $sortedStudents->[$i]);
        push(@upperStudents1, $sortedStudents->[(scalar(@$students)-$i-1)]);
    }

    $problemData{'studentsUpperListCriterion1'}=join(':::', @upperStudents1);
    $problemData{'studentsLowerListCriterion1'}=join(':::', @lowerStudents1);

    # Discriminant Factor criterion 2
    $sortedStudents = &SortDivideByTries($students, $cache, ':totalSolved');

    for(my $i=0; $i<$upperCount; $i++) {
        push(@lowerStudents2, $sortedStudents->[$i]);
        push(@upperStudents2, $sortedStudents->[(scalar(@$students)-$i-1)]);
    }
    $problemData{'studentsUpperListCriterion2'}=join(':::', @upperStudents2);
    $problemData{'studentsLowerListCriterion2'}=join(':::', @lowerStudents2);

    $problemData{'problemList'} = join(':::', @problemList);
#                $Discussed=0;
#                if($Discuss->{"$name:$problem"}) {
#		    $TotDiscuss++;
#                    $Discussed=1;
#                }

    return \%problemData;
}

sub SortDivideByTries {
    my ($toSort, $data, $sortOn)=@_;
    my @orderedData = sort { ($data->{$a.':totalTries'}) ? 
                             ($data->{$a.$sortOn}/$data->{$a.':totalTries'}):0
                             <=>
                             ($data->{$b.':totalTries'}) ? 
                             ($data->{$b.$sortOn}/$data->{$b.':totalTries'}):0
                           } @$toSort;

    return \@orderedData;
}

sub SortProblems {
    my ($problemData,$sortBy,$ascend)=@_;

    my @problems = split(':::', $problemData->{'problemList'});
    if($sortBy eq "Homework Sets Order") {
        return \@problems;
    }

    my $data;

    if   ($sortBy eq "#Stdnts") { $data = ':studentCount'; }
    elsif($sortBy eq "Tries")   { $data = ':totalTries'; }
    elsif($sortBy eq "Mod")     { $data = ':maxTries'; }
    elsif($sortBy eq "Mean")    { $data = ':mean'; }
    elsif($sortBy eq "#YES")    { $data = ':correct'; }
    elsif($sortBy eq "#yes")    { $data = ':correctByOverride'; }
    elsif($sortBy eq "%Wrng")   { $data = ':percentWrong'; }
    elsif($sortBy eq "DoDiff")  { $data = ':degreeOfDifficulty'; }
    elsif($sortBy eq "S.D.")    { $data = ':standardDeviation'; }
    elsif($sortBy eq "Skew.")   { $data = ':skewness'; }
    elsif($sortBy eq "D.F.1st") { $data = ':discriminantFactor1'; }
    elsif($sortBy eq "D.F.2nd") { $data = ':discriminantFactor2'; }
    elsif($sortBy eq "Disc.")   { $data = ''; }
    else                        { return \@problems; }

    my @orderedProblems = 
        sort { $problemData->{$a.$data} <=> $problemData->{$b.$data} }
             @problems;
    if($ascend eq 'Descending') {
        @orderedProblems = reverse(@orderedProblems);
    }

    return \@orderedProblems;
}

sub CalculateStatistics {
    my ($data, $cache)=@_;

    my @problems = split(':::', $data->{'problemList'});
    foreach(@problems) {
        # Mean
        $data->{$_.':mean'} = ($data->{$_.':studentCount'}) ? 
            ($data->{$_.':totalTries'} / $data->{$_.':studentCount'}) : 0;

        # %Wrong
        $data->{$_.':percentWrong'} = ($data->{$_.':studentCount'}) ?
            (($data->{$_.':wrong'} / $data->{$_.':studentCount'}) * 100.0) : 
            100.0;

        # Degree of Difficulty
        $data->{$_.':degreeOfDifficulty'} = ($data->{$_.':totalTries'}) ?
            (1 - (($data->{$_.':correct'} + $data->{$_.':correctByOverride'}) /
                  $data->{$_.':totalTries'})) : 0;

        # Factor in mean
        my $studentTries = $data->{$_.':studentTries'};
        foreach(my $index=0; $index < scalar(@$studentTries); $index++) {
            $studentTries->[$index] -= $data->{$_.':mean'};
        }
        my $sumSquared = 0;
        my $sumCubed = 0;
        foreach(@$studentTries) {
            my $squared = ($_ * $_);
            my $cubed = ($squared * $_);
            $sumSquared += $squared;
            $sumCubed += $cubed;
        }

        # Standard deviation
        $data->{$_.':standardDeviation'} = ($data->{$_.':studentCount'} - 1) ?
            ((sqrt($sumSquared)) / ($data->{$_.':studentCount'} - 1)) : 0;

        # Skewness
        my $standardDeviation = $data->{$_.':standardDeviation'};
        $data->{$_.':skewness'} = ($data->{$_.':standardDeviation'}) ?
            (((sqrt($sumSquared)) / $data->{$_.':studentCount'}) / 
             ($standardDeviation * $standardDeviation * $standardDeviation)) :
             0;

        # Discrimination Factor 1
        my ($sequence, $problem, $part) = split(':', $_);

        my @upper1 = split(':::', $data->{'studentsUpperListCriterion1'});
        my @lower1 = split(':::', $data->{'studentsLowerListCriterion1'});

        my $upper1Sum=0;
        foreach my $name (@upper1) {
            $upper1Sum += $cache->{"$name:$problem:$part:awarded"};
        }
        $upper1Sum = (scalar(@upper1)) ? ($upper1Sum/(scalar(@upper1))) : 0;

        my $lower1Sum=0;
        foreach my $name (@lower1) {
            $lower1Sum += $cache->{"$name:$problem:$part:awarded"};
        }
        $lower1Sum = (scalar(@lower1)) ? ($lower1Sum/(scalar(@lower1))) : 0;

        $data->{$_.':discriminationFactor1'} = $upper1Sum - $lower1Sum;

        # Discrimination Factor 2
        my @upper2 = split(':::', $data->{'studentsUpperListCriterion2'});
        my @lower2 = split(':::', $data->{'studentsLowerListCriterion2'});

        my $upper2Sum=0;
        foreach my $name (@upper2) {
            $upper2Sum += $cache->{"$name:$problem:$part:awarded"};
        }
        $upper2Sum = (scalar(@upper2)) ? ($upper2Sum/(scalar(@upper2))) : 0;

        my $lower2Sum=0;
        foreach my $name (@lower2) {
            $lower2Sum += $cache->{"$name:$problem:$part:awarded"};
        }
        $lower2Sum = (scalar(@lower2)) ? ($lower2Sum/(scalar(@lower2))) : 0;

        $data->{$_.':discriminationFactor2'} = $upper2Sum - $lower2Sum;
    }

    return;
}

#---- END Problem Statistics Web Page ----------------------------------------

1;
__END__

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