Annotation of loncom/interface/statistics/lonproblemanalysis.pm, revision 1.46

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

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