File:  [LON-CAPA] / loncom / interface / statistics / lonproblemstatistics.pm
Revision 1.27: download - view: text, annotated - select for diffs
Wed Aug 14 20:42:49 2002 UTC (21 years, 10 months ago) by stredwic
Branches: MAIN
CVS tags: HEAD
Fixed a problem with statistics calculations, acts funny when testing near
zero.  Fixed sequence displays for problem statistics so that the sequences
are in the proper order.  Same with problem analysis.  Also removed
discussion column from statistics.

# The LearningOnline Network with CAPA
# (Publication Handler
#
# $Id: lonproblemstatistics.pm,v 1.27 2002/08/14 20:42:49 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 InitializeProblemStatistics {
    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 ('ERROR', undef);
    }

    # 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 $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 ('ERROR', undef);
            }
            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 ('ERROR', undef); }

        unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
            $r->print('Unable to tie database.');
            return ('ERROR', undef);
        }
        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 ('ERROR', undef);
        }
        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 ('ERROR', undef);
        }
    }

    my $orderedProblems = &SortProblems(\%cache, 
                                        $cache{'ProblemStatisticsSort'},
                                        $cache{'SortProblems'},
                                        $cache{'ProblemStatisticsAscend'});
    return ('OK', $orderedProblems);
}

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

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

    unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
        $r->print('Unable to tie database.');
        return;
    }
    my $Ptr = '';
    $Ptr .= '<table border="0" cellspacing="5"><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'});
    my @sectionsSelected = split(':',$cache{'sectionsSelected'});
    $Ptr .= &Apache::lonhtmlcommon::MultipleSectionSelect(\@sections,
                                                          \@sectionsSelected,
                                                          'Statistics');
    $Ptr .= '</td></tr>'."\n";
    $Ptr .= &ProblemStatisticsButtons($cache{'DisplayFormat'}, 
                                      $cache{'DisplayLegend'},
                                      $cache{'SortProblems'});
    $Ptr .= '</table>';
    if($cache{'DisplayLegend'} eq 'Show Legend') {
        $Ptr .= &ProblemStatisticsLegend();
    }
    $r->print($Ptr);
    $r->rflush();
    untie(%cache);

    my ($result, $orderedProblems) =
        &InitializeProblemStatistics($cacheDB, $students, $courseID, $c, $r);
    if($result ne 'OK') {
        return;
    }

    unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
        $r->print('Unable to tie database.');
        return;
    }
    &BuildStatisticsTable(\%cache, $cache{'DisplayFormat'}, 
                          $cache{'SortProblems'}, $orderedProblems, 
                          \@Header, $r, $color);
    untie(%cache);

    return;
}

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

    my ($result, undef) = 
        &InitializeProblemStatistics($cacheDB, $students, $courseID, $c, $r);
    if($result ne 'OK') {
        return;
    }

    unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
        return 'Unable to tie database.';
    }
   
    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">';
        $Str .= '<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,$sortProblems,$orderedProblems,$headings,
        $r,$color)=@_;

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

        if($currentSequence == -1 || 
           ($sortProblems eq 'Sort Within Sequence' && 
            $currentSequence != $sequence)) {
            if($displayFormat ne 'Display CSV Format') {
                if($currentSequence ne -1) {
                    $r->print('</table>');
                    $r->print('</td></tr></table><br>');
                }
                if($sortProblems eq 'Sort Within Sequence') {
                    $r->print('<b>'.$cache->{$sequence.':title'}.'</b>');
                }
                $r->print('<table border="0"><tr><td bgcolor="#777777">'."\n");
                $r->print('<table border="0" cellpadding="3">'."\n");
                $r->print(&CreateProblemStatisticsTableHeading($headings, $r));
            } else {
                if($sortProblems eq 'Sort Within Sequence') {
                    $r->print('"'.$cache->{$sequence.':title'}.'"');
                }
                $r->print('<br>');
            }
            $currentSequence = $sequence;
        }

        my $ref = '<a href="'.$cache->{$problem.':source'}.
                  '" target="_blank">'.$cache->{$problem.':title'}.'</a>';
        my $title = $cache->{$problem.':title'};
        if($part != 0) {
            $title .= ' Part '.$part;
        }
        my $source = $cache->{$problem.':source'};
        my $tableData = join('&', $ref, $title, $source,
                       $cache->{$_.':studentCount'},
                       $cache->{$_.':totalTries'},
                       $cache->{$_.':maxTries'},
                       $cache->{$_.':mean'},
                       $cache->{$_.':correct'},
                       $cache->{$_.':correctByOverride'},
                       $cache->{$_.':percentWrong'},
                       $cache->{$_.':degreeOfDifficulty'},
                       $cache->{$_.':standardDeviation'},
                       $cache->{$_.':skewness'},
                       $cache->{$_.':discriminationFactor1'},
                       $cache->{$_.':discriminationFactor2'});

        &TableRow($displayFormat,$tableData,$count,$r,$color);

        $count++;
    }
    if($displayFormat ne 'Display CSV Format') {
        $r->print('</table>'."\n");
        $r->print('</td></tr></table>');
    } else {
        $r->print('<br>');
    }

    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)=split(/\&/,$Str);	
    my $Ptr;
    if($displayFormat eq 'Display CSV Format') {
        $Ptr='"'.$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".
             "<br>\n";

        $r->print("\n".$Ptr);
    } else {
        $Ptr='<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";
        $r->print($Ptr.'</tr>'."\n");
    }

    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, $sortProblems)=@_;

    my $Ptr = '<tr><td></td><td align="left">';
    $Ptr .= '<input type="submit" name="DoDiffGraph" ';
    $Ptr .= 'value="Degree of Difficulty" />'."\n";
    $Ptr .= '</td><td align="left">';
    $Ptr .= '<input type="submit" name="PercentWrongGraph" ';
    $Ptr .= 'value="Percent Wrong" />'."\n";
    $Ptr .= '</td></tr><tr><td></td><td>'."\n";
    $Ptr .= '<input type="submit" name="SortProblems" ';
    if($sortProblems eq 'Sort All Problems') {
        $Ptr .= 'value="Sort Within Sequence" />'."\n";
    } else {
        $Ptr .= 'value="Sort All Problems" />'."\n";
    }
    $Ptr .= '</td><td align="left">';
    $Ptr .= '<input type="submit" name="DisplayLegend" ';
    if($displayLegend eq 'Show Legend') {
        $Ptr .= 'value="Hide Legend" />'."\n";
    } else {
        $Ptr .= 'value="Show Legend" />'."\n";
    }
    $Ptr .= '</td><td align="left">';
    $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;
}

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

    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++;
                    }
                }

                my $studentTriesJoined = join(':::', @studentTries);
                $problemData{$id.':sequenceTitle'} = 
                    $cache->{$sequence.':title'};
                $problemData{$id.':studentCount'} = $studentCount;
                $problemData{$id.':totalTries'} = $totalTries;
                $problemData{$id.':studentTries'} = $studentTriesJoined;
                $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);

    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,$sortProblems,$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 = ':discriminationFactor1'; }
    elsif($sortBy eq "D.F.2nd") { $data = ':discriminationFactor2'; }
    else                        { return \@problems; }

    my %temp;
    my @sequenceList=();
    foreach(@problems) {
        my ($sequence) = split(':', $_);

        my @array=();
        my $tempArray;
        if(defined($temp{$sequence})) {
            $tempArray = $temp{$sequence};
        } else {
            push(@sequenceList, $sequence);
            $tempArray = \@array;
            $temp{$sequence} = $tempArray;
        }

        push(@$tempArray, $_);
    }

    my @orderedProblems;
    if($sortProblems eq "Sort Within Sequence") {
        foreach(keys(%temp)) {
            my $tempArray = $temp{$_};
            my @tempOrder =
                sort { $problemData->{$a.$data} <=> $problemData->{$b.$data} }
            @$tempArray;
            $temp{$_} = \@tempOrder;
        }
        foreach(@sequenceList) {
            my $tempArray = $temp{$_};
            @orderedProblems = (@orderedProblems, @$tempArray);
        }
    } else {
        @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
        my $mean = ($data->{$_.':studentCount'}) ? 
            ($data->{$_.':totalTries'} / $data->{$_.':studentCount'}) : 0;
        $data->{$_.':mean'} = sprintf("%.2f", $mean);

        # %Wrong
        my $pw = ($data->{$_.':studentCount'}) ?
            (($data->{$_.':wrong'} / $data->{$_.':studentCount'}) * 100.0) : 
            100.0;
        $data->{$_.':percentWrong'} = sprintf("%.1f", $pw);

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

        $data->{$_.':degreeOfDifficulty'} = sprintf("%.2f", $dod);

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

        # Standard deviation
        my $standardDeviation;
        if($data->{$_.':studentCount'} - 1 > 0) {
            $standardDeviation = (sqrt($sumSquared)) / 
                                 ($data->{$_.':studentCount'} - 1);
        } else {
            $standardDeviation =  0.0;
        }
        $data->{$_.':standardDeviation'} = sprintf("%.1f", $standardDeviation);

        # Skewness
        my $skew;
        if($standardDeviation > 0.0999 && $data->{$_.':studentCount'} > 0) {
            $skew = (((sqrt($sumSquared)) / $data->{$_.':studentCount'}) / 
                     ($standardDeviation * 
                      $standardDeviation * 
                      $standardDeviation));
        } else {
            $skew = 0.0;
        }

        $data->{$_.':skewness'} = sprintf("%.1f", $skew);

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

        my $df1 = $upper1Sum - $lower1Sum;
        $data->{$_.':discriminationFactor1'} = sprintf("%.2f", $df1);

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

        my $df2 = $upper2Sum - $lower2Sum;
        $data->{$_.':discriminationFactor2'} = sprintf("%.2f", $df2);
    }

    return;
}

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

1;
__END__

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