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, 11 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.

    1: # The LearningOnline Network with CAPA
    2: # (Publication Handler
    3: #
    4: # $Id: lonproblemstatistics.pm,v 1.25 2002/08/14 16:18:55 stredwic 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: # (Navigate problems for statistical reports
   29: # YEAR=2001
   30: # 5/5,7/9,7/25/1,8/11,9/13,9/26,10/5,10/9,10/22,10/26 Behrouz Minaei
   31: # 11/1,11/4,11/16,12/14,12/16,12/18,12/20,12/31 Behrouz Minaei
   32: # YEAR=2002
   33: # 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
   34: # 5/12,5/14,5/15,5/19,5/26,7/16,7/25,7/29,8/5  Behrouz Minaei
   35: #
   36: ###
   37: 
   38: package Apache::lonproblemstatistics; 
   39: 
   40: use strict;
   41: use Apache::lonnet();
   42: use Apache::lonhtmlcommon;
   43: use Apache::loncoursedata;
   44: use GDBM_File;
   45: 
   46: my $jr;
   47: 
   48: sub BuildProblemStatisticsPage {
   49:     my ($cacheDB, $students, $courseID, $c, $r)=@_;
   50:     my %cache;
   51: 
   52:     $jr = $r;
   53: 
   54:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
   55:         $r->print('Unable to tie database.');
   56:         return;
   57:     }
   58: 
   59:     # Remove students who don't have the proper section.
   60:     my @sectionsSelected = split(':',$cache{'sectionsSelected'});
   61:     for(my $studentIndex=((scalar @$students)-1); $studentIndex>=0;
   62:         $studentIndex--) {
   63:         my $value = $cache{$students->[$studentIndex].':section'};
   64:         my $found = 0;
   65:         foreach (@sectionsSelected) {
   66:             if($_ eq 'none') {
   67:                 if($value eq '' || !defined($value) || $value eq ' ') {
   68:                     $found = 1;
   69:                     last;
   70:                 }
   71:             } else {
   72:                 if($value eq $_) {
   73:                     $found = 1;
   74:                     last;
   75:                 }
   76:             }
   77:         }
   78:         if($found == 0) {
   79:             splice(@$students, $studentIndex, 1);
   80:         }
   81:     }
   82: 
   83:     my $Ptr = '';
   84:     $Ptr .= '<table border="0"><tbody>';
   85:     $Ptr .= '<tr><td align="right"><b>Select Map</b></td>'."\n";
   86:     $Ptr .= '<td align="left">';
   87:     $Ptr .= &Apache::lonhtmlcommon::MapOptions(\%cache, 'ProblemStatistics',
   88:                                                'Statistics');
   89:     $Ptr .= '</td></tr>'."\n";
   90:     $Ptr .= '<tr><td align="right"><b>Sorting Type:</b></td>'."\n";
   91:     $Ptr .= '<td align="left">'."\n";
   92:     $Ptr .= &Apache::lonhtmlcommon::AscendOrderOptions(
   93:                                             $cache{'ProblemStatisticsAscend'}, 
   94:                                             'ProblemStatistics',
   95:                                             'Statistics');
   96:     $Ptr .= '</td></tr>'."\n";
   97:     $Ptr .= '<tr><td align="right"><b>Select Sections</b>';
   98:     $Ptr .= '</td>'."\n";
   99:     $Ptr .= '<td align="left">'."\n";
  100:     my @sections = split(':',$cache{'sectionList'});
  101:     $Ptr .= &Apache::lonhtmlcommon::MultipleSectionSelect(\@sections,
  102:                                                           \@sectionsSelected,
  103:                                                           'Statistics');
  104:     $Ptr .= '</td></tr>'."\n";
  105:     $Ptr .= &ProblemStatisticsButtons($cache{'DisplayFormat'}, 
  106:                                       $cache{'DisplayLegend'});
  107:     $Ptr .= '</table>';
  108:     if($cache{'DisplayLegend'} eq 'Show Legend') {
  109:         $Ptr .= &ProblemStatisticsLegend();
  110:     }
  111:     $r->print($Ptr);
  112:     $r->rflush();
  113: 
  114:     my @Header = ("Homework Sets Order","#Stdnts","Tries","Mod",
  115:                   "Mean","#YES","#yes","%Wrng","DoDiff",
  116:                   "S.D.","Skew.","D.F.1st","D.F.2nd","Disc.");
  117:     my $color=&setbgcolor(0);
  118: 
  119: #    my %Discuss=&Apache::loncoursedata::LoadDiscussion($courseID);
  120:     my $lastStatus = (defined($cache{'StatisticsLastStatus'})) ?
  121:                      $cache{'StatisticsLastStatus'} : 'Nothing';
  122:     my $whichStudents = join(':::',sort(@$students));
  123:     if(!defined($cache{'StatisticsCached'}) || 
  124:        $lastStatus ne $cache{'Status'} ||
  125:        $whichStudents ne $cache{'StatisticsWhichStudents'}) {
  126:         if(defined($cache{'StatisticsCached'})) {
  127:             untie(%cache);
  128:             unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
  129:                 $r->print('Unable to tie database.');
  130:                 return;
  131:             }
  132:             my @statkeys = split(':::', $cache{'StatisticsKeys'});
  133:             delete $cache{'StatisticsKeys'};
  134:             delete $cache{'StatisticsCached'};
  135:             foreach(@statkeys) {
  136:                 delete $cache{$_};
  137:             }
  138:         }
  139:         untie(%cache);
  140:         &Apache::loncoursedata::DownloadStudentCourseDataSeparate($students,
  141:                                                                   'true',
  142:                                                                   $cacheDB,
  143:                                                                   'true', 
  144:                                                                   'true',
  145:                                                                   $courseID,
  146:                                                                   $r, $c);
  147:         if($c->aborted()) { return; }
  148: 
  149:         unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
  150:             $r->print('Unable to tie database.');
  151:             return;
  152:         }
  153:         my ($problemData) = &ExtractStudentData(\%cache, $students);
  154:         &CalculateStatistics($problemData, \%cache);
  155:         untie(%cache);
  156: 
  157:         unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
  158:             $r->print('Unable to tie database.');
  159:             return;
  160:         }
  161:         foreach(keys(%$problemData)) {
  162:             $cache{$_} = $problemData->{$_};
  163:         }
  164:         $cache{'StatisticsKeys'} = join(':::', keys(%$problemData));
  165:         $cache{'StatisticsCached'} = 'true';
  166:         $cache{'StatisticsLastStatus'} = $cache{'Status'};
  167:         $cache{'StatisticsWhichStudents'} = $whichStudents;
  168:         untie(%cache);
  169: 
  170:         unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
  171:             $r->print('Unable to tie database.');
  172:             return;
  173:         }
  174:     }
  175: 
  176:     my $orderedProblems = &SortProblems(\%cache, 
  177:                                         $cache{'ProblemStatisticsSort'},
  178:                                         $cache{'ProblemStatisticsAscend'});
  179:     &BuildStatisticsTable(\%cache, $cache{'DisplayFormat'}, $orderedProblems, 
  180:                           \@Header, $r, $color);
  181:     untie(%cache);
  182: 
  183:     return;
  184: }
  185: 
  186: sub BuildGraphicChart {
  187:     my ($graph,$cacheDB,$courseDescription,$r)=@_;
  188:     my %cache;
  189:     my $max = 0;
  190: 
  191:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
  192:         return '<html><body>Unable to tie database.</body></html>';
  193:     }
  194:    
  195:     my @problems = split(':::', $cache{'problemList'});
  196:     my @values = ();
  197:     foreach (@problems) {
  198:         my $data = 0;
  199:         if($graph eq 'DoDiffGraph') {
  200:             $data = sprintf("%.2f", $cache{$_.':degreeOfDifficulty'}),
  201:         } else {
  202:             $data = sprintf("%.1f", $cache{$_.':percentWrong'}),
  203:         }
  204:         if($max < $data) {
  205:             $max = $data;
  206:         }
  207:         push(@values, $data);
  208:     }
  209:     untie(%cache);
  210: 
  211:     my $sendValues = join(',', @values);
  212:     my $sendCount = scalar(@values);
  213: 
  214:     my $title = '';
  215:     if($graph eq 'DoDiffGraph') {
  216: 	$title = 'Degree-of-Difficulty';
  217:     } else {
  218: 	$title = 'Wrong-Percentage';
  219:     }
  220:     my @GData = ($courseDescription, 'Problems', $title, $max, $sendCount, 
  221:                  $sendValues);
  222: 
  223:     $r->print('</form>'."\n");
  224:     $r->print('<IMG src="/cgi-bin/graph.gif?'.(join('&', @GData)).'" border="1" />');
  225:     $r->print('<form>'."\n");
  226: 
  227:     return;
  228: }
  229: 
  230: #---- Problem Statistics Web Page ---------------------------------------
  231: 
  232: sub CreateProblemStatisticsTableHeading {
  233:     my ($headings,$r)=@_;
  234: 
  235:     my $Str='';
  236:     $Str .= '<tr>'."\n";
  237:     $Str .= '<th bgcolor="#ffffe6">P#</th>'."\n";
  238:     foreach(@$headings) {
  239: 	$Str .= '<th bgcolor="#ffffe6">'.'<a href="/adm/statistics?reportSelected=';
  240:         $Str .= &Apache::lonnet::escape('Problem Statistics');
  241:         $Str .= '&ProblemStatisticsSort=';
  242:         $Str .= &Apache::lonnet::escape($_).'">'.$_.'</a>&nbsp</th>'."\n";
  243:     }
  244:     $Str .= "\n".'</tr>'."\n";    
  245: 
  246:     return $Str;
  247: }
  248: 
  249: sub BuildStatisticsTable {
  250:     my ($cache,$displayFormat,$orderedProblems,$headings,$r,$color)=@_;
  251: 
  252: #6666666
  253: #    my $file="/home/httpd/perl/tmp/183d.txt";
  254: #    open(OUT, ">$file");
  255: #6666666
  256: ##     &Apache::lonstatistics::Create_PrgWin($r);
  257: ##777777
  258: ##    my (%Activity) = &LoadActivityLog();
  259: ##    $r->print('<script>popwin.document.popremain.remaining.value="'.
  260: ##              'Loading Discussion...";</script>');
  261: ##    my ($doDiffFile) = &LoadDoDiffFile();
  262: 
  263: ##777777
  264: ##    $Str .= &Classify($discriminantFactor, $students);
  265: 
  266:      if($displayFormat ne 'Display CSV Format') {
  267:         $r->print('<table border="0"><tr><td bgcolor="#777777">'."\n");
  268:         $r->print('<table border="0" cellpadding="3">'."\n");
  269:         $r->print(&CreateProblemStatisticsTableHeading($headings, $r));
  270:     } else {
  271:         $r->print('<br>');
  272:     }
  273: 
  274:     my $count = 1;
  275:     foreach(@$orderedProblems) {
  276:         my ($sequence,$problem,$part)=split(':', $_);
  277:         if($cache->{'StatisticsMaps'} ne 'All Maps'  &&
  278:            $cache->{'StatisticsMaps'} ne $cache->{$sequence.':title'}) {
  279:             next;
  280:         }
  281: 
  282:         my $ref = '<a href="'.$cache->{$problem.':source'}.
  283:                   '" target="_blank">'.$cache->{$problem.':title'}.'</a>';
  284: #        my $ref = $cache->{$problem.':title'};
  285:         my $title = $cache->{$problem.':title'};
  286:         my $source = 'source';
  287:         my $tableData = join('&', $ref, $title, $source,
  288:                        $cache->{$_.':studentCount'},
  289:                        $cache->{$_.':totalTries'},
  290:                        $cache->{$_.':maxTries'},
  291:                        sprintf("%.2f", $cache->{$_.':mean'}),
  292:                        $cache->{$_.':correct'},
  293:                        $cache->{$_.':correctByOverride'},
  294:                        sprintf("%.1f", $cache->{$_.':percentWrong'}),
  295:                        sprintf("%.2f", $cache->{$_.':degreeOfDifficulty'}),
  296:                        sprintf("%.1f", $cache->{$_.':standardDeviation'}),
  297:                        sprintf("%.1f", $cache->{$_.':skewness'}),
  298:                        sprintf("%.2f", $cache->{$_.':discriminationFactor1'}),
  299:                        sprintf("%.2f", $cache->{$_.':discriminationFactor2'}),
  300:                        0); # 0 is for discussion, need to figure out
  301: 
  302:         &TableRow($displayFormat,$tableData,$count,$r,$color);
  303:         $count++;
  304:     }
  305:     if($cache->{'DisplayFormat'} ne 'Display CSV Format') {
  306:         $r->print('</table>'."\n");
  307:     }
  308:     $r->print('</td></tr></table>');
  309: #6666666
  310: #	    $r->print('<br>'.$out.'&'.$DoD);
  311: #            print (OUT $out.'@'.$DoD.'&');
  312: #6666666
  313: 
  314: #6666666
  315: #    close( OUT );
  316: #666666
  317:     return;
  318: }
  319: 
  320: sub TableRow {
  321:     my ($displayFormat,$Str,$RealIdx,$r,$color)=@_;
  322:     my($ref,$title,$source,$StdNo,$TotalTries,$MxTries,$Avg,$YES,$Override,
  323:        $Wrng,$DoD,$SD,$Sk,$_D1,$_D2,$DiscNo,$Prob)=split(/\&/,$Str);	
  324:     my $Ptr;
  325:     if($displayFormat eq 'Display CSV Format') {
  326:         $Ptr="\n".'<br>'.
  327:              "\n".'"'.$RealIdx.'",'.
  328:              "\n".'"'.$title.'",'.
  329:              "\n".'"'.$source.'",'.
  330:              "\n".'"'.$StdNo.'",'.
  331:              "\n".'"'.$TotalTries.'",'.
  332:              "\n".'"'.$MxTries.'",'.
  333:              "\n".'"'.$Avg.'",'.
  334:              "\n".'"'.$YES.'",'.
  335:              "\n".'"'.$Override.'",'.
  336:              "\n".'"'.$Wrng.'",'.
  337:              "\n".'"'.$DoD.'",'.
  338:              "\n".'"'.$SD.'",'.
  339:              "\n".'"'.$Sk.'",'.
  340:              "\n".'"'.$_D1.'",'.
  341: 	     "\n".'"'.$_D2.'"'.
  342: 	     "\n".'"'.$DiscNo.'"';
  343: 
  344:         $r->print("\n".$Ptr);
  345:     } else {
  346:         $Ptr="\n".'<tr>'.
  347:              "\n".'<td bgcolor="#ffffe6">'.$RealIdx.'</td>'.
  348:              "\n".'<td bgcolor="#ffffe6">'.$ref.'</td>'.
  349:              "\n".'<td bgcolor='.$color->{"yellow"}.'> '.$StdNo.'</td>'.
  350:              "\n".'<td bgcolor='.$color->{"yellow"}.'>'.$TotalTries.'</td>'.
  351:              "\n".'<td bgcolor='.$color->{"yellow"}.'>'.$MxTries.'</td>'.
  352:              "\n".'<td bgcolor='.$color->{"gb"}.'>'.$Avg.'</td>'.
  353:              "\n".'<td bgcolor='.$color->{"gb"}.'> '.$YES.'</td>'.
  354:              "\n".'<td bgcolor='.$color->{"gb"}.'> '.$Override.'</td>'.
  355:              "\n".'<td bgcolor='.$color->{"red"}.'> '.$Wrng.'</td>'.
  356:              "\n".'<td bgcolor='.$color->{"red"}.'> '.$DoD.'</td>'.
  357:              "\n".'<td bgcolor='.$color->{"green"}.'> '.$SD.'</td>'.
  358:              "\n".'<td bgcolor='.$color->{"green"}.'> '.$Sk.'</td>'.
  359:              "\n".'<td bgcolor='.$color->{"purple"}.'> '.$_D1.'</td>'.
  360: 	     "\n".'<td bgcolor='.$color->{"purple"}.'> '.$_D2.'</td>'.
  361:              "\n".'<td bgcolor='.$color->{"yellow"}.'> '.$DiscNo.'</td>';
  362:         $r->print("\n".$Ptr.'</tr>' );
  363:     }
  364: 
  365:     return;
  366: }
  367: 
  368: # For loading the colored table for display or un-colored for print
  369: sub setbgcolor {
  370:     my $PrintTable=shift;
  371:     my %color;
  372:     if ($PrintTable){
  373: 	$color{"gb"}="#FFFFFF";
  374: 	$color{"red"}="#FFFFFF";
  375: 	$color{"yellow"}="#FFFFFF";
  376: 	$color{"green"}="#FFFFFF";
  377: 	$color{"purple"}="#FFFFFF";
  378:     } else {
  379: 	$color{"gb"}="#DDFFFF";
  380: 	$color{"red"}="#FFDDDD";
  381: 	$color{"yellow"}="#EEFFCC";
  382: 	$color{"green"}="#DDFFDD";
  383: 	$color{"purple"}="#FFDDFF";
  384:     }
  385: 
  386:     return \%color;
  387: }
  388: 
  389: sub ProblemStatisticsButtons {
  390:     my ($displayFormat, $displayLegend)=@_;
  391: 
  392:     my $Ptr = '<tr><td></td><td align="left">';
  393:     $Ptr .= '<input type="submit" name="DoDiffGraph" ';
  394:     $Ptr .= 'value="DoDiff Graph" />'."\n";
  395:     $Ptr .= '&nbsp;&nbsp;&nbsp;';
  396:     $Ptr .= '<input type="submit" name="PercentWrongGraph" ';
  397:     $Ptr .= 'value="%Wrong Graph" />'."\n";
  398:     $Ptr .= '</td></tr><tr><td></td><td>'."\n";
  399:     $Ptr .= '<input type="submit" name="DisplayLegend" ';
  400:     if($displayLegend eq 'Show Legend') {
  401:         $Ptr .= 'value="Hide Legend" />'."\n";
  402:     } else {
  403:         $Ptr .= 'value="Show Legend" />'."\n";
  404:     }
  405:     $Ptr .= '&nbsp;&nbsp;&nbsp;';
  406:     $Ptr .= '<input type="submit" name="DisplayCSVFormat" ';
  407:     if($displayFormat eq 'Display CSV Format') {
  408:         $Ptr .= 'value="Display Table Format" />'."\n";
  409:     } else {
  410:         $Ptr .= 'value="Display CSV Format" />'."\n";
  411:     }
  412:     $Ptr .= '</td></tr>';
  413: 
  414:     return $Ptr;
  415: }
  416: 
  417: sub ProblemStatisticsLegend {
  418:     my $Ptr = '';
  419:     $Ptr = '<table border="0">';
  420:     $Ptr .= '<tr><td>';
  421:     $Ptr .= '<b>#Stdnts</b></td>';
  422:     $Ptr .= '<td>Total number of students attempted the problem.';
  423:     $Ptr .= '</td></tr><tr><td>';
  424:     $Ptr .= '<b>Tries</b></td>';
  425:     $Ptr .= '<td>Total number of tries for solving the problem.';
  426:     $Ptr .= '</td></tr><tr><td>';
  427:     $Ptr .= '<b>Mod</b></td>';
  428:     $Ptr .= '<td>Largest number of tries for solving the problem by a student.';
  429:     $Ptr .= '</td></tr><tr><td>';
  430:     $Ptr .= '<b>Mean</b></td>';
  431:     $Ptr .= '<td>Average number of tries. [ Tries / #Stdnts ]';
  432:     $Ptr .= '</td></tr><tr><td>';
  433:     $Ptr .= '<b>#YES</b></td>';
  434:     $Ptr .= '<td>Number of students solved the problem correctly.';
  435:     $Ptr .= '</td></tr><tr><td>';
  436:     $Ptr .= '<b>#yes</b></td>';
  437:     $Ptr .= '<td>Number of students solved the problem by override.';
  438:     $Ptr .= '</td></tr><tr><td>';
  439:     $Ptr .= '<b>%Wrong</b></td>';
  440:     $Ptr .= '<td>Percentage of students who tried to solve the problem ';
  441:     $Ptr .= 'but is still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ]';
  442:     $Ptr .= '</td></tr><tr><td>';
  443:     $Ptr .= '<b>DoDiff</b></td>';
  444:     $Ptr .= '<td>Degree of Difficulty of the problem.  ';
  445:     $Ptr .= '[ 1 - ((#YES+#yes) / Tries) ]';
  446:     $Ptr .= '</td></tr><tr><td>';
  447:     $Ptr .= '<b>S.D.</b></td>';
  448:     $Ptr .= '<td>Standard Deviation of the tries.  ';
  449:     $Ptr .= '[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1) ';
  450:     $Ptr .= 'where Xi denotes every student\'s tries ]';
  451:     $Ptr .= '</td></tr><tr><td>';
  452:     $Ptr .= '<b>Skew.</b></td>';
  453:     $Ptr .= '<td>Skewness of the students tries.';
  454:     $Ptr .= '[(sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3)]';
  455:     $Ptr .= '</td></tr><tr><td>';
  456:     $Ptr .= '<b>Dis.F.</b></td>';
  457:     $Ptr .= '<td>Discrimination Factor: A Standard for evaluating the ';
  458:     $Ptr .= 'problem according to a Criterion<br>';
  459:     $Ptr .= '<b>[Applied Criterion in %27 Upper Students - ';
  460:     $Ptr .= 'Applied the same Criterion in %27 Lower Students]</b><br>';
  461:     $Ptr .= '<b>1st Criterion</b> for Sorting the Students: ';
  462:     $Ptr .= '<b>Sum of Partial Credit Awarded / Total Number of Tries</b><br>';
  463:     $Ptr .= '<b>2nd Criterion</b> for Sorting the Students: ';
  464:     $Ptr .= '<b>Total number of Correct Answers / Total Number of Tries</b>';
  465:     $Ptr .= '</td></tr>';
  466:     $Ptr .= '<tr><td><b>Disc.</b></td>';
  467:     $Ptr .= '<td>Number of Students had at least one discussion.';
  468:     $Ptr .= '</td></tr></table>';
  469: 
  470:     return $Ptr;
  471: }
  472: 
  473: #------- Processing upperlist and lowerlist according to each problem
  474: 
  475: sub ExtractStudentData {
  476:     my ($cache, $students)=@_;
  477: 
  478: #$Apache::lonxml::debug=1;
  479: #&Apache::lonhomework::showhash(%$cache);
  480: #$Apache::lonxml::debug=0;
  481: 
  482:     my @problemList=();
  483:     my %problemData;
  484:     foreach my $sequence (split(':', $cache->{'orderedSequences'})) {
  485:         foreach my $problemID (split(':', $cache->{$sequence.':problems'})) {
  486:             foreach my $part (split(/\:/,$cache->{$sequence.':'.
  487:                                                   $problemID.
  488:                                                   ':parts'})) {
  489:                 my $id = $sequence.':'.$problemID.':'.$part;
  490:                 push(@problemList, $id);
  491:                 my $totalTries = 0;
  492:                 my $totalAwarded = 0;
  493:                 my $correct = 0;
  494:                 my $correctByOverride = 0;
  495:                 my $studentCount = 0;
  496:                 my $maxTries = 0;
  497:                 my $totalFirst = 0;
  498:                 my @studentTries=();
  499:                 foreach(@$students) {
  500:                     my $code = $cache->{"$_:$problemID:$part:code"};
  501: 
  502:                     if(defined($cache->{$_.':error'}) || $code eq ' ' ||
  503:                        $cache->{"$_:$problemID:NoVersion"} eq 'true') {
  504:                         next;
  505:                     }
  506: 
  507:                     $studentCount++;
  508:                     my $tries =  $cache->{"$_:$problemID:$part:tries"};
  509:                     if($maxTries < $tries) {
  510:                         $maxTries = $tries;
  511:                     }
  512:                     $totalTries += $tries;
  513:                     push(@studentTries, $tries);
  514: 
  515:                     my $awarded = $cache->{"$_:$problemID:$part:awarded"};
  516:                     $totalAwarded += $awarded;
  517: 
  518:                     if($code eq '*') {
  519:                         $correct++;
  520:                         if($tries == 1) {
  521:                             $totalFirst++;
  522:                         }
  523:                     } elsif($code eq '+') {
  524:                         $correctByOverride++;
  525:                     }
  526:                 }
  527: 
  528:                 $problemData{$id.':sequenceTitle'} = 
  529:                     $cache->{$sequence.':title'};
  530:                 $problemData{$id.':studentCount'} = $studentCount;
  531:                 $problemData{$id.':totalTries'} = $totalTries;
  532:                 $problemData{$id.':studentTries'} = \@studentTries;
  533:                 $problemData{$id.':totalAwarded'} = $totalAwarded;
  534:                 $problemData{$id.':correct'} = $correct;
  535:                 $problemData{$id.':correctByOverride'} = $correctByOverride;
  536:                 $problemData{$id.':wrong'} = $studentCount - 
  537:                                              ($correct + $correctByOverride);
  538:                 $problemData{$id.':maxTries'} = $maxTries;
  539:                 $problemData{$id.':totalFirst'} = $totalFirst;
  540:             }
  541:         }
  542:     }
  543: 
  544:     my @upperStudents1=();
  545:     my @lowerStudents1=();
  546:     my @upperStudents2=();
  547:     my @lowerStudents2=();
  548:     my $upperCount = int(0.27*scalar(@$students));
  549:     # Discriminant Factor criterion 1
  550:     my $sortedStudents = &SortDivideByTries($students,$cache,':totalAwarded');
  551: 
  552:     for(my $i=0; $i<$upperCount; $i++) {
  553:         push(@lowerStudents1, $sortedStudents->[$i]);
  554:         push(@upperStudents1, $sortedStudents->[(scalar(@$students)-$i-1)]);
  555:     }
  556: 
  557:     $problemData{'studentsUpperListCriterion1'}=join(':::', @upperStudents1);
  558:     $problemData{'studentsLowerListCriterion1'}=join(':::', @lowerStudents1);
  559: 
  560:     # Discriminant Factor criterion 2
  561:     $sortedStudents = &SortDivideByTries($students, $cache, ':totalSolved');
  562: 
  563:     for(my $i=0; $i<$upperCount; $i++) {
  564:         push(@lowerStudents2, $sortedStudents->[$i]);
  565:         push(@upperStudents2, $sortedStudents->[(scalar(@$students)-$i-1)]);
  566:     }
  567:     $problemData{'studentsUpperListCriterion2'}=join(':::', @upperStudents2);
  568:     $problemData{'studentsLowerListCriterion2'}=join(':::', @lowerStudents2);
  569: 
  570:     $problemData{'problemList'} = join(':::', @problemList);
  571: #                $Discussed=0;
  572: #                if($Discuss->{"$name:$problem"}) {
  573: #		    $TotDiscuss++;
  574: #                    $Discussed=1;
  575: #                }
  576: 
  577:     return \%problemData;
  578: }
  579: 
  580: sub SortDivideByTries {
  581:     my ($toSort, $data, $sortOn)=@_;
  582:     my @orderedData = sort { ($data->{$a.':totalTries'}) ? 
  583:                              ($data->{$a.$sortOn}/$data->{$a.':totalTries'}):0
  584:                              <=>
  585:                              ($data->{$b.':totalTries'}) ? 
  586:                              ($data->{$b.$sortOn}/$data->{$b.':totalTries'}):0
  587:                            } @$toSort;
  588: 
  589:     return \@orderedData;
  590: }
  591: 
  592: sub SortProblems {
  593:     my ($problemData,$sortBy,$ascend)=@_;
  594: 
  595:     my @problems = split(':::', $problemData->{'problemList'});
  596:     if($sortBy eq "Homework Sets Order") {
  597:         return \@problems;
  598:     }
  599: 
  600:     my $data;
  601: 
  602:     if   ($sortBy eq "#Stdnts") { $data = ':studentCount'; }
  603:     elsif($sortBy eq "Tries")   { $data = ':totalTries'; }
  604:     elsif($sortBy eq "Mod")     { $data = ':maxTries'; }
  605:     elsif($sortBy eq "Mean")    { $data = ':mean'; }
  606:     elsif($sortBy eq "#YES")    { $data = ':correct'; }
  607:     elsif($sortBy eq "#yes")    { $data = ':correctByOverride'; }
  608:     elsif($sortBy eq "%Wrng")   { $data = ':percentWrong'; }
  609:     elsif($sortBy eq "DoDiff")  { $data = ':degreeOfDifficulty'; }
  610:     elsif($sortBy eq "S.D.")    { $data = ':standardDeviation'; }
  611:     elsif($sortBy eq "Skew.")   { $data = ':skewness'; }
  612:     elsif($sortBy eq "D.F.1st") { $data = ':discriminantFactor1'; }
  613:     elsif($sortBy eq "D.F.2nd") { $data = ':discriminantFactor2'; }
  614:     elsif($sortBy eq "Disc.")   { $data = ''; }
  615:     else                        { return \@problems; }
  616: 
  617:     my @orderedProblems = 
  618:         sort { $problemData->{$a.$data} <=> $problemData->{$b.$data} }
  619:              @problems;
  620:     if($ascend eq 'Descending') {
  621:         @orderedProblems = reverse(@orderedProblems);
  622:     }
  623: 
  624:     return \@orderedProblems;
  625: }
  626: 
  627: sub CalculateStatistics {
  628:     my ($data, $cache)=@_;
  629: 
  630:     my @problems = split(':::', $data->{'problemList'});
  631:     foreach(@problems) {
  632:         # Mean
  633:         $data->{$_.':mean'} = ($data->{$_.':studentCount'}) ? 
  634:             ($data->{$_.':totalTries'} / $data->{$_.':studentCount'}) : 0;
  635: 
  636:         # %Wrong
  637:         $data->{$_.':percentWrong'} = ($data->{$_.':studentCount'}) ?
  638:             (($data->{$_.':wrong'} / $data->{$_.':studentCount'}) * 100.0) : 
  639:             100.0;
  640: 
  641:         # Degree of Difficulty
  642:         $data->{$_.':degreeOfDifficulty'} = ($data->{$_.':totalTries'}) ?
  643:             (1 - (($data->{$_.':correct'} + $data->{$_.':correctByOverride'}) /
  644:                   $data->{$_.':totalTries'})) : 0;
  645: 
  646:         # Factor in mean
  647:         my $studentTries = $data->{$_.':studentTries'};
  648:         foreach(my $index=0; $index < scalar(@$studentTries); $index++) {
  649:             $studentTries->[$index] -= $data->{$_.':mean'};
  650:         }
  651:         my $sumSquared = 0;
  652:         my $sumCubed = 0;
  653:         foreach(@$studentTries) {
  654:             my $squared = ($_ * $_);
  655:             my $cubed = ($squared * $_);
  656:             $sumSquared += $squared;
  657:             $sumCubed += $cubed;
  658:         }
  659: 
  660:         # Standard deviation
  661:         $data->{$_.':standardDeviation'} = ($data->{$_.':studentCount'} - 1) ?
  662:             ((sqrt($sumSquared)) / ($data->{$_.':studentCount'} - 1)) : 0;
  663: 
  664:         # Skewness
  665:         my $standardDeviation = $data->{$_.':standardDeviation'};
  666:         $data->{$_.':skewness'} = ($data->{$_.':standardDeviation'}) ?
  667:             (((sqrt($sumSquared)) / $data->{$_.':studentCount'}) / 
  668:              ($standardDeviation * $standardDeviation * $standardDeviation)) :
  669:              0;
  670: 
  671:         # Discrimination Factor 1
  672:         my ($sequence, $problem, $part) = split(':', $_);
  673: 
  674:         my @upper1 = split(':::', $data->{'studentsUpperListCriterion1'});
  675:         my @lower1 = split(':::', $data->{'studentsLowerListCriterion1'});
  676: 
  677:         my $upper1Sum=0;
  678:         foreach my $name (@upper1) {
  679:             $upper1Sum += $cache->{"$name:$problem:$part:awarded"};
  680:         }
  681:         $upper1Sum = (scalar(@upper1)) ? ($upper1Sum/(scalar(@upper1))) : 0;
  682: 
  683:         my $lower1Sum=0;
  684:         foreach my $name (@lower1) {
  685:             $lower1Sum += $cache->{"$name:$problem:$part:awarded"};
  686:         }
  687:         $lower1Sum = (scalar(@lower1)) ? ($lower1Sum/(scalar(@lower1))) : 0;
  688: 
  689:         $data->{$_.':discriminationFactor1'} = $upper1Sum - $lower1Sum;
  690: 
  691:         # Discrimination Factor 2
  692:         my @upper2 = split(':::', $data->{'studentsUpperListCriterion2'});
  693:         my @lower2 = split(':::', $data->{'studentsLowerListCriterion2'});
  694: 
  695:         my $upper2Sum=0;
  696:         foreach my $name (@upper2) {
  697:             $upper2Sum += $cache->{"$name:$problem:$part:awarded"};
  698:         }
  699:         $upper2Sum = (scalar(@upper2)) ? ($upper2Sum/(scalar(@upper2))) : 0;
  700: 
  701:         my $lower2Sum=0;
  702:         foreach my $name (@lower2) {
  703:             $lower2Sum += $cache->{"$name:$problem:$part:awarded"};
  704:         }
  705:         $lower2Sum = (scalar(@lower2)) ? ($lower2Sum/(scalar(@lower2))) : 0;
  706: 
  707:         $data->{$_.':discriminationFactor2'} = $upper2Sum - $lower2Sum;
  708:     }
  709: 
  710:     return;
  711: }
  712: 
  713: #---- END Problem Statistics Web Page ----------------------------------------
  714: 
  715: 1;
  716: __END__

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