File:  [LON-CAPA] / loncom / interface / statistics / lonproblemanalysis.pm
Revision 1.43: download - view: text, annotated - select for diffs
Mon Oct 20 20:42:39 2003 UTC (20 years, 9 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Excel output for optionresponse analysis.

loncoursedata.pm:
Added &get_student_data.
Modified return values of get_optionresionse_data it now logs errors and
(on error) no longer returns a reference to useless data.

lonproblemanalysis.pm:
Added 'Produce Excel Data Sheet' button.  Wording will probably change, as
will page which presents the spreadsheet for download.
Added a bunch of routines associated with excel output, including two
routines 'calc_serial' and '_adjustment' copied from Andrew Benham's
datecalc1.pl, part of the Spreadsheet::WriteExcel CPAN module (GPL).
Read through some of the comments on these to learn a little about date
handling in Excel.

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lonproblemanalysis.pm,v 1.43 2003/10/20 20:42:39 matthew Exp $
    4: #
    5: # Copyright Michigan State University Board of Trustees
    6: #
    7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    8: #
    9: # LON-CAPA is free software; you can redistribute it and/or modify
   10: # it under the terms of the GNU General Public License as published by
   11: # the Free Software Foundation; either version 2 of the License, or
   12: # (at your option) any later version.
   13: #
   14: # LON-CAPA is distributed in the hope that it will be useful,
   15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17: # GNU General Public License for more details.
   18: #
   19: # You should have received a copy of the GNU General Public License
   20: # along with LON-CAPA; if not, write to the Free Software
   21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22: #
   23: # /home/httpd/html/adm/gpl.txt
   24: #
   25: # http://www.lon-capa.org/
   26: #
   27: 
   28: package Apache::lonproblemanalysis;
   29: 
   30: use strict;
   31: use Apache::lonnet();
   32: use Apache::loncommon();
   33: use Apache::lonhtmlcommon();
   34: use Apache::loncoursedata();
   35: use Apache::lonstatistics;
   36: use Apache::lonlocal;
   37: use HTML::Entities();
   38: use Time::Local();
   39: use Spreadsheet::WriteExcel();
   40: 
   41: my $plotcolors = ['#33ff00', 
   42:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
   43:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
   44:                   ]; 
   45: 
   46: sub BuildProblemAnalysisPage {
   47:     my ($r,$c)=@_;
   48:     $r->print('<h2>'.&mt('Option Response Problem Analysis').'</h2>');
   49:     $r->print(&CreateInterface());
   50:     #
   51:     my @Students = @Apache::lonstatistics::Students;
   52:     #
   53:     if (exists($ENV{'form.ClearCache'}) || 
   54:         exists($ENV{'form.updatecaches'}) ||
   55:         (exists($ENV{'form.firstanalysis'}) &&
   56:          $ENV{'form.firstanalysis'} ne 'no')) {
   57:         &Apache::lonstatistics::Gather_Full_Student_Data($r);
   58:     }
   59:     if (! exists($ENV{'form.firstanalysis'})) {
   60:         $r->print('<input type="hidden" name="firstanalysis" value="yes" />');
   61:     } else {
   62:         $r->print('<input type="hidden" name="firstanalysis" value="no" />');
   63:     }
   64:     $r->rflush();
   65:     if (exists($ENV{'form.problemchoice'}) && 
   66:         ! exists($ENV{'form.SelectAnother'})) {
   67:         $r->print('<input type="submit" name="ProblemAnalysis" value="'.
   68:                   &mt('Analyze Problem Again').'" />');
   69:         $r->print('&nbsp;'x5);
   70:         $r->print('<input type="submit" name="ClearCache" value="'.
   71:                   &mt('Clear Caches').'" />');
   72:         $r->print('&nbsp;'x5);
   73:         $r->print('<input type="submit" name="updatecaches" value="'.
   74:                   &mt('Update Student Data').'" />');
   75:         $r->print('&nbsp;'x5);
   76:         $r->print('<input type="hidden" name="problemchoice" value="'.
   77:                   $ENV{'form.problemchoice'}.'" />');
   78:         $r->print('<input type="submit" name="SelectAnother" value="'.
   79:                   &mt('Choose a different resource').'" />');
   80:         $r->print('&nbsp;'x5);
   81:         $r->print('<input type="submit" name="ExcelOutput" value="'.
   82:                   &mt('Produce Excel Data Sheet').'" />');
   83:         $r->print('&nbsp;'x5);
   84:         #
   85:         $r->print('<hr />');
   86:         #
   87:         my ($symb,$part,$resid) = &get_problem_symb(
   88:                      &Apache::lonnet::unescape($ENV{'form.problemchoice'})
   89:                                            );
   90:         $r->rflush();
   91:         #
   92:         my $resource = &get_resource_from_symb($symb);
   93:         if (defined($resource)) {
   94:             $r->print('<h3>'.$resource->{'src'}.'</h3>');
   95:             my %Data = &get_problem_data($resource->{'src'});
   96:             my $PerformanceData = 
   97:                 &Apache::loncoursedata::get_optionresponse_data
   98:                                            (\@Students,$symb,$resid);
   99:             my $ORdata = $Data{$part.'.'.$resid};
  100:             if (exists($ENV{'form.ExcelOutput'}) && 
  101:                 defined($PerformanceData)) {
  102:                 my $result = &prepare_excel_sheet($r,$resource,
  103:                                                   $PerformanceData,$ORdata);
  104:                 $r->print($result);
  105:                 $r->rflush();
  106:             }
  107:             ##
  108:             ## Render the problem
  109:             my $base;
  110:             ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);
  111:             $base = "http://".$ENV{'SERVER_NAME'}.$base;
  112:             my $rendered_problem = 
  113:                 &Apache::lonnet::ssi_body($resource->{'src'});
  114:             $rendered_problem =~ s/<\s*form\s*/<nop /g;
  115:             $rendered_problem =~ s|(<\s*/form\s*>)|<\/nop>|g;
  116:             $r->print('<table bgcolor="ffffff"><tr><td>'.
  117:                       '<base href="'.$base.'" />'.
  118:                       $rendered_problem.
  119:                       '</td></tr></table>');
  120:             $r->rflush();
  121:             ##
  122:             ## Analyze the problem
  123:             if (defined($PerformanceData) && 
  124:                 ref($PerformanceData) eq 'ARRAY') {
  125:                 if ($ENV{'form.AnalyzeOver'} eq 'Tries') {
  126:                     my $analysis_html = &tries_analysis($r,$PerformanceData,
  127:                                                          $ORdata);
  128:                     $r->print($analysis_html);
  129:                     $r->rflush();
  130:                 } elsif ($ENV{'form.AnalyzeOver'} eq 'Time') {
  131:                     my $analysis_html = &time_analysis($PerformanceData,
  132:                                                          $ORdata);
  133:                     $r->print($analysis_html);
  134:                     $r->rflush();
  135:                 } else {
  136:                     $r->print('<h2>'.
  137:                               &mt('The analysis you have selected is '.
  138:                                          'not supported at this time').
  139:                               '</h2>');
  140:                 }
  141:             } else {
  142:                 $r->print('<h2>'.
  143:                           &mt('There is no student data for this problem.').
  144:                           '</h2>');
  145:             }
  146:         } else {
  147:             $r->print('resource is undefined');
  148:         }
  149:         $r->print('<hr />');
  150:     } else {
  151:         $r->print('<input type="submit" name="ProblemAnalysis" value="'.
  152:                   &mt('Analyze Problem').'" />');
  153:         $r->print('&nbsp;'x5);
  154:         $r->print('<h3>'.&mt('Please select a problem to analyze').'</h3>');
  155:         $r->print(&OptionResponseProblemSelector());
  156:     }
  157: }
  158: 
  159: #########################################################
  160: #########################################################
  161: ##
  162: ##      Misc interface routines use by analysis code
  163: ##
  164: #########################################################
  165: #########################################################
  166: sub build_foil_index {
  167:     my ($ORdata) = @_;
  168:     return if (! exists($ORdata->{'Foils'}));
  169:     my %Foildata = %{$ORdata->{'Foils'}};
  170:     my @Foils = sort(keys(%Foildata));
  171:     my %Concepts;
  172:     foreach my $foilid (@Foils) {
  173:         push(@{$Concepts{$Foildata{$foilid}->{'Concept'}}},
  174:              $foilid);
  175:     }
  176:     undef(@Foils);
  177:     # Having gathered the concept information in a hash, we now translate it
  178:     # into an array because we need to be consistent about order.
  179:     # Also put the foils in order, too.
  180:     my $sortfunction = sub {
  181:         my %Numbers = (one   => 1,
  182:                        two   => 2,
  183:                        three => 3,
  184:                        four  => 4,
  185:                        five  => 5,
  186:                        six   => 6,
  187:                        seven => 7,
  188:                        eight => 8,
  189:                        nine  => 9,
  190:                        ten   => 10,);
  191:         my $a1 = lc($a); 
  192:         my $b1 = lc($b);
  193:         if (exists($Numbers{$a})) {
  194:             $a1 = $Numbers{$a};
  195:         }
  196:         if (exists($Numbers{$b})) {
  197:             $b1 = $Numbers{$b};
  198:         }
  199:         $a1 cmp $b1;
  200:     };
  201:     my @Concepts;
  202:     foreach my $concept (sort $sortfunction (keys(%Concepts))) {
  203:         push(@Concepts,{ name => $concept,
  204:                         foils => [@{$Concepts{$concept}}]});
  205:         push(@Foils,(@{$Concepts{$concept}}));
  206:     }
  207:     #
  208:     # Build up the table of row labels.
  209:     my $table = '<table border="1" >'."\n";
  210:     if (@Concepts > 1) {
  211:         $table .= '<tr>'.
  212:             '<th>'.&mt('Concept Number').'</th>'.
  213:             '<th>'.&mt('Concept').'</th>'.
  214:             '<th>'.&mt('Foil Number').'</th>'.
  215:             '<th>'.&mt('Foil Name').'</th>'.
  216:             '<th>'.&mt('Foil Text').'</th>'.
  217:             '<th>'.&mt('Correct Value').'</th>'.
  218:             "</tr>\n";
  219:     } else {
  220:         $table .= '<tr>'.
  221:             '<th>'.&mt('Foil Number').'</th>'.
  222:             '<th>'.&mt('Foil Name').'</th>'.
  223:             '<th>'.&mt('Foil Text').'</th>'.
  224:             '<th>'.&mt('Correct Value').'</th>'.
  225:             "</tr>\n";
  226:     }        
  227:     my $conceptindex = 1;
  228:     my $foilindex = 1;
  229:     foreach my $concept (@Concepts) {
  230:         my @FoilsInConcept = @{$concept->{'foils'}};
  231:         my $firstfoil = shift(@FoilsInConcept);
  232:         if (@Concepts > 1) {
  233:             $table .= '<tr>'.
  234:                 '<td>'.$conceptindex.'</td>'.
  235:                 '<td>'.$concept->{'name'}.'</td>'.
  236:                 '<td>'.$foilindex++.'</td>'.
  237:                 '<td>'.$Foildata{$firstfoil}->{'name'}.'</td>'.
  238:                 '<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.
  239:                 '<td>'.$Foildata{$firstfoil}->{'value'}.'</td>'.
  240:                 "</tr>\n";
  241:         } else {
  242:             $table .= '<tr>'.
  243:                 '<td>'.$foilindex++.'</td>'.
  244:                 '<td>'.$Foildata{$firstfoil}->{'name'}.'</td>'.
  245:                 '<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.
  246:                 '<td>'.$Foildata{$firstfoil}->{'value'}.'</td>'.
  247:                 "</tr>\n";
  248:         }
  249:         foreach my $foilid (@FoilsInConcept) {
  250:             if (@Concepts > 1) {
  251:                 $table .= '<tr>'.
  252:                     '<td></td>'.
  253:                     '<td></td>'.
  254:                     '<td>'.$foilindex.'</td>'.
  255:                     '<td>'.$Foildata{$foilid}->{'name'}.'</td>'.
  256:                     '<td>'.$Foildata{$foilid}->{'text'}.'</td>'.
  257:                     '<td>'.$Foildata{$foilid}->{'value'}.'</td>'.
  258:                     "</tr>\n";
  259:             } else {
  260:                 $table .= '<tr>'.
  261:                     '<td>'.$foilindex.'</td>'.
  262:                     '<td>'.$Foildata{$foilid}->{'name'}.'</td>'.
  263:                     '<td>'.$Foildata{$foilid}->{'text'}.'</td>'.
  264:                     '<td>'.$Foildata{$foilid}->{'value'}.'</td>'.
  265:                     "</tr>\n";
  266:             }                
  267:         } continue {
  268:             $foilindex++;
  269:         }
  270:     } continue {
  271:         $conceptindex++;
  272:     }
  273:     $table .= "</table>\n";
  274:     #
  275:     # Build option index with color stuff
  276:     return ($table,\@Foils,\@Concepts);
  277: }
  278: 
  279: sub build_option_index {
  280:     my ($ORdata)= @_;
  281:     my $table = "<table>\n";
  282:     my $optionindex = 0;
  283:     my @Rows;
  284:     foreach my $option (&mt('correct option chosen'),@{$ORdata->{'Options'}}) {
  285:         push (@Rows,
  286:               '<tr>'.
  287:               '<td bgcolor="'.$plotcolors->[$optionindex++].'">'.
  288:               ('&nbsp;'x4).'</td>'.
  289:               '<td>'.$option.'</td>'.
  290:               "</tr>\n");
  291:     }
  292:     shift(@Rows); # Throw away 'correct option chosen' color
  293:     $table .= join('',reverse(@Rows));
  294:     $table .= "</table>\n";
  295: }
  296: 
  297: #########################################################
  298: #########################################################
  299: ##
  300: ##         Tries Analysis
  301: ##
  302: #########################################################
  303: #########################################################
  304: sub tries_analysis {
  305:     my ($r,$PerformanceData,$ORdata) = @_;
  306:     my $mintries = 1;
  307:     my $maxtries = $ENV{'form.NumPlots'};
  308:     my ($table,$Foils,$Concepts) = &build_foil_index($ORdata);
  309:     if ((@$Concepts < 2) && ($ENV{'form.AnalyzeAs'} ne 'Foils')) {
  310:         $table = '<h3>'.
  311:             &mt('Not enough data for concept analysis.  '.
  312:                 'Performing Foil Analysis').
  313:             '</h3>'.$table;
  314:         $ENV{'form.AnalyzeAs'} = 'Foils';
  315:     }
  316:     my %ResponseData = &analyze_option_data_by_tries($r,$PerformanceData,
  317:                                                      $mintries,$maxtries);
  318:     my $analysis = '';
  319:     if ($ENV{'form.AnalyzeAs'} eq 'Foils') {
  320:         $analysis = &Tries_Foil_Analysis($mintries,$maxtries,$Foils,
  321:                                          \%ResponseData,$ORdata);
  322:     } else {
  323:         $analysis = &Tries_Concept_Analysis($mintries,$maxtries,
  324:                                             $Concepts,\%ResponseData,$ORdata);
  325:     }
  326:     $table .= $analysis;
  327:     return $table;
  328: }
  329: 
  330: sub Tries_Foil_Analysis {
  331:     my ($mintries,$maxtries,$Foils,$respdat,$ORdata) = @_;
  332:     my %ResponseData = %$respdat;
  333:     #
  334:     # Compute the data neccessary to make the plots
  335:     my @PlotData; 
  336:     foreach my $foilid (@$Foils) {
  337:         for (my $i=$mintries;$i<=$maxtries;$i++) {
  338:             if ($ResponseData{$foilid}->[$i]->{'_total'} == 0) {
  339:                 push(@{$PlotData[$i]->{'_correct'}},0);
  340:             } else {
  341:                 push(@{$PlotData[$i]->{'_correct'}},
  342:                      100*$ResponseData{$foilid}->[$i]->{'_correct'}/
  343:                      $ResponseData{$foilid}->[$i]->{'_total'});
  344:             }
  345:             foreach my $option (@{$ORdata->{'Options'}}) {
  346:                 push(@{$PlotData[$i]->{'_total'}},
  347:                      $ResponseData{$foilid}->[$i]->{'_total'});
  348:                 if ($ResponseData{$foilid}->[$i]->{'_total'} == 0) {
  349:                     push (@{$PlotData[$i]->{$option}},0);
  350:                 } else {
  351:                     if ($ResponseData{$foilid}->[$i]->{'_total'} ==
  352:                         $ResponseData{$foilid}->[$i]->{'_correct'}) {
  353:                         push(@{$PlotData[$i]->{$option}},0);
  354:                     } else {
  355:                         push (@{$PlotData[$i]->{$option}},
  356:                               100 * $ResponseData{$foilid}->[$i]->{$option} / 
  357:                               ($ResponseData{$foilid}->[$i]->{'_total'} - 
  358:                                $ResponseData{$foilid}->[$i]->{'_correct'}));
  359:                     }
  360:                 }
  361:             }
  362:         }
  363:     }
  364:     # 
  365:     # Build a table for the plots
  366:     my $analysis_html = "<table>\n";
  367:     my $foilkey = &build_option_index($ORdata);
  368:     for (my $i=$mintries;$i<=$maxtries;$i++) {
  369:         my $count = $ResponseData{'_total'}->[$i];
  370:         if ($count == 0) {
  371:             $count = 'no submissions';
  372:         } elsif ($count == 1) {
  373:             $count = '1 submission';
  374:         } else {
  375:             $count = $count.' submissions';
  376:         }
  377:         my $title = 'Attempt '.$i.', '.$count;
  378:         my @Datasets;
  379:         foreach my $option ('_correct',@{$ORdata->{'Options'}}) {
  380:             next if (! exists($PlotData[$i]->{$option}));
  381:             push(@Datasets,$PlotData[$i]->{$option});
  382:         }
  383:         my $correctgraph = &Apache::loncommon::DrawGraph
  384:             ($title,'Foil Number','Percent Correct',
  385:              100,$plotcolors,$Datasets[0]);
  386:         $analysis_html.= '<tr><td>'.$correctgraph.'</td>';
  387:         ##
  388:         ##
  389:         for (my $i=0; $i< scalar(@{$Datasets[0]});$i++) {
  390:             $Datasets[0]->[$i]=0;
  391:         }
  392:         $count = $ResponseData{'_total'}->[$i]-$ResponseData{'_correct'}->[$i];
  393:         if ($count == 0) {
  394:             $count = 'no submissions';
  395:         } elsif ($count == 1) {
  396:             $count = '1 submission';
  397:         } else {
  398:             $count = $count.' submissions';
  399:         }
  400:         $title = 'Attempt '.$i.', '.$count;
  401:         my $incorrectgraph = &Apache::loncommon::DrawGraph
  402:             ($title,'Foil Number','% Option Chosen Incorrectly',
  403:              100,$plotcolors,@Datasets);
  404:         $analysis_html.= '<td>'.$incorrectgraph.'</td>';
  405:         $analysis_html.= '<td>'.$foilkey."<td></tr>\n";
  406:     }
  407:     $analysis_html .= "</table>\n";
  408:     return $analysis_html;
  409: }
  410: 
  411: sub Tries_Concept_Analysis {
  412:     my ($mintries,$maxtries,$Concepts,$respdat,$ORdata) = @_;
  413:     my %ResponseData = %$respdat;
  414:     my $analysis_html = "<table>\n";
  415:     #
  416:     # Compute the data neccessary to make the plots
  417:     my @PlotData;
  418:     # Concept analysis
  419:     #
  420:     # Note: we do not bother with characterizing the students incorrect
  421:     # answers at the concept level because an incorrect answer for one foil
  422:     # may be a correct answer for another foil.
  423:     my %ConceptData;
  424:     foreach my $concept (@{$Concepts}) {
  425:         for (my $i=$mintries;$i<=$maxtries;$i++) {
  426:             #
  427:             # Gather the per-attempt data
  428:             my $cdata = $ConceptData{$concept}->[$i];
  429:             foreach my $foilid (@{$concept->{'foils'}}) {
  430:                 $cdata->{'_correct'} += 
  431:                     $ResponseData{$foilid}->[$i]->{'_correct'};
  432:                 $cdata->{'_total'}   += 
  433:                     $ResponseData{$foilid}->[$i]->{'_total'};
  434:             }
  435:             push (@{$PlotData[$i]->{'_total'}},$cdata->{'_total'});
  436:             if ($cdata->{'_total'} == 0) {
  437:                 push (@{$PlotData[$i]->{'_correct'}},0);
  438:             } else {
  439:                 push (@{$PlotData[$i]->{'_correct'}},
  440:                       100*$cdata->{'_correct'}/$cdata->{'_total'});
  441:                 }
  442:         }
  443:     }
  444:     # Build a table for the plots
  445:     for (my $i=$mintries;$i<=$maxtries;$i++) {
  446:         my $minstu = $PlotData[$i]->{'_total'}->[0];
  447:         my $maxstu = $PlotData[$i]->{'_total'}->[0];
  448:         foreach my $count (@{$PlotData[$i]->{'_total'}}) {
  449:             if ($minstu > $count) {
  450:                 $minstu = $count;
  451:             }
  452:             if ($maxstu < $count) {
  453:                 $maxstu = $count;
  454:             }
  455:         }
  456:         $maxstu = 0 if (! defined($maxstu));
  457:         $minstu = 0 if (! defined($minstu));
  458:         my $title;
  459:         my $count = $ResponseData{'_total'}->[$i];
  460:         if ($count == 0) {
  461:             $count = 'no submissions';
  462:         } elsif ($count == 1) {
  463:             $count = '1 submission';
  464:         } else {
  465:             $count = $count.' submissions';
  466:         }
  467:         $title = 'Attempt '.$i.', '.$count;
  468:         my $graphlink = &Apache::loncommon::DrawGraph
  469:             ($title,'Concept Number','Percent Correct',
  470:              100,$plotcolors,$PlotData[$i]->{'_correct'});
  471:         $analysis_html.= '<tr><td>'.$graphlink."</td></tr>\n";
  472:     }
  473:     $analysis_html .= "</table>\n";
  474:     return $analysis_html;
  475: }
  476: 
  477: sub analyze_option_data_by_tries {
  478:     my ($r,$PerformanceData,$mintries,$maxtries) = @_;
  479:     my %Trydata;
  480:     $mintries = 1         if (! defined($mintries) || $mintries < 1);
  481:     $maxtries = $mintries if (! defined($maxtries) || $maxtries < $mintries);
  482:     foreach my $row (@$PerformanceData) {
  483:         next if (! defined($row));
  484:         my $tries = &get_tries_from_row($row);
  485:         my %Row   = &Process_Row($row);
  486:         next if (! %Row);
  487:         while (my ($foilid,$href) = each(%Row)) {
  488:             if (! ref($href)) { 
  489:                 $Trydata{$foilid}->[$tries] += $href;
  490:                 next;
  491:             }
  492:             while (my ($option,$value) = each(%$href)) {
  493:                 $Trydata{$foilid}->[$tries]->{$option}+=$value;
  494:             }
  495:         }
  496:     }
  497:     return %Trydata;
  498: }
  499: 
  500: #########################################################
  501: #########################################################
  502: ##
  503: ##                 Time Analysis
  504: ##
  505: #########################################################
  506: #########################################################
  507: sub time_analysis {
  508:     my ($PerformanceData,$ORdata) = @_;
  509:     my ($table,$Foils,$Concepts) = &build_foil_index($ORdata);
  510:     if ((@$Concepts < 2) && ($ENV{'form.AnalyzeAs'} ne 'Foils')) {
  511:         $table = '<h3>'.
  512:             &mt('Not enough data for concept analysis.  '.
  513:                 'Performing Foil Analysis').
  514:             '</h3>'.$table;
  515:         $ENV{'form.AnalyzeAs'} = 'Foils';
  516:     }
  517:     my $num_plots = $ENV{'form.NumPlots'};
  518:     my $num_data = scalar(@$PerformanceData)-1;
  519:     my $percent = sprintf('%2f',100/$num_plots);
  520:     #
  521:     $table .= "<table>\n";
  522:     for (my $i=0;$i<$num_plots;$i++) {
  523:         ##
  524:         my $starttime = &Apache::lonhtmlcommon::get_date_from_form
  525:             ('startdate_'.$i);
  526:         my $endtime = &Apache::lonhtmlcommon::get_date_from_form
  527:             ('enddate_'.$i);
  528:         if (! defined($starttime) || ! defined($endtime)) {
  529:             my $sec_in_day = 86400;
  530:             my $last_sub_time = &get_time_from_row($PerformanceData->[-1]);
  531:             my ($sday,$smon,$syear);
  532:             (undef,undef,undef,$sday,$smon,$syear) = 
  533:                 localtime($last_sub_time - $sec_in_day*$i);
  534:             $starttime = &Time::Local::timelocal(0,0,0,$sday,$smon,$syear);
  535:             $endtime = $starttime + $sec_in_day;
  536:             if ($i == ($num_plots -1 )) {
  537:                 $starttime = &get_time_from_row($PerformanceData->[0]);
  538:             }
  539:         }
  540:         my $startdateform = &Apache::lonhtmlcommon::date_setter
  541:             ('Statistics','startdate_'.$i,$starttime);
  542:         my $enddateform = &Apache::lonhtmlcommon::date_setter
  543:             ('Statistics','enddate_'.$i,$endtime);
  544:         #
  545:         my $begin_index;
  546:         my $end_index;
  547:         my $j;
  548:         while (++$j < scalar(@$PerformanceData)) {
  549:             last if (&get_time_from_row($PerformanceData->[$j]) > $starttime);
  550:         }
  551:         $begin_index = $j;
  552:         while (++$j < scalar(@$PerformanceData)) {
  553:             last if (&get_time_from_row($PerformanceData->[$j]) > $endtime);
  554:         }
  555:         $end_index = $j;
  556:         ##
  557:         my $interval = {
  558:             begin_index => $begin_index,
  559:             end_index   => $end_index,
  560:             startdateform => $startdateform,
  561:             enddateform   => $enddateform,
  562:         };
  563:         if ($ENV{'form.AnalyzeAs'} eq 'Foils') {
  564:             $table .= &Foil_Time_Analysis($PerformanceData,$ORdata,$Foils,
  565:                                           $interval);
  566:         } else {
  567:             $table .= &Concept_Time_Analysis($PerformanceData,$ORdata,
  568:                                              $Concepts,$interval);
  569:         }
  570:     }
  571:     #
  572:     return $table;
  573: }
  574: 
  575: sub Foil_Time_Analysis {
  576:     my ($PerformanceData,$ORdata,$Foils,$interval) = @_;
  577:     my $analysis_html;
  578:     my $foilkey = &build_option_index($ORdata);
  579:     my ($begin_index,$end_index) = ($interval->{'begin_index'},
  580:                                     $interval->{'end_index'});
  581:     my %TimeData;
  582:     #
  583:     # Compute the number getting the foils correct or incorrects
  584:     for (my $j=$begin_index;$j<=$end_index;$j++) {
  585:         my $row = $PerformanceData->[$j];
  586:         next if (! defined($row));
  587:         my %Row = &Process_Row($row);
  588:         while (my ($foilid,$href) = each(%Row)) {
  589:             if (! ref($href)) {
  590:                 $TimeData{$foilid} += $href;
  591:                 next;
  592:             }
  593:             while (my ($option,$value) = each(%$href)) {
  594:                 $TimeData{$foilid}->{$option}+=$value;
  595:             }
  596:         }
  597:     }
  598:     my @Plotdata;
  599:     foreach my $foil (@$Foils) {
  600:         my $total = $TimeData{$foil}->{'_total'};
  601:         if ($total == 0) {
  602:             push(@{$Plotdata[0]},0);
  603:         } else {
  604:             push(@{$Plotdata[0]},
  605:                  100 * $TimeData{$foil}->{'_correct'} / $total);
  606:         }
  607:         my $total_incorrect = $total - $TimeData{$foil}->{'_correct'};
  608:         my $optionidx = 1;
  609:         foreach my $option (@{$ORdata->{'Options'}}) {
  610:             if ($total_incorrect == 0) {
  611:                 push(@{$Plotdata[$optionidx]},0);
  612:             } else {
  613:                 push(@{$Plotdata[$optionidx]},
  614:                      100 * $TimeData{$foil}->{$option} / $total_incorrect);
  615:             }
  616:         } continue {
  617:             $optionidx++;
  618:         }
  619:     }
  620:     #
  621:     # Create the plot
  622:     my $count = $end_index-$begin_index;
  623:     my $title;
  624:     if ($count == 0) {
  625:         $title = 'no submissions';
  626:     } elsif ($count == 1) {
  627:         $title = 'one submission';
  628:     } else {
  629:         $title = $count.' submissions';
  630:     }
  631:     my $correctplot = &Apache::loncommon::DrawGraph($title,
  632:                                                     'Foil Number',
  633:                                                     'Percent Correct',
  634:                                                     100,
  635:                                                     $plotcolors,
  636:                                                     $Plotdata[0]);
  637:     for (my $j=0; $j< scalar(@{$Plotdata[0]});$j++) {
  638:         $Plotdata[0]->[$j]=0;
  639:     }
  640:     $count = $end_index-$begin_index-$TimeData{'_correct'};
  641:     if ($count == 0) {
  642:         $title = 'no submissions';
  643:     } elsif ($count == 1) {
  644:         $title = 'one submission';
  645:     } else {
  646:         $title = $count.' submissions';
  647:     }
  648:     my $incorrectplot = &Apache::loncommon::DrawGraph($title,
  649:                                                  'Foil Number',
  650:                                                  'Incorrect Option Choice',
  651:                                                  100,
  652:                                                  $plotcolors,
  653:                                                  @Plotdata);        
  654:     $analysis_html.='<tr>'.
  655:         '<td>'.$correctplot.'</td>'.
  656:         '<td>'.$incorrectplot.'</td>'.
  657:         '<td align="left" valign="top">'.$foilkey.'</td>'."</tr>\n";
  658:     $analysis_html.= '<tr>'.'<td colspan="3">'.
  659:         '<b>Start Time</b>:'.
  660:         ' &nbsp;'.$interval->{'startdateform'}.'<br />'.
  661:         '<b>End Time</b>&nbsp;&nbsp;: '.
  662:         '&nbsp;'.$interval->{'enddateform'}.'<br />'.
  663: #        '<b>Plot Title</b>&nbsp;&nbsp;:'.
  664: #        ("&nbsp;"x3).$interval->{'titleform'}.
  665:         '</td>'.
  666:         "</tr>\n";
  667:     return $analysis_html;
  668: }
  669: 
  670: sub Concept_Time_Analysis {
  671:     my ($PerformanceData,$ORdata,$Concepts,$interval) = @_;
  672:     my $analysis_html;
  673:     ##
  674:     ## Determine starttime, endtime, startindex, endindex
  675:     my ($begin_index,$end_index) = ($interval->{'begin_index'},
  676:                                     $interval->{'end_index'});
  677:     my %TimeData;
  678:     #
  679:     # Compute the number getting the foils correct or incorrects
  680:     for (my $j=$begin_index;$j<=$end_index;$j++) {
  681:         my $row = $PerformanceData->[$j];
  682:         next if (! defined($row));
  683:         my %Row = &Process_Row($row);
  684:         while (my ($foilid,$href) = each(%Row)) {
  685:             if (! ref($href)) {
  686:                 $TimeData{$foilid} += $href;
  687:                 next;
  688:             }
  689:             while (my ($option,$value) = each(%$href)) {
  690:                 $TimeData{$foilid}->{$option}+=$value;
  691:             }
  692:         }
  693:     }
  694:     #
  695:     # Put the data in plottable form
  696:     my @Plotdata;
  697:     foreach my $concept (@$Concepts) {
  698:         my ($total,$correct);
  699:         foreach my $foil (@{$concept->{'foils'}}) {
  700:             $total += $TimeData{$foil}->{'_total'};
  701:             $correct += $TimeData{$foil}->{'_correct'};
  702:         }
  703:         if ($total == 0) {
  704:             push(@Plotdata,0);
  705:         } else {
  706:             push(@Plotdata,100 * $correct / $total);
  707:         }
  708:     }
  709:     #
  710:     # Create the plot
  711:     my $title = ($end_index - $begin_index).' submissions';
  712:     my $correctplot = &Apache::loncommon::DrawGraph($title,
  713:                                                     'Concept Number',
  714:                                                     'Percent Correct',
  715:                                                     100,
  716:                                                     $plotcolors,
  717:                                                     \@Plotdata);
  718:     $analysis_html.='<tr>'.
  719:         '<td>'.$correctplot.'</td>'.
  720:         '<td align="left" valign="top">'.
  721:         '<b>Start Time</b>: &nbsp;'.$interval->{'startdateform'}.'<br />'.
  722:         '<b>End Time</b>&nbsp;&nbsp;: '.
  723:            '&nbsp;'.$interval->{'enddateform'}.'<br />'.
  724: #        '<b>Plot Title</b>&nbsp;&nbsp;:'.("&nbsp;"x3).
  725: #            $interval->{'titleform'}.
  726:         '</td>'.
  727:         "</tr>\n";
  728:     return $analysis_html;
  729: }
  730: 
  731: #########################################################
  732: #########################################################
  733: ##
  734: ##             Excel output 
  735: ##
  736: #########################################################
  737: #########################################################
  738: 
  739: sub prepare_excel_sheet {
  740:     my ($r,$resource,$PerformanceData,$ORdata) = @_;
  741:     my $response = '<h2>'.&mt('Excel Spreadsheet Creation').'</h2>';
  742:     my (undef,$Foils,$Concepts) = &build_foil_index($ORdata);
  743:     #
  744:     # Create excel worksheet
  745:     my $filename = '/prtspool/'.
  746:         $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
  747:         time.'_'.rand(1000000000).'.xls';
  748:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
  749:     if (! defined($workbook)) {
  750:         $r->log_error("Error creating excel spreadsheet $filename: $!");
  751:         $r->print('<p>'.&mt("Unable to create new Excel file.  ".
  752:                             "This error has been logged.  ".
  753:                             "Please alert your LON-CAPA administrator").
  754:                   '</p>');
  755:         return undef;
  756:     }
  757:     #
  758:     $workbook->set_tempdir('/home/httpd/perl/tmp');
  759:     #
  760:     # Define some potentially useful formats
  761:     my $format;
  762:     $format->{'header'} = $workbook->add_format(bold      => 1, 
  763:                                                 bottom    => 1,
  764: #                                                text_wrap => 1,
  765:                                                 align     => 'center');
  766:     $format->{'bold'} = $workbook->add_format(bold=>1);
  767:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
  768:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
  769:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
  770:     $format->{'date'} = $workbook->add_format(num_format=>
  771:                                               'mmm d yyyy hh:mm AM/PM');
  772:     #
  773:     # Create and populate main worksheets
  774:     my $problem_data_sheet  = $workbook->addworksheet('Problem Data');
  775:     my $student_data_sheet  = $workbook->addworksheet('Student Data');
  776:     my $response_data_sheet = $workbook->addworksheet('Response Data');
  777:     foreach my $sheet ($problem_data_sheet,$student_data_sheet,
  778:                        $response_data_sheet) {
  779:         $sheet->write(0,0,$resource->{'title'},$format->{'h2'});
  780:         $sheet->write(1,0,$resource->{'src'},$format->{'h3'});
  781:     }
  782:     #
  783:     my $result;
  784:     $result = &build_problem_data_worksheet($problem_data_sheet,$format,
  785:                                             $Concepts,$ORdata);
  786:     if ($result ne 'okay') {
  787:         # Do something useful
  788:     }
  789:     $result = &build_student_data_worksheet($student_data_sheet,$format);
  790:     if ($result ne 'okay') {
  791:         # Do something useful
  792:     }
  793:     $result = &build_response_data_worksheet($response_data_sheet,$format,
  794:                                              $PerformanceData,$Foils,
  795:                                              $ORdata);
  796:     if ($result ne 'okay') {
  797:         # Do something useful
  798:     }
  799:    $response_data_sheet->activate();
  800:     #
  801:     # Close the excel file
  802:     $workbook->close();
  803:     #
  804:     # Write a link to allow them to download it
  805:     $result .= '<br />'.
  806:               '<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n";
  807:     return $result;
  808: }
  809: 
  810: sub build_problem_data_worksheet {
  811:     my ($worksheet,$format,$Concepts,$ORdata) = @_;
  812:     my $rows_output = 3;
  813:     my $cols_output = 0;
  814:     $worksheet->write($rows_output++,0,'Problem Structure',$format->{'h3'});
  815:     ##
  816:     ##
  817:     my @Headers;
  818:     if (@$Concepts > 1) {
  819:         @Headers = ("Concept\nNumber",'Concept',"Foil\nNumber",
  820:                     'Foil Name','Foil Text','Correct value');
  821:     } else {
  822:         @Headers = ('Foil Number','FoilName','Foil Text','Correct value');
  823:     }
  824:     $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
  825:     my %Foildata = %{$ORdata->{'Foils'}};
  826:     my $conceptindex = 1;
  827:     my $foilindex = 1;
  828:     foreach my $concept (@$Concepts) {
  829:         my @FoilsInConcept = @{$concept->{'foils'}};
  830:         my $firstfoil = shift(@FoilsInConcept);
  831:         if (@$Concepts > 1) {
  832:             $worksheet->write_row($rows_output++,0,
  833:                                   [$conceptindex,
  834:                                    $concept->{'name'},
  835:                                    $foilindex++,
  836:                                    $Foildata{$firstfoil}->{'name'},
  837:                                    $Foildata{$firstfoil}->{'text'},
  838:                                    $Foildata{$firstfoil}->{'value'},]);
  839:         } else {
  840:             $worksheet->write_row($rows_output++,0,
  841:                                   [ $foilindex++,
  842:                                     $Foildata{$firstfoil}->{'name'},
  843:                                     $Foildata{$firstfoil}->{'text'},
  844:                                     $Foildata{$firstfoil}->{'value'},]);
  845:         }
  846:         foreach my $foilid (@FoilsInConcept) {
  847:             if (@$Concepts > 1) {
  848:                 $worksheet->write_row($rows_output++,0,
  849:                                       ['',
  850:                                        '',
  851:                                        $foilindex,
  852:                                        $Foildata{$foilid}->{'name'},
  853:                                        $Foildata{$foilid}->{'text'},
  854:                                        $Foildata{$foilid}->{'value'},]);
  855:             } else {
  856:                 $worksheet->write_row($rows_output++,0,                
  857:                                       [$foilindex,
  858:                                        $Foildata{$foilid}->{'name'},
  859:                                        $Foildata{$foilid}->{'text'},
  860:                                        $Foildata{$foilid}->{'value'},]);
  861:             }                
  862:         } continue {
  863:             $foilindex++;
  864:         }
  865:     } continue {
  866:         $conceptindex++;
  867:     }
  868:     $rows_output++;
  869:     $rows_output++;
  870:     ##
  871:     ## Option data output
  872:     $worksheet->write($rows_output++,0,'Options',$format->{'header'});
  873:     foreach my $string (@{$ORdata->{'Options'}}) {
  874:         $worksheet->write($rows_output++,0,$string);
  875:     }
  876:     return 'okay';
  877: }
  878: 
  879: sub build_student_data_worksheet {
  880:     my ($worksheet,$format) = @_;
  881:     my $rows_output = 3;
  882:     my $cols_output = 0;
  883:     $worksheet->write($rows_output++,0,'Student Data',$format->{'h3'});
  884:     my @Headers = ('full name','username','domain','section',
  885:                    "student\nnumber",'identifier');
  886:     $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
  887:     my @Students = @Apache::lonstatistics::Students;
  888:     my $studentrows = &Apache::loncoursedata::get_student_data(\@Students);
  889:     my %ids;
  890:     foreach my $row (@$studentrows) {
  891:         my ($mysqlid,$student) = @$row;
  892:         $ids{$student}=$mysqlid;
  893:     }
  894:     foreach my $student (@Students) {
  895:         my $name_domain = $student->{'username'}.':'.$student->{'domain'};
  896:         $worksheet->write_row($rows_output++,0,
  897:                           [$student->{'fullname'},
  898:                            $student->{'username'},$student->{'domain'},
  899:                            $student->{'section'},$student->{'id'},
  900:                            $ids{$name_domain}]);
  901:     }
  902:     return;
  903: }
  904: 
  905: sub build_response_data_worksheet {
  906:     my ($worksheet,$format,$PerformanceData,$Foils,$ORdata)=@_;
  907:     my $rows_output = 3;
  908:     my $cols_output = 0;
  909:     $worksheet->write($rows_output++,0,'Response Data',$format->{'h3'});
  910:     $worksheet->set_column(1,1,20);
  911:     $worksheet->set_column(2,2,13);
  912:     my @Headers = ('identifier','time','award detail','attempt');
  913:     foreach my $foil (@$Foils) {
  914:         push (@Headers,$foil.' submission');
  915:         push (@Headers,$foil.' grading');
  916:     }
  917:     $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
  918:     #
  919:     foreach my $row (@$PerformanceData) {
  920:         next if (! defined($row));
  921:         my ($student,$award,$grading,$submission,$time,$tries) = @$row;
  922:         my @Foilgrades = split('&',$grading);
  923:         my @Foilsubs   = split('&',$submission);
  924:         my %ResponseData;
  925:         for (my $j=0;$j<=$#Foilgrades;$j++) {
  926:             my ($foilid,$correct)  = split('=',$Foilgrades[$j]);
  927:             my (undef,$submission) = split('=',$Foilsubs[$j]);
  928:             $submission = &Apache::lonnet::unescape($submission);
  929:             $ResponseData{$foilid.' submission'}=$submission;
  930:             $ResponseData{$foilid.' award'}=$correct;
  931:         }
  932:         $worksheet->write($rows_output,$cols_output++,$student);
  933:         $worksheet->write($rows_output,$cols_output++,
  934:                           &calc_serial($time),$format->{'date'});
  935:         $worksheet->write($rows_output,$cols_output++,$award);
  936:         $worksheet->write($rows_output,$cols_output++,$tries);
  937:         foreach my $foilid (@$Foils) {
  938:             $worksheet->write($rows_output,$cols_output++,
  939:                               $ResponseData{$foilid.' submission'});
  940:             $worksheet->write($rows_output,$cols_output++,
  941:                               $ResponseData{$foilid.' award'});
  942:         }
  943:         $rows_output++;
  944:         $cols_output = 0;
  945:     }
  946:     return;
  947: }
  948: 
  949: 
  950: ##
  951: ## The following is copied from datecalc1.pl, part of the 
  952: ## Spreadsheet::WriteExcel CPAN module.
  953: ##
  954: ##
  955: ######################################################################
  956: #
  957: # Demonstration of writing date/time cells to Excel spreadsheets,
  958: # using UNIX/Perl time as source of date/time.
  959: #
  960: # Copyright 2000, Andrew Benham, adsb@bigfoot.com
  961: #
  962: ######################################################################
  963: #
  964: # UNIX/Perl time is the time since the Epoch (00:00:00 GMT, 1 Jan 1970)
  965: # measured in seconds.
  966: #
  967: # An Excel file can use exactly one of two different date/time systems.
  968: # In these systems, a floating point number represents the number of days
  969: # (and fractional parts of the day) since a start point. The floating point
  970: # number is referred to as a 'serial'.
  971: # The two systems ('1900' and '1904') use different starting points:
  972: #  '1900'; '1.00' is 1 Jan 1900 BUT 1900 is erroneously regarded as
  973: #          a leap year - see:
  974: #            http://support.microsoft.com/support/kb/articles/Q181/3/70.asp
  975: #          for the excuse^H^H^H^H^H^Hreason.
  976: #  '1904'; '1.00' is 2 Jan 1904.
  977: #
  978: # The '1904' system is the default for Apple Macs. Windows versions of
  979: # Excel have the option to use the '1904' system.
  980: #
  981: # Note that Visual Basic's "DateSerial" function does NOT erroneously
  982: # regard 1900 as a leap year, and thus its serials do not agree with
  983: # the 1900 serials of Excel for dates before 1 Mar 1900.
  984: #
  985: # Note that StarOffice (at least at version 5.2) does NOT erroneously
  986: # regard 1900 as a leap year, and thus its serials do not agree with
  987: # the 1900 serials of Excel for dates before 1 Mar 1900.
  988: #
  989: ######################################################################
  990: #
  991: # Calculation description
  992: # =======================
  993: #
  994: # 1900 system
  995: # -----------
  996: # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 70 years after 1 Jan 1900.
  997: # Of those 70 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68)
  998: # were leap years with an extra day.
  999: # Thus there were 17 + 70*365 days = 25567 days between 1 Jan 1900 and
 1000: # 1 Jan 1970.
 1001: # In the 1900 system, '1' is 1 Jan 1900, but as 1900 was not a leap year
 1002: # 1 Jan 1900 should really be '2', so 1 Jan 1970 is '25569'.
 1003: #
 1004: # 1904 system
 1005: # -----------
 1006: # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 66 years after 1 Jan 1904.
 1007: # Of those 66 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68)
 1008: # were leap years with an extra day.
 1009: # Thus there were 17 + 66*365 days = 24107 days between 1 Jan 1904 and
 1010: # 1 Jan 1970.
 1011: # In the 1904 system, 2 Jan 1904 being '1', 1 Jan 1970 is '24107'.
 1012: #
 1013: ######################################################################
 1014: #
 1015: # Copyright (c) 2000, Andrew Benham.
 1016: # This program is free software. It may be used, redistributed and/or
 1017: # modified under the same terms as Perl itself.
 1018: #
 1019: # Andrew Benham, adsb@bigfoot.com
 1020: # London, United Kingdom
 1021: # 11 Nov 2000
 1022: #
 1023: ######################################################################
 1024: 
 1025: # Use 1900 date system on all platforms other than Apple Mac (for which
 1026: # use 1904 date system).
 1027: my $DATE_SYSTEM = ($^O eq 'MacOS') ? 1 : 0;
 1028: 
 1029: #-----------------------------------------------------------
 1030: # calc_serial()
 1031: #
 1032: # Called with (up to) 2 parameters.
 1033: #   1.  Unix timestamp.  If omitted, uses current time.
 1034: #   2.  GMT flag. Set to '1' to return serial in GMT.
 1035: #       If omitted, returns serial in appropriate timezone.
 1036: #
 1037: # Returns date/time serial according to $DATE_SYSTEM selected
 1038: #-----------------------------------------------------------
 1039: sub calc_serial {
 1040:         my $time = (defined $_[0]) ? $_[0] : time();
 1041:         my $gmtflag = (defined $_[1]) ? $_[1] : 0;
 1042: 
 1043:         # Divide timestamp by number of seconds in a day.
 1044:         # This gives a date serial with '0' on 1 Jan 1970.
 1045:         my $serial = $time / 86400;
 1046: 
 1047:         # Adjust the date serial by the offset appropriate to the
 1048:         # currently selected system (1900/1904).
 1049:         if ($DATE_SYSTEM == 0) {        # use 1900 system
 1050:                 $serial += 25569;
 1051:         } else {                        # use 1904 system
 1052:                 $serial += 24107;
 1053:         }
 1054: 
 1055:         unless ($gmtflag) {
 1056:                 # Now have a 'raw' serial with the right offset. But this
 1057:                 # gives a serial in GMT, which is false unless the timezone
 1058:                 # is GMT. We need to adjust the serial by the appropriate
 1059:                 # timezone offset.
 1060:                 # Calculate the appropriate timezone offset by seeing what
 1061:                 # the differences between localtime and gmtime for the given
 1062:                 # time are.
 1063: 
 1064:                 my @gmtime = gmtime($time);
 1065:                 my @ltime  = localtime($time);
 1066: 
 1067:                 # For the first 7 elements of the two arrays, adjust the
 1068:                 # date serial where the elements differ.
 1069:                 for (0 .. 6) {
 1070:                         my $diff = $ltime[$_] - $gmtime[$_];
 1071:                         if ($diff) {
 1072:                                 $serial += _adjustment($diff,$_);
 1073:                         }
 1074:                 }
 1075:         }
 1076: 
 1077:         # Perpetuate the error that 1900 was a leap year by decrementing
 1078:         # the serial if we're using the 1900 system and the date is prior to
 1079:         # 1 Mar 1900. This has the effect of making serial value '60'
 1080:         # 29 Feb 1900.
 1081: 
 1082:         # This fix only has any effect if UNIX/Perl time on the platform
 1083:         # can represent 1900. Many can't.
 1084: 
 1085:         unless ($DATE_SYSTEM) {
 1086:                 $serial-- if ($serial < 61);    # '61' is 1 Mar 1900
 1087:         }
 1088:         return $serial;
 1089: }
 1090: 
 1091: sub _adjustment {
 1092:         # Based on the difference in the localtime/gmtime array elements
 1093:         # number, return the adjustment required to the serial.
 1094: 
 1095:         # We only look at some elements of the localtime/gmtime arrays:
 1096:         #    seconds    unlikely to be different as all known timezones
 1097:         #               have an offset of integral multiples of 15 minutes,
 1098:         #               but it's easy to do.
 1099:         #    minutes    will be different for timezone offsets which are
 1100:         #               not an exact number of hours.
 1101:         #    hours      very likely to be different.
 1102:         #    weekday    will differ when localtime/gmtime difference
 1103:         #               straddles midnight.
 1104:         #
 1105:         # Assume that difference between localtime and gmtime is less than
 1106:         # 5 days, then don't have to do maths for day of month, month number,
 1107:         # year number, etc...
 1108: 
 1109:         my ($delta,$element) = @_;
 1110:         my $adjust = 0;
 1111: 
 1112:         if ($element == 0) {            # Seconds
 1113:                 $adjust = $delta/86400;         # 60 * 60 * 24
 1114:         } elsif ($element == 1) {       # Minutes
 1115:                 $adjust = $delta/1440;          # 60 * 24
 1116:         } elsif ($element == 2) {       # Hours
 1117:                 $adjust = $delta/24;            # 24
 1118:         } elsif ($element == 6) {       # Day of week number
 1119:                 # Catch difference straddling Sat/Sun in either direction
 1120:                 $delta += 7 if ($delta < -4);
 1121:                 $delta -= 7 if ($delta > 4);
 1122: 
 1123:                 $adjust = $delta;
 1124:         }
 1125:         return $adjust;
 1126: }
 1127: 
 1128: #########################################################
 1129: #########################################################
 1130: ##
 1131: ##             Interface 
 1132: ##
 1133: #########################################################
 1134: #########################################################
 1135: sub CreateInterface {
 1136:     ##
 1137:     ## Environment variable initialization
 1138:     if (! exists$ENV{'form.AnalyzeOver'}) {
 1139:         $ENV{'form.AnalyzeOver'} = 'Tries';
 1140:     }
 1141:     ##
 1142:     ## Build the menu
 1143:     my $Str = '';
 1144:     $Str .= '<table cellspacing="5">'."\n";
 1145:     $Str .= '<tr>';
 1146:     $Str .= '<td align="center"><b>'.&mt('Sections').'</b></td>';
 1147:     $Str .= '<td align="center"><b>'.&mt('Enrollment Status').'</b></td>';
 1148: #    $Str .= '<td align="center"><b>'.&mt('Sequences and Folders').'</b></td>';
 1149:     $Str .= '<td align="center">&nbsp;</td>';
 1150:     $Str .= '</tr>'."\n";
 1151:     ##
 1152:     ## 
 1153:     $Str .= '<tr><td align="center">'."\n";
 1154:     $Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
 1155:     $Str .= '</td>';
 1156:     #
 1157:     $Str .= '<td align="center">';
 1158:     $Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5);
 1159:     $Str .= '</td>';
 1160:     #
 1161: #    $Str .= '<td align="center">';
 1162:     my $only_seq_with_assessments = sub { 
 1163:         my $s=shift;
 1164:         if ($s->{'num_assess'} < 1) { 
 1165:             return 0;
 1166:         } else { 
 1167:             return 1;
 1168:         }
 1169:     };
 1170:     &Apache::lonstatistics::MapSelect('Maps','multiple,all',5,
 1171:                                               $only_seq_with_assessments);
 1172:     ##
 1173:     ##
 1174:     $Str .= '<td>';
 1175:     { # These braces are here to organize the code, not scope it.
 1176:         {
 1177:             $Str .= '<nobr>'.&mt('Analyze Over ');
 1178:             $Str .='<select name="AnalyzeOver" >';
 1179:             $Str .= '<option value="Tries" ';
 1180:             if (! exists($ENV{'form.AnalyzeOver'}) || 
 1181:                 $ENV{'form.AnalyzeOver'} eq 'Tries'){
 1182:                 # Default to Tries
 1183:                 $Str .= ' selected ';
 1184:             }
 1185:             $Str .= '>'.&mt('Tries').'</option>';
 1186:             $Str .= '<option value="Time" ';
 1187:             $Str .= ' selected ' if ($ENV{'form.AnalyzeOver'} eq 'Time');
 1188:             $Str .= '>'.&mt('Time').'</option>';
 1189:             $Str .= '</select></nobr><br />';
 1190:         }
 1191:         {
 1192:             $Str .= '<nobr>'.&mt('Analyze as ');
 1193:             $Str .='<select name="AnalyzeAs" >';
 1194:             $Str .= '<option value="Concepts" ';
 1195:             if (! exists($ENV{'form.AnalyzeAs'}) || 
 1196:                 $ENV{'form.AnalyzeAs'} eq 'Concepts'){
 1197:                 # Default to Concepts
 1198:                 $Str .= ' selected ';
 1199:             }
 1200:             $Str .= '>'.&mt('Concepts').'</option>';
 1201:             $Str .= '<option value="Foils" ';
 1202:             $Str .= ' selected ' if ($ENV{'form.AnalyzeAs'} eq 'Foils');
 1203:             $Str .= '>'.&mt('Foils').'</option>';
 1204:             $Str .= '</select></nobr><br />';
 1205:         }
 1206:         {
 1207:             $Str .= '<br /><nobr>'.&mt('Number of Plots:');
 1208:             $Str .= '<select name="NumPlots">';
 1209:             if (! exists($ENV{'form.NumPlots'}) 
 1210:                 || $ENV{'form.NumPlots'} < 1 
 1211:                 || $ENV{'form.NumPlots'} > 20) {
 1212:                 $ENV{'form.NumPlots'} = 5;
 1213:             }
 1214:             foreach my $i (1,2,3,4,5,6,7,8,10,15,20) {
 1215:                 $Str .= '<option value="'.$i.'" ';
 1216:                 if ($ENV{'form.NumPlots'} == $i) { $Str.=' selected '; }
 1217:                 $Str .= '>'.$i.'</option>';
 1218:             }
 1219:             $Str .= '</select></nobr>';
 1220:         }
 1221:     }
 1222:     $Str .= '</td>';
 1223:     ##
 1224:     ##
 1225:     $Str .= '</tr>'."\n";
 1226:     $Str .= '</table>'."\n";
 1227:     return $Str;
 1228: }
 1229: 
 1230: sub OptionResponseProblemSelector {
 1231:     my $Str;
 1232:     $Str = "\n<table>\n";
 1233:     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
 1234:         next if ($seq->{'num_assess'}<1);
 1235:         my $seq_str = '';
 1236:         foreach my $res (@{$seq->{'contents'}}) {
 1237:             next if ($res->{'type'} ne 'assessment');
 1238:             foreach my $part (@{$res->{'parts'}}) {
 1239:                 my $partdata = $res->{'partdata'}->{$part};
 1240:                 if (! exists($partdata->{'option'}) || 
 1241:                     $partdata->{'option'} == 0) {
 1242:                     next;
 1243:                 }
 1244:                 for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){
 1245:                     my $respid = $partdata->{'ResponseIds'}->[$i];
 1246:                     my $resptype = $partdata->{'ResponseTypes'}->[$i];
 1247:                     if ($resptype eq 'option') {
 1248:                         my $value = &Apache::lonnet::escape($res->{'symb'}.':'.$part.':'.$respid);
 1249:                         my $checked = '';
 1250:                         if ($ENV{'form.problemchoice'} eq $value) {
 1251:                             $checked = 'checked ';
 1252:                         }
 1253:                         $seq_str .= '<tr><td>'.
 1254:   '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.
 1255:   '</td><td>'.
 1256:   '<a href="'.$res->{'src'}.'">'.$res->{'title'}.'</a> ';
 1257:                         if ($partdata->{'option'} > 1) {
 1258:                             $seq_str .= &mt('response').' '.$respid;
 1259:                         }
 1260:                         $seq_str .= "</td></tr>\n";
 1261:                     }
 1262:                 }
 1263:             }
 1264:         }
 1265:         if ($seq_str ne '') {
 1266:             $Str .= '<tr><td>&nbsp</td><td><b>'.$seq->{'title'}.'</b></td>'.
 1267:                 "</tr>\n".$seq_str;
 1268:         }
 1269:     }
 1270:     $Str .= "</table>\n";
 1271:     return $Str;
 1272: }
 1273: 
 1274: #########################################################
 1275: #########################################################
 1276: ##
 1277: ##              Misc functions
 1278: ##
 1279: #########################################################
 1280: #########################################################
 1281: sub get_problem_symb {
 1282:     my $problemstring = shift();
 1283:     my ($symb,$partid,$resid) = ($problemstring=~ /^(.*):([^:]*):([^:]*)$/);
 1284:     return ($symb,$partid,$resid);
 1285: }
 1286: 
 1287: sub get_resource_from_symb {
 1288:     my ($symb) = @_;
 1289:     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
 1290:         foreach my $res (@{$seq->{'contents'}}) {
 1291:             if ($res->{'symb'} eq $symb) {
 1292:                 return $res;
 1293:             }
 1294:         }
 1295:     }
 1296:     return undef;
 1297: }
 1298: 
 1299: sub get_time_from_row {
 1300:     my ($row) = @_;
 1301:     if (ref($row)) {
 1302:         return $row->[3];
 1303:     } 
 1304:     return undef;
 1305: }
 1306: 
 1307: sub get_tries_from_row {
 1308:     my ($row) = @_;
 1309:     if (ref($row)) {
 1310:         return $row->[5];
 1311:     }
 1312:     return undef;
 1313: }
 1314: 
 1315: sub Process_Row {
 1316:     my ($row) = @_;
 1317:     my %RowData;
 1318:     my ($student_id,$award,$grading,$submission,$time,$tries) = @$row;
 1319:     return undef if ($award eq 'MISSING_ANSWER');
 1320:     if ($award =~ /(APPROX_ANS|EXACT_ANS)/) {
 1321:         $RowData{'_correct'} = 1;
 1322:     }
 1323:     $RowData{'_total'} = 1;
 1324:     my @Foilgrades = split('&',$grading);
 1325:     my @Foilsubs   = split('&',$submission);
 1326:     for (my $j=0;$j<=$#Foilgrades;$j++) {
 1327:         my ($foilid,$correct)  = split('=',$Foilgrades[$j]);
 1328:         my (undef,$submission) = split('=',$Foilsubs[$j]);
 1329:         if ($correct) {
 1330:             $RowData{$foilid}->{'_correct'}++;
 1331:         } else {
 1332:             $submission = &Apache::lonnet::unescape($submission);
 1333:             $RowData{$foilid}->{$submission}++;
 1334:         }
 1335:         $RowData{$foilid}->{'_total'}++;
 1336:     }
 1337:     return %RowData;
 1338: }
 1339: 
 1340: ##
 1341: ## get problem data and put it into a useful data structure.
 1342: ## note: we must force each foil and option to not begin or end with
 1343: ##       spaces as they are stored without such data.
 1344: ##
 1345: sub get_problem_data {
 1346:     my ($url) = @_;
 1347:     my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze'));
 1348:     (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
 1349:     my %Answer;
 1350:     %Answer=&Apache::lonnet::str2hash($Answ);
 1351:     my %Partdata;
 1352:     foreach my $part (@{$Answer{'parts'}}) {
 1353:         while (my($key,$value) = each(%Answer)) {
 1354:             next if ($key !~ /^$part/);
 1355:             $key =~ s/^$part\.//;
 1356:             if (ref($value) eq 'ARRAY') {
 1357:                 if ($key eq 'options') {
 1358:                     $Partdata{$part}->{'Options'}=$value;
 1359:                 } elsif ($key eq 'concepts') {
 1360:                     $Partdata{$part}->{'Concepts'}=$value;
 1361:                 } elsif ($key =~ /^concept\.(.*)$/) {
 1362:                     my $concept = $1;
 1363:                     foreach my $foil (@$value) {
 1364:                         $Partdata{$part}->{'Foils'}->{$foil}->{'Concept'}=
 1365:                                                                       $concept;
 1366:                     }
 1367:                 }
 1368:             } else {
 1369:                 if ($key=~ /^foil\.text\.(.*)$/) {
 1370:                     my $foil = $1;
 1371:                     $Partdata{$part}->{'Foils'}->{$foil}->{'name'}=$foil;
 1372:                     $value =~ s/(\s*$|^\s*)//g;
 1373:                     $Partdata{$part}->{'Foils'}->{$foil}->{'text'}=$value;
 1374:                 } elsif ($key =~ /^foil\.value\.(.*)$/) {
 1375:                     my $foil = $1;
 1376:                     $Partdata{$part}->{'Foils'}->{$foil}->{'value'}=$value;
 1377:                 }
 1378:             }
 1379:         }
 1380:     }
 1381:     return %Partdata;
 1382: }
 1383: 
 1384: 1;
 1385: 
 1386: __END__

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