File:  [LON-CAPA] / loncom / interface / statistics / lonproblemanalysis.pm
Revision 1.70: download - view: text, annotated - select for diffs
Wed Feb 18 19:16:55 2004 UTC (20 years, 4 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Modified &prepare_excel_output to include the 'awarded', 'weight', and
'score' columns in the Excel worksheet it produces.

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lonproblemanalysis.pm,v 1.70 2004/02/18 19:16:55 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: package Apache::lonproblemanalysis;
   28: 
   29: use strict;
   30: use Apache::lonnet();
   31: use Apache::loncommon();
   32: use Apache::lonhtmlcommon();
   33: use Apache::loncoursedata();
   34: use Apache::lonstatistics;
   35: use Apache::lonlocal;
   36: use Apache::lonstathelpers;
   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: my @SubmitButtons = ({ name => 'PrevProblemAnalysis',
   47:                        text => 'Previous Problem' },
   48:                      { name => 'ProblemAnalysis',
   49:                        text => 'Analyze Problem Again' },
   50:                      { name => 'NextProblemAnalysis',
   51:                        text => 'Next Problem' },
   52:                      { name => 'break'},
   53:                      { name => 'ClearCache',
   54:                        text => 'Clear Caches' },
   55:                      { name => 'updatecaches',
   56:                        text => 'Update Student Data' },
   57:                      { name => 'SelectAnother',
   58:                        text => 'Choose a different Problem' },
   59:                      { name => 'ExcelOutput',
   60:                        text => 'Produce Excel Output' });
   61: 
   62: 
   63: sub BuildProblemAnalysisPage {
   64:     my ($r,$c)=@_;
   65:     #
   66:     my %Saveable_Parameters = ('Status' => 'scalar',
   67:                                'Section' => 'array',
   68:                                'NumPlots' => 'scalar',
   69:                                'AnalyzeAs' => 'scalar',
   70:                                'AnalyzeOver' => 'scalar',
   71:                                );
   72:     &Apache::loncommon::store_course_settings('problem_analysis',
   73:                                               \%Saveable_Parameters);
   74:     &Apache::loncommon::restore_course_settings('problem_analysis',
   75:                                                 \%Saveable_Parameters);
   76:     #
   77:     &Apache::lonstatistics::PrepareClasslist();
   78:     #
   79:     $r->print('<h2>'.&mt('Detailed Problem Analysis').'</h2>');
   80:     $r->print(&CreateInterface());
   81:     #
   82:     my @Students = @Apache::lonstatistics::Students;
   83:     #
   84:     if (@Students < 1) {
   85:         $r->print('<h2>There are no students in the sections selected</h2>');
   86:     }
   87:     #
   88:     &Apache::loncoursedata::clear_internal_caches();
   89:     if (exists($ENV{'form.ClearCache'}) || 
   90:         exists($ENV{'form.updatecaches'}) ||
   91:         (exists($ENV{'form.firstanalysis'}) &&
   92:          $ENV{'form.firstanalysis'} ne 'no')) {
   93:         &Apache::lonstatistics::Gather_Full_Student_Data($r);
   94:     }
   95:     if (! exists($ENV{'form.firstanalysis'})) {
   96:         $r->print('<input type="hidden" name="firstanalysis" value="yes" />');
   97:     } else {
   98:         $r->print('<input type="hidden" name="firstanalysis" value="no" />');
   99:     }
  100:     $r->rflush();
  101:     #
  102:     my $problem_types = '(option|radiobutton|numerical)';
  103:     if (exists($ENV{'form.problemchoice'}) && 
  104:         ! exists($ENV{'form.SelectAnother'})) {
  105:         foreach my $button (@SubmitButtons) {
  106:             if ($button->{'name'} eq 'break') {
  107:                 $r->print("<br />\n");
  108:             } else {
  109:                 $r->print('<input type="submit" name="'.$button->{'name'}.'" '.
  110:                           'value="'.&mt($button->{'text'}).'" />');
  111:                 $r->print('&nbsp;'x5);
  112:             }
  113:         }
  114:         #
  115:         $r->print('<hr />');
  116:         $r->rflush();
  117:         #
  118:         # Determine which problem we are to analyze
  119:         my $current_problem = &Apache::lonstathelpers::get_target_from_id
  120:             ($ENV{'form.problemchoice'});
  121:         #
  122:         my ($prev,$curr,$next) = 
  123:             &Apache::lonstathelpers::get_prev_curr_next($current_problem,
  124:                                                         $problem_types,
  125:                                                         'response',
  126:                                                         );
  127:         if (exists($ENV{'form.PrevProblemAnalysis'}) && defined($prev)) {
  128:             $current_problem = $prev;
  129:         } elsif (exists($ENV{'form.NextProblemAnalysis'}) && defined($next)) {
  130:             $current_problem = $next;
  131:         } else {
  132:             $current_problem = $curr;
  133:         }
  134:         #
  135:         # Store the current problem choice and send it out in the form
  136:         $ENV{'form.problemchoice'} = 
  137:             &Apache::lonstathelpers::make_target_id($current_problem);
  138:         $r->print('<input type="hidden" name="problemchoice" value="'.
  139:                   $ENV{'form.problemchoice'}.'" />');
  140:         #
  141:         if (! defined($current_problem->{'resource'})) {
  142:             $r->print('resource is undefined');
  143:         } else {
  144:             my $resource = $current_problem->{'resource'};
  145:             $r->print('<h1>'.$resource->{'title'}.'</h1>');
  146:             $r->print('<h3>'.$resource->{'src'}.'</h3>');
  147:             $r->print(&Apache::lonstathelpers::render_resource($resource));
  148:             $r->rflush();
  149:             my %Data = &get_problem_data($resource->{'src'});
  150:             my $ProblemData = $Data{$current_problem->{'part'}.
  151:                                     '.'.
  152:                                     $current_problem->{'respid'}};
  153:             if ($current_problem->{'resptype'} eq 'option') {
  154:                 &OptionResponseAnalysis($r,$current_problem,
  155:                                         $ProblemData,
  156:                                         \@Students);
  157:             } elsif ($current_problem->{'resptype'} eq 'radiobutton') {
  158:                 &RadioResponseAnalysis($r,$current_problem,
  159:                                        $ProblemData,
  160:                                        \@Students);
  161:             } elsif ($current_problem->{'resptype'} eq 'numerical') {
  162: #                if (exists($ENV{'form.ExcelOutput'})) {
  163:                     &prepare_excel_output($r,$current_problem,
  164:                                           $ProblemData,\@Students);
  165: #                } else {
  166: #                    &NumericalResponseAnalysis($r,$current_problem,
  167: #                                               $ProblemData,\@Students);
  168: #                }
  169:             } else {
  170:                 $r->print('<h2>This analysis is not supported</h2>');
  171:             }
  172:         }
  173:         $r->print('<hr />');
  174:     } else {
  175:         $r->print('<input type="submit" name="ProblemAnalysis" value="'.
  176:                   &mt('Analyze Problem').'" />');
  177:         $r->print('&nbsp;'x5);
  178:         $r->print('<h3>'.&mt('Please select a problem to analyze').'</h3>');
  179:         $r->print(&Apache::lonstathelpers::ProblemSelector
  180:                   ($problem_types));
  181:     }
  182: }
  183: 
  184: 
  185: #########################################################
  186: #########################################################
  187: ##
  188: ##      Excel output of student answers and correct answers
  189: ##
  190: #########################################################
  191: #########################################################
  192: sub prepare_excel_output {
  193:     my ($r,$problem,$ProblemData,$Students) = @_;
  194:     my ($resource,$respid,$partid) = ($problem->{'resource'},
  195:                                       $problem->{'respid'},
  196:                                       $problem->{'part'});
  197:     $r->print('<h2>'.
  198:               &mt('Preparing Excel spreadsheet of student responses').
  199:               '</h2>');
  200:     #
  201:     &GetStudentAnswers($r,$problem,$Students);
  202:     #
  203:     my @Columns = ( 'username','domain','attempt','time',
  204:                     'submission','correct', 'grading','awarded','weight',
  205:                     'score');
  206:     my $awarded_col = 7;
  207:     my $weight_col  = 8;
  208:     #
  209:     # Create excel worksheet
  210:     my $filename = '/prtspool/'.
  211:         $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
  212:         time.'_'.rand(1000000000).'.xls';
  213:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
  214:     if (! defined($workbook)) {
  215:         $r->log_error("Error creating excel spreadsheet $filename: $!");
  216:         $r->print('<p>'.&mt("Unable to create new Excel file.  ".
  217:                             "This error has been logged.  ".
  218:                             "Please alert your LON-CAPA administrator").
  219:                   '</p>');
  220:         return undef;
  221:     }
  222:     #
  223:     $workbook->set_tempdir('/home/httpd/perl/tmp');
  224:     #
  225:     my $format = &Apache::loncommon::define_excel_formats($workbook);
  226:     my $worksheet  = $workbook->addworksheet('Student Submission Data');
  227:     #
  228:     # Make sure we get new weight data instead of data on a 10 minute delay
  229:     &Apache::lonnet::clear_EXT_cache_status();
  230:     #
  231:     # Put on the standard headers and whatnot
  232:     my $rows_output=0;
  233:     $worksheet->write($rows_output++,0,$resource->{'title'},$format->{'h1'});
  234:     $worksheet->write($rows_output++,0,$resource->{'src'},$format->{'h3'});
  235:     $rows_output++;
  236:     $worksheet->write_row($rows_output++,0,\@Columns,$format->{'bold'});
  237:     #
  238:     # Populate the worksheet with the student data
  239:     foreach my $student (@$Students) {
  240:         my $results = &Apache::loncoursedata::get_response_data_by_student
  241:             ($student,$resource->{'symb'},$respid);
  242:         my %row;
  243:         $row{'username'} = $student->{'username'};
  244:         $row{'domain'}   = $student->{'domain'};
  245:         $row{'correct'} = $student->{'answer'};
  246:         $row{'weight'} = &Apache::lonnet::EXT
  247:             ('resource.'.$partid.'.weight',$resource->{'symb'},
  248:              undef,undef,undef);
  249:         if (! defined($results) || ref($results) ne 'ARRAY') {
  250:             $row{'score'} = '='.
  251:                 &Spreadsheet::WriteExcel::Utility::xl_rowcol_to_cell
  252:                     ($rows_output,$awarded_col)
  253:                 .'*'.
  254:                 &Spreadsheet::WriteExcel::Utility::xl_rowcol_to_cell
  255:                     ($rows_output,$weight_col);
  256:             my $cols_output = 0;
  257:             foreach my $col (@Columns) {
  258:                 if (! exists($row{$col})) {
  259:                     $cols_output++;
  260:                     next;
  261:                 }
  262:                 $worksheet->write($rows_output,$cols_output++,$row{$col});
  263:             }
  264:             $rows_output++;
  265:         } else {
  266:             foreach my $response (@$results) {
  267:                 delete($row{'time'});
  268:                 delete($row{'attempt'});
  269:                 delete($row{'submission'});
  270:                 delete($row{'awarded'});
  271:                 delete($row{'grading'});
  272:                 delete($row{'score'});
  273:                 my %row_format;
  274:                 #
  275:                 # Time is handled differently
  276:                 $row{'time'} = &calc_serial(
  277:                      $response->[&Apache::loncoursedata::RDs_timestamp()]);
  278:                 $row_format{'time'}=$format->{'date'};
  279:                 #
  280:                 $row{'attempt'}  = $response->[
  281:                      &Apache::loncoursedata::RDs_tries()];
  282:                 $row{'submission'} = $response->[
  283:                      &Apache::loncoursedata::RDs_submission()];
  284:                 $row{'grading'} = $response->[
  285:                      &Apache::loncoursedata::RDs_awarddetail()];
  286:                 $row{'awarded'} = $response->[
  287:                      &Apache::loncoursedata::RDs_awarded()];
  288:                 $row{'score'} = '='.
  289:                     &Spreadsheet::WriteExcel::Utility::xl_rowcol_to_cell
  290:                         ($rows_output,$awarded_col)
  291:                     .'*'.
  292:                     &Spreadsheet::WriteExcel::Utility::xl_rowcol_to_cell
  293:                         ($rows_output,$weight_col);
  294:                 my $cols_output = 0;
  295:                 foreach my $col (@Columns) {
  296:                     $worksheet->write($rows_output,$cols_output++,$row{$col},
  297:                                       $row_format{$col});
  298:                 }
  299:                 $rows_output++;
  300:             }
  301:         } # End of else clause on if (! defined($results) ....
  302:     }
  303:     #
  304:     # Close the excel file
  305:     $workbook->close();
  306:     #
  307:     # Write a link to allow them to download it
  308:     $r->print('<p><a href="'.$filename.'">'.
  309:               &mt('Your Excel spreadsheet.').
  310:               '</a></p>'."\n");
  311: 
  312: }
  313: 
  314: 
  315: #########################################################
  316: #########################################################
  317: ##
  318: ##      Numerical Response Routines
  319: ##
  320: #########################################################
  321: #########################################################
  322: sub NumericalResponseAnalysis {
  323:     my ($r,$problem,$ProblemData,$Students) = @_;
  324:     $r->print('<h2>This analysis is not yet supported</h2>');
  325:     my ($resource,$respid) = ($problem->{'resource'},
  326:                               $problem->{'respid'});
  327:     my $analysis_html;
  328:     my $PerformanceData = 
  329:         &Apache::loncoursedata::get_response_data
  330:         ($Students,$resource->{'symb'},$respid);
  331:     if (! defined($PerformanceData) || 
  332:         ref($PerformanceData) ne 'ARRAY' ) {
  333:         $analysis_html = '<h2>'.
  334:             &mt('There is no submission data for this resource').
  335:             '</h2>';
  336:         $r->print($analysis_html);
  337:         return;
  338:     }
  339:     my ($max,$min) = &GetStudentAnswers($r,$problem,$Students);
  340:     $r->print('Maximum = '.$max.' Minimum = '.$min);
  341:     my $max_students = 0;
  342:     my %Data;
  343:     foreach my $student (@$Students) {
  344:         my $answer = $student->{'answer'};
  345:         $Data{$answer}++;
  346:         if ($max_students < $Data{$answer}) {
  347:             $max_students = $Data{$answer};
  348:         }
  349:     }
  350:     foreach (5,10,20,25,50,75,100,150,200,250,500,1000,1500,2000,2500,5000) {
  351:         if ($max_students < $_) {
  352:             $max_students = $_;
  353:             last;
  354:         }
  355:     }
  356:     my @Labels = sort {$a <=> $b } keys(%Data);
  357:     $r->print('number of labels = '.scalar(@Labels));
  358:     my @PlotData = @Data{@Labels};
  359:     $r->print('number of PlotData = '.scalar(@PlotData));
  360:     my $graph = 
  361:         &Apache::loncommon::DrawXYGraph('Correct Answer Distribution',
  362:                                         'Correct Answer',
  363:                                         'Number of students',
  364:                                         $max_students,
  365:                                         undef,
  366:                                         \@Labels,
  367:                                         [\@PlotData],
  368:                                         (xskip=>10));
  369:     $r->print($graph);
  370:     return;
  371: }
  372: 
  373: sub GetStudentAnswers {
  374:     my ($r,$problem,$Students) = @_;
  375:     my %Answers;
  376:     my ($resource,$partid,$respid) = ($problem->{'resource'},
  377:                                       $problem->{'part'},
  378:                                       $problem->{'respid'});
  379:     # Open progress window
  380:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
  381:         ($r,'Student Answer Compilation Status',
  382:          'Student Answer Compilation Progress', scalar(@$Students));
  383:     $r->print("<table>\n");
  384:     $r->rflush();
  385:     foreach my $student (@$Students) {
  386:         my $sname = $student->{'username'};
  387:         my $sdom = $student->{'domain'};
  388:         my $answer = &analyze_problem_as_student($resource,
  389:                                                  $sname,$sdom,
  390:                                                  $partid,$respid);
  391:         &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
  392:                                                  &mt('last student'));
  393:         $student->{'answer'} = $answer;
  394:     }
  395:     $r->print("</table>\n");
  396:     $r->rflush();
  397:     # close progress window
  398:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
  399:     return;
  400: }
  401: 
  402: sub build_student_data_worksheet {
  403:     my ($workbook,$format) = @_;
  404:     my $rows_output = 3;
  405:     my $cols_output = 0;
  406:     my $worksheet  = $workbook->addworksheet('Student Data');
  407:     $worksheet->write($rows_output++,0,'Student Data',$format->{'h3'});
  408:     my @Headers = ('full name','username','domain','section',
  409:                    "student\nnumber",'identifier');
  410:     $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
  411:     my @Students = @Apache::lonstatistics::Students;
  412:     my $studentrows = &Apache::loncoursedata::get_student_data(\@Students);
  413:     my %ids;
  414:     foreach my $row (@$studentrows) {
  415:         my ($mysqlid,$student) = @$row;
  416:         $ids{$student}=$mysqlid;
  417:     }
  418:     foreach my $student (@Students) {
  419:         my $name_domain = $student->{'username'}.':'.$student->{'domain'};
  420:         $worksheet->write_row($rows_output++,0,
  421:                           [$student->{'fullname'},
  422:                            $student->{'username'},$student->{'domain'},
  423:                            $student->{'section'},$student->{'id'},
  424:                            $ids{$name_domain}]);
  425:     }
  426:     return $worksheet;
  427: }
  428: 
  429: #########################################################
  430: #########################################################
  431: ##
  432: ##      Radio Response Routines
  433: ##
  434: #########################################################
  435: #########################################################
  436: sub RadioResponseAnalysis {
  437:     my ($r,$problem,$ProblemData,$Students) = @_;
  438:     my ($resource,$respid) = ($problem->{'resource'},
  439:                               $problem->{'respid'});
  440:     my $analysis_html;
  441:     my $PerformanceData = 
  442:         &Apache::loncoursedata::get_response_data
  443:         ($Students,$resource->{'symb'},$respid);
  444:     if (! defined($PerformanceData) || 
  445:         ref($PerformanceData) ne 'ARRAY' ) {
  446:         $analysis_html = '<h2>'.
  447:             &mt('There is no submission data for this resource').
  448:             '</h2>';
  449:         $r->print($analysis_html);
  450:         return;
  451:     }
  452:     if (exists($ENV{'form.ExcelOutput'})) {
  453:         $analysis_html .= &RR_Excel_output($r,$problem->{'resource'},
  454:                                            $PerformanceData,$ProblemData);
  455:     } elsif ($ENV{'form.AnalyzeOver'} eq 'Tries') {
  456:         $analysis_html .= &RR_Tries_Analysis($r,$problem->{'resource'},
  457:                                              $PerformanceData,$ProblemData);
  458:     } elsif ($ENV{'form.AnalyzeOver'} eq 'Time') {
  459:         $analysis_html .= &RR_Time_Analysis($r,$problem->{'resource'},
  460:                                             $PerformanceData,$ProblemData);
  461:     } else {
  462:         $analysis_html .= '<h2>'.
  463:            &mt('The analysis you have selected is not supported at this time').
  464:            '</h2>';
  465:     }
  466:     $r->print($analysis_html);
  467: }
  468: 
  469: sub RR_Excel_output   { 
  470:     my ($r,$PerformanceData,$ProblemData) = @_;
  471:     return '<h1>No!</h1>';
  472: }
  473: 
  474: sub RR_Tries_Analysis { 
  475:     my ($r,$resource,$PerformanceData,$ProblemData) = @_;
  476:     my $analysis_html;
  477:     my $mintries = 1;
  478:     my $maxtries = $ENV{'form.NumPlots'};
  479:     my ($table,$Foils,$Concepts) = &build_foil_index($ProblemData);
  480:     if ((! defined($Concepts)) || ((@$Concepts < 2) && 
  481:                                    ($ENV{'form.AnalyzeAs'} ne 'Foils'))) {
  482:         $table = '<h3>'.
  483:             &mt('Not enough data for concept analysis.  '.
  484:                 'Performing Foil Analysis').
  485:             '</h3>'.$table;
  486:         $ENV{'form.AnalyzeAs'} = 'Foils';
  487:     }
  488:     $analysis_html .= $table;
  489:     my @TryData = &RR_tries_data_analysis($r,$PerformanceData);
  490: #    if ($ENV{'form.AnalyzeAs'} eq 'Foils') {
  491:         $analysis_html .= &RR_Tries_Foil_Analysis($mintries,$maxtries,$Foils,
  492:                                                  \@TryData,$ProblemData);
  493: #    } else {
  494: #        $analysis_html = &RR_Tries_Concept_Analysis($mintries,$maxtries,
  495: #                                                    $Concepts,
  496: #                                                    \@TryData,
  497: #                                                    $ProblemData);
  498: #    }
  499:     return $analysis_html;
  500: }
  501: 
  502: sub RR_tries_data_analysis {
  503:     my ($r,$Attempt_data) = @_;
  504:     my @TryData;
  505:     foreach my $attempt (@$Attempt_data) {
  506:         my %Attempt = &hashify_attempt($attempt);
  507:         my ($answer,undef) = split('=',$Attempt{'submission'});
  508:         $TryData[$Attempt{'tries'}]->{$answer}++;
  509:     }
  510:     return @TryData;
  511: }
  512: 
  513: sub RR_Time_Analysis  { 
  514:     my ($r,$PerformanceData,$ProblemData) = @_;
  515:     my $html;
  516:     return $html;
  517: }
  518: 
  519: sub RR_Tries_Foil_Analysis {
  520:     my ($min,$max,$Foils,$TryData,$ProblemData) = @_;
  521:     my $html;
  522:     #
  523:     # Compute the data neccessary to make the plots
  524:     for (my $try=$min;$try<=$max;$try++) {
  525:         my @PlotData_Correct; 
  526:         my @PlotData_Incorrect;
  527:         next if ($try > scalar(@{$TryData}));
  528:         next if (! defined($TryData->[$try]));
  529:         my %DataSet = %{$TryData->[$try]};
  530:         my $total = 0;
  531:         foreach my $foilid (@$Foils) {
  532:             $total += $DataSet{$foilid};
  533:         }
  534:         foreach my $foilid (@$Foils) {
  535:             if ($total == 0) {
  536:                 push (@PlotData_Correct,0);
  537:                 push (@PlotData_Incorrect,0);
  538:             } else {
  539:                 if ($ProblemData->{'_Foils'}->{$foilid}->{'value'} eq 'true') {
  540:                     push (@PlotData_Correct,
  541:                           int(100*$DataSet{$foilid}/$total));
  542:                     push (@PlotData_Incorrect,0);
  543:                 } else {
  544:                     push (@PlotData_Correct,0);
  545:                     push (@PlotData_Incorrect,
  546:                           int(100*$DataSet{$foilid}/$total));
  547:                 }
  548:             }
  549:         }
  550:         my $title='Attempt '.$try;
  551:         my $xlabel = $total.' Submissions';
  552:         $html.=  &Apache::loncommon::DrawBarGraph($title,
  553:                                                   $xlabel,
  554:                                                   'Percent Choosing',
  555:                                                   100,
  556:                                                   ['#33ff00','#ff3300'],
  557:                                                   undef,
  558:                                                   \@PlotData_Correct,
  559:                                                   \@PlotData_Incorrect);
  560:     }
  561:     return $html;
  562: }
  563: 
  564: sub RR_Tries_Concept_Analysis {
  565:     my ($min,$max,$Concepts,$ResponseData,$ProblemData) = @_;
  566:     my $html;
  567:     return $html;
  568: }
  569: 
  570: sub RR_Time_Foil_Analysis {
  571:     my ($min,$max,$Foils,$ResponseData,$ProblemData) = @_;
  572:     my $html;
  573:     return $html;
  574: }
  575: 
  576: sub RR_Time_Concept_Analysis {
  577:     my ($min,$max,$Concepts,$ResponseData,$ProblemData) = @_;
  578:     my $html;
  579:     return $html;
  580: }
  581: 
  582: 
  583: sub get_Radio_problem_data {
  584:     my ($url) = @_;
  585:     my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze'));
  586:     (my $garbage,$Answ)=split('_HASH_REF__',$Answ,2);
  587:     my %Answer = &Apache::lonnet::str2hash($Answ);
  588:     my %Partdata;
  589:     foreach my $part (@{$Answer{'parts'}}) {
  590:         while (my($key,$value) = each(%Answer)) {
  591: #            if (ref($value) eq 'ARRAY') {
  592: #                &Apache::lonnet::logthis('is ref part:'.$part.' '.$key.'='.join(',',@$value));
  593: #            } else {
  594: #                &Apache::lonnet::logthis('notref part:'.$part.' '.$key.'='.$value);
  595: #            }                
  596:             next if ($key !~ /^$part/);
  597:             $key =~ s/^$part\.//;
  598:             if ($key eq 'foils') {
  599:                 $Partdata{$part}->{'_Foils'}=$value;
  600:             } elsif ($key eq 'options') {
  601:                 $Partdata{$part}->{'_Options'}=$value;
  602:             } elsif ($key eq 'shown') {
  603:                 $Partdata{$part}->{'_Shown'}=$value;
  604:             } elsif ($key =~ /^foil.value.(.*)$/) {
  605:                 $Partdata{$part}->{$1}->{'value'}=$value;
  606:             } elsif ($key =~ /^foil.text.(.*)$/) {
  607:                 $Partdata{$part}->{$1}->{'text'}=$value;
  608:             }
  609:         }
  610:     }
  611:     return %Partdata;
  612: }
  613: 
  614: #########################################################
  615: #########################################################
  616: ##
  617: ##      Option Response Routines
  618: ##
  619: #########################################################
  620: #########################################################
  621: sub OptionResponseAnalysis {
  622:     my ($r,$problem,$ProblemData,$Students) = @_;
  623:     my ($resource,$respid) = ($problem->{'resource'},
  624:                               $problem->{'respid'});
  625:     # Note: part data is not needed.
  626:     my $PerformanceData = 
  627:         &Apache::loncoursedata::get_response_data
  628:         ($Students,$resource->{'symb'},$respid);
  629:     if (! defined($PerformanceData) || 
  630:         ref($PerformanceData) ne 'ARRAY' ) {
  631:         $r->print('<h2>'.
  632:                   &mt('There is no student data for this problem.').
  633:                   '</h2>');
  634:     }  else {
  635:         $r->rflush();
  636:         if (exists($ENV{'form.ExcelOutput'})) {
  637:             my $result = &OR_excel_sheet($r,$resource,
  638:                                          $PerformanceData,
  639:                                          $ProblemData);
  640:             $r->print($result);
  641:             $r->rflush();
  642:         } else {
  643:             if ($ENV{'form.AnalyzeOver'} eq 'Tries') {
  644:                 my $analysis_html = &OR_tries_analysis($r,
  645:                                                     $PerformanceData,
  646:                                                     $ProblemData);
  647:                 $r->print($analysis_html);
  648:                 $r->rflush();
  649:             } elsif ($ENV{'form.AnalyzeOver'} eq 'Time') {
  650:                 my $analysis_html = &OR_time_analysis($PerformanceData,
  651:                                                    $ProblemData);
  652:                 $r->print($analysis_html);
  653:                 $r->rflush();
  654:             } else {
  655:                 $r->print('<h2>'.
  656:                           &mt('The analysis you have selected is '.
  657:                               'not supported at this time').
  658:                           '</h2>');
  659:             }
  660:         }
  661:     }
  662: }
  663: 
  664: #########################################################
  665: #
  666: #       Option Response:  Tries Analysis
  667: #
  668: #########################################################
  669: sub OR_tries_analysis {
  670:     my ($r,$PerformanceData,$ORdata) = @_;
  671:     my $mintries = 1;
  672:     my $maxtries = $ENV{'form.NumPlots'};
  673:     my ($table,$Foils,$Concepts) = &build_foil_index($ORdata);
  674:     if ((@$Concepts < 2) && ($ENV{'form.AnalyzeAs'} ne 'Foils')) {
  675:         $table = '<h3>'.
  676:             &mt('Not enough data for concept analysis.  '.
  677:                 'Performing Foil Analysis').
  678:             '</h3>'.$table;
  679:         $ENV{'form.AnalyzeAs'} = 'Foils';
  680:     }
  681:     my %ResponseData = &OR_analyze_by_tries($r,$PerformanceData,
  682:                                                      $mintries,$maxtries);
  683:     my $analysis = '';
  684:     if ($ENV{'form.AnalyzeAs'} eq 'Foils') {
  685:         $analysis = &OR_Tries_Foil_Analysis($mintries,$maxtries,$Foils,
  686:                                          \%ResponseData,$ORdata);
  687:     } else {
  688:         $analysis = &OR_Tries_Concept_Analysis($mintries,$maxtries,
  689:                                             $Concepts,\%ResponseData,$ORdata);
  690:     }
  691:     $table .= $analysis;
  692:     return $table;
  693: }
  694: 
  695: sub OR_Tries_Foil_Analysis {
  696:     my ($mintries,$maxtries,$Foils,$respdat,$ORdata) = @_;
  697:     my %ResponseData = %$respdat;
  698:     #
  699:     # Compute the data neccessary to make the plots
  700:     my @PlotData; 
  701:     foreach my $foilid (@$Foils) {
  702:         for (my $i=$mintries;$i<=$maxtries;$i++) {
  703:             if ($ResponseData{$foilid}->[$i]->{'_total'} == 0) {
  704:                 push(@{$PlotData[$i]->{'_correct'}},0);
  705:             } else {
  706:                 push(@{$PlotData[$i]->{'_correct'}},
  707:                      100*$ResponseData{$foilid}->[$i]->{'_correct'}/
  708:                      $ResponseData{$foilid}->[$i]->{'_total'});
  709:             }
  710:             foreach my $option (@{$ORdata->{'_Options'}}) {
  711:                 push(@{$PlotData[$i]->{'_total'}},
  712:                      $ResponseData{$foilid}->[$i]->{'_total'});
  713:                 if ($ResponseData{$foilid}->[$i]->{'_total'} == 0) {
  714:                     push (@{$PlotData[$i]->{$option}},0);
  715:                 } else {
  716:                     if ($ResponseData{$foilid}->[$i]->{'_total'} ==
  717:                         $ResponseData{$foilid}->[$i]->{'_correct'}) {
  718:                         push(@{$PlotData[$i]->{$option}},0);
  719:                     } else {
  720:                         push (@{$PlotData[$i]->{$option}},
  721:                               100 * $ResponseData{$foilid}->[$i]->{$option} / 
  722:                               ($ResponseData{$foilid}->[$i]->{'_total'} - 
  723:                                $ResponseData{$foilid}->[$i]->{'_correct'}));
  724:                     }
  725:                 }
  726:             }
  727:         }
  728:     }
  729:     # 
  730:     # Build a table for the plots
  731:     my $analysis_html = "<table>\n";
  732:     my $foilkey = &build_option_index($ORdata);
  733:     for (my $i=$mintries;$i<=$maxtries;$i++) {
  734:         my $count = $ResponseData{'_total'}->[$i];
  735:         if ($count == 0) {
  736:             $count = 'no submissions';
  737:         } elsif ($count == 1) {
  738:             $count = '1 submission';
  739:         } else {
  740:             $count = $count.' submissions';
  741:         }
  742:         my $title = 'Attempt '.$i.', '.$count;
  743:         my @Datasets;
  744:         foreach my $option ('_correct',@{$ORdata->{'_Options'}}) {
  745:             next if (! exists($PlotData[$i]->{$option}));
  746:             push(@Datasets,$PlotData[$i]->{$option});
  747:         }
  748:         my $correctgraph = &Apache::loncommon::DrawBarGraph
  749:             ($title,'Foil Number','Percent Correct',
  750:              100,$plotcolors,undef,$Datasets[0]);
  751:         $analysis_html.= '<tr><td>'.$correctgraph.'</td>';
  752:         ##
  753:         ##
  754:         next if (! defined($Datasets[0]));
  755:         for (my $i=0; $i< scalar(@{$Datasets[0]});$i++) {
  756:             $Datasets[0]->[$i]=0;
  757:         }
  758:         $count = $ResponseData{'_total'}->[$i]-$ResponseData{'_correct'}->[$i];
  759:         if ($count == 0) {
  760:             $count = 'no submissions';
  761:         } elsif ($count == 1) {
  762:             $count = '1 submission';
  763:         } else {
  764:             $count = $count.' submissions';
  765:         }
  766:         $title = 'Attempt '.$i.', '.$count;
  767:         my $incorrectgraph = &Apache::loncommon::DrawBarGraph
  768:             ($title,'Foil Number','% Option Chosen Incorrectly',
  769:              100,$plotcolors,undef,@Datasets);
  770:         $analysis_html.= '<td>'.$incorrectgraph.'</td>';
  771:         $analysis_html.= '<td>'.$foilkey."<td></tr>\n";
  772:     }
  773:     $analysis_html .= "</table>\n";
  774:     return $analysis_html;
  775: }
  776: 
  777: sub OR_Tries_Concept_Analysis {
  778:     my ($mintries,$maxtries,$Concepts,$respdat,$ORdata) = @_;
  779:     my %ResponseData = %$respdat;
  780:     my $analysis_html = "<table>\n";
  781:     #
  782:     # Compute the data neccessary to make the plots
  783:     my @PlotData;
  784:     # Concept analysis
  785:     #
  786:     # Note: we do not bother with characterizing the students incorrect
  787:     # answers at the concept level because an incorrect answer for one foil
  788:     # may be a correct answer for another foil.
  789:     my %ConceptData;
  790:     foreach my $concept (@{$Concepts}) {
  791:         for (my $i=$mintries;$i<=$maxtries;$i++) {
  792:             #
  793:             # Gather the per-attempt data
  794:             my $cdata = $ConceptData{$concept}->[$i];
  795:             foreach my $foilid (@{$concept->{'foils'}}) {
  796:                 $cdata->{'_correct'} += 
  797:                     $ResponseData{$foilid}->[$i]->{'_correct'};
  798:                 $cdata->{'_total'}   += 
  799:                     $ResponseData{$foilid}->[$i]->{'_total'};
  800:             }
  801:             push (@{$PlotData[$i]->{'_total'}},$cdata->{'_total'});
  802:             if ($cdata->{'_total'} == 0) {
  803:                 push (@{$PlotData[$i]->{'_correct'}},0);
  804:             } else {
  805:                 push (@{$PlotData[$i]->{'_correct'}},
  806:                       100*$cdata->{'_correct'}/$cdata->{'_total'});
  807:                 }
  808:         }
  809:     }
  810:     # Build a table for the plots
  811:     for (my $i=$mintries;$i<=$maxtries;$i++) {
  812:         my $minstu = $PlotData[$i]->{'_total'}->[0];
  813:         my $maxstu = $PlotData[$i]->{'_total'}->[0];
  814:         foreach my $count (@{$PlotData[$i]->{'_total'}}) {
  815:             if ($minstu > $count) {
  816:                 $minstu = $count;
  817:             }
  818:             if ($maxstu < $count) {
  819:                 $maxstu = $count;
  820:             }
  821:         }
  822:         $maxstu = 0 if (! defined($maxstu));
  823:         $minstu = 0 if (! defined($minstu));
  824:         my $title;
  825:         my $count = $ResponseData{'_total'}->[$i];
  826:         if ($count == 0) {
  827:             $count = 'no submissions';
  828:         } elsif ($count == 1) {
  829:             $count = '1 submission';
  830:         } else {
  831:             $count = $count.' submissions';
  832:         }
  833:         $title = 'Attempt '.$i.', '.$count;
  834:         my $graphlink = &Apache::loncommon::DrawBarGraph
  835:             ($title,'Concept Number','Percent Correct',
  836:              100,$plotcolors,undef,$PlotData[$i]->{'_correct'});
  837:         $analysis_html.= '<tr><td>'.$graphlink."</td></tr>\n";
  838:     }
  839:     $analysis_html .= "</table>\n";
  840:     return $analysis_html;
  841: }
  842: 
  843: sub OR_analyze_by_tries {
  844:     my ($r,$PerformanceData,$mintries,$maxtries) = @_;
  845:     my %Trydata;
  846:     $mintries = 1         if (! defined($mintries) || $mintries < 1);
  847:     $maxtries = $mintries if (! defined($maxtries) || $maxtries < $mintries);
  848:     foreach my $row (@$PerformanceData) {
  849:         next if (! defined($row));
  850:         my $tries = &get_tries_from_row($row);
  851:         my %Row   = &Process_OR_Row($row);
  852:         next if (! %Row);
  853:         while (my ($foilid,$href) = each(%Row)) {
  854:             if (! ref($href)) { 
  855:                 $Trydata{$foilid}->[$tries] += $href;
  856:                 next;
  857:             }
  858:             while (my ($option,$value) = each(%$href)) {
  859:                 $Trydata{$foilid}->[$tries]->{$option}+=$value;
  860:             }
  861:         }
  862:     }
  863:     return %Trydata;
  864: }
  865: 
  866: #########################################################
  867: #
  868: #     Option Response: Time Analysis
  869: #
  870: #########################################################
  871: sub OR_time_analysis {
  872:     my ($PerformanceData,$ORdata) = @_;
  873:     my ($table,$Foils,$Concepts) = &build_foil_index($ORdata);
  874:     if ((@$Concepts < 2) && ($ENV{'form.AnalyzeAs'} ne 'Foils')) {
  875:         $table = '<h3>'.
  876:             &mt('Not enough data for concept analysis.  '.
  877:                 'Performing Foil Analysis').
  878:             '</h3>'.$table;
  879:         $ENV{'form.AnalyzeAs'} = 'Foils';
  880:     }
  881:     my $num_plots = $ENV{'form.NumPlots'};
  882:     my $num_data = scalar(@$PerformanceData)-1;
  883:     my $percent = sprintf('%2f',100/$num_plots);
  884:     #
  885:     $table .= "<table>\n";
  886:     for (my $i=0;$i<$num_plots;$i++) {
  887:         ##
  888:         my $starttime = &Apache::lonhtmlcommon::get_date_from_form
  889:             ('startdate_'.$i);
  890:         my $endtime = &Apache::lonhtmlcommon::get_date_from_form
  891:             ('enddate_'.$i);
  892:         if (! defined($starttime) || ! defined($endtime)) {
  893:             my $sec_in_day = 86400;
  894:             my $last_sub_time = &get_time_from_row($PerformanceData->[-1]);
  895:             my ($sday,$smon,$syear);
  896:             (undef,undef,undef,$sday,$smon,$syear) = 
  897:                 localtime($last_sub_time - $sec_in_day*$i);
  898:             $starttime = &Time::Local::timelocal(0,0,0,$sday,$smon,$syear);
  899:             $endtime = $starttime + $sec_in_day;
  900:             if ($i == ($num_plots -1 )) {
  901:                 $starttime = &get_time_from_row($PerformanceData->[0]);
  902:             }
  903:         }
  904:         my $startdateform = &Apache::lonhtmlcommon::date_setter
  905:             ('Statistics','startdate_'.$i,$starttime);
  906:         my $enddateform = &Apache::lonhtmlcommon::date_setter
  907:             ('Statistics','enddate_'.$i,$endtime);
  908:         #
  909:         my $begin_index;
  910:         my $end_index;
  911:         my $j;
  912:         while (++$j < scalar(@$PerformanceData)) {
  913:             last if (&get_time_from_row($PerformanceData->[$j]) 
  914:                                                               > $starttime);
  915:         }
  916:         $begin_index = $j;
  917:         while (++$j < scalar(@$PerformanceData)) {
  918:             last if (&get_time_from_row($PerformanceData->[$j]) > $endtime);
  919:         }
  920:         $end_index = $j;
  921:         ##
  922:         my $interval = {
  923:             begin_index => $begin_index,
  924:             end_index   => $end_index,
  925:             startdateform => $startdateform,
  926:             enddateform   => $enddateform,
  927:         };
  928:         if ($ENV{'form.AnalyzeAs'} eq 'Foils') {
  929:             $table .= &OR_Foil_Time_Analysis($PerformanceData,$ORdata,$Foils,
  930:                                           $interval);
  931:         } else {
  932:             $table .= &OR_Concept_Time_Analysis($PerformanceData,$ORdata,
  933:                                              $Concepts,$interval);
  934:         }
  935:     }
  936:     #
  937:     return $table;
  938: }
  939: 
  940: sub OR_Foil_Time_Analysis {
  941:     my ($PerformanceData,$ORdata,$Foils,$interval) = @_;
  942:     my $analysis_html;
  943:     my $foilkey = &build_option_index($ORdata);
  944:     my ($begin_index,$end_index) = ($interval->{'begin_index'},
  945:                                     $interval->{'end_index'});
  946:     my %TimeData;
  947:     #
  948:     # Compute the number getting the foils correct or incorrects
  949:     for (my $j=$begin_index;$j<=$end_index;$j++) {
  950:         my $row = $PerformanceData->[$j];
  951:         next if (! defined($row));
  952:         my %Row = &Process_OR_Row($row);
  953:         while (my ($foilid,$href) = each(%Row)) {
  954:             if (! ref($href)) {
  955:                 $TimeData{$foilid} += $href;
  956:                 next;
  957:             }
  958:             while (my ($option,$value) = each(%$href)) {
  959:                 $TimeData{$foilid}->{$option}+=$value;
  960:             }
  961:         }
  962:     }
  963:     my @Plotdata;
  964:     foreach my $foil (@$Foils) {
  965:         my $total = $TimeData{$foil}->{'_total'};
  966:         if ($total == 0) {
  967:             push(@{$Plotdata[0]},0);
  968:         } else {
  969:             push(@{$Plotdata[0]},
  970:                  100 * $TimeData{$foil}->{'_correct'} / $total);
  971:         }
  972:         my $total_incorrect = $total - $TimeData{$foil}->{'_correct'};
  973:         my $optionidx = 1;
  974:         foreach my $option (@{$ORdata->{'_Options'}}) {
  975:             if ($total_incorrect == 0) {
  976:                 push(@{$Plotdata[$optionidx]},0);
  977:             } else {
  978:                 push(@{$Plotdata[$optionidx]},
  979:                      100 * $TimeData{$foil}->{$option} / $total_incorrect);
  980:             }
  981:         } continue {
  982:             $optionidx++;
  983:         }
  984:     }
  985:     #
  986:     # Create the plot
  987:     my $count = $end_index-$begin_index;
  988:     my $title;
  989:     if ($count == 0) {
  990:         $title = 'no submissions';
  991:     } elsif ($count == 1) {
  992:         $title = 'one submission';
  993:     } else {
  994:         $title = $count.' submissions';
  995:     }
  996:     my $correctplot = &Apache::loncommon::DrawBarGraph($title,
  997:                                                        'Foil Number',
  998:                                                        'Percent Correct',
  999:                                                        100,
 1000:                                                        $plotcolors,
 1001:                                                        undef,
 1002:                                                        $Plotdata[0]);
 1003:     for (my $j=0; $j< scalar(@{$Plotdata[0]});$j++) {
 1004:         $Plotdata[0]->[$j]=0;
 1005:     }
 1006:     $count = $end_index-$begin_index-$TimeData{'_correct'};
 1007:     if ($count == 0) {
 1008:         $title = 'no submissions';
 1009:     } elsif ($count == 1) {
 1010:         $title = 'one submission';
 1011:     } else {
 1012:         $title = $count.' submissions';
 1013:     }
 1014:     my $incorrectplot = &Apache::loncommon::DrawBarGraph($title,
 1015:                                                  'Foil Number',
 1016:                                                  'Incorrect Option Choice',
 1017:                                                  100,
 1018:                                                  $plotcolors,
 1019:                                                  undef,
 1020:                                                  @Plotdata);        
 1021:     $analysis_html.='<tr>'.
 1022:         '<td>'.$correctplot.'</td>'.
 1023:         '<td>'.$incorrectplot.'</td>'.
 1024:         '<td align="left" valign="top">'.$foilkey.'</td>'."</tr>\n";
 1025:     $analysis_html.= '<tr>'.'<td colspan="3">'.
 1026:         '<b>Start Time</b>:'.
 1027:         ' &nbsp;'.$interval->{'startdateform'}.'<br />'.
 1028:         '<b>End Time</b>&nbsp;&nbsp;: '.
 1029:         '&nbsp;'.$interval->{'enddateform'}.'<br />'.
 1030: #        '<b>Plot Title</b>&nbsp;&nbsp;:'.
 1031: #        ("&nbsp;"x3).$interval->{'titleform'}.
 1032:         '</td>'.
 1033:         "</tr>\n";
 1034:     return $analysis_html;
 1035: }
 1036: 
 1037: sub OR_Concept_Time_Analysis {
 1038:     my ($PerformanceData,$ORdata,$Concepts,$interval) = @_;
 1039:     my $analysis_html;
 1040:     ##
 1041:     ## Determine starttime, endtime, startindex, endindex
 1042:     my ($begin_index,$end_index) = ($interval->{'begin_index'},
 1043:                                     $interval->{'end_index'});
 1044:     my %TimeData;
 1045:     #
 1046:     # Compute the number getting the foils correct or incorrects
 1047:     for (my $j=$begin_index;$j<=$end_index;$j++) {
 1048:         my $row = $PerformanceData->[$j];
 1049:         next if (! defined($row));
 1050:         my %Row = &Process_OR_Row($row);
 1051:         while (my ($foilid,$href) = each(%Row)) {
 1052:             if (! ref($href)) {
 1053:                 $TimeData{$foilid} += $href;
 1054:                 next;
 1055:             }
 1056:             while (my ($option,$value) = each(%$href)) {
 1057:                 $TimeData{$foilid}->{$option}+=$value;
 1058:             }
 1059:         }
 1060:     }
 1061:     #
 1062:     # Put the data in plottable form
 1063:     my @Plotdata;
 1064:     foreach my $concept (@$Concepts) {
 1065:         my ($total,$correct);
 1066:         foreach my $foil (@{$concept->{'foils'}}) {
 1067:             $total += $TimeData{$foil}->{'_total'};
 1068:             $correct += $TimeData{$foil}->{'_correct'};
 1069:         }
 1070:         if ($total == 0) {
 1071:             push(@Plotdata,0);
 1072:         } else {
 1073:             push(@Plotdata,100 * $correct / $total);
 1074:         }
 1075:     }
 1076:     #
 1077:     # Create the plot
 1078:     my $title = ($end_index - $begin_index).' submissions';
 1079:     my $correctplot = &Apache::loncommon::DrawBarGraph($title,
 1080:                                                     'Concept Number',
 1081:                                                     'Percent Correct',
 1082:                                                     100,
 1083:                                                     $plotcolors,
 1084:                                                     undef,
 1085:                                                     \@Plotdata);
 1086:     $analysis_html.='<tr>'.
 1087:         '<td>'.$correctplot.'</td>'.
 1088:         '<td align="left" valign="top">'.
 1089:         '<b>Start Time</b>: &nbsp;'.$interval->{'startdateform'}.'<br />'.
 1090:         '<b>End Time</b>&nbsp;&nbsp;: '.
 1091:            '&nbsp;'.$interval->{'enddateform'}.'<br />'.
 1092: #        '<b>Plot Title</b>&nbsp;&nbsp;:'.("&nbsp;"x3).
 1093: #            $interval->{'titleform'}.
 1094:         '</td>'.
 1095:         "</tr>\n";
 1096:     return $analysis_html;
 1097: }
 1098: 
 1099: #########################################################
 1100: #########################################################
 1101: ##
 1102: ##             Excel output 
 1103: ##
 1104: #########################################################
 1105: #########################################################
 1106: sub OR_excel_sheet {
 1107:     my ($r,$resource,$PerformanceData,$ORdata) = @_;
 1108:     my $response = '';
 1109:     my (undef,$Foils,$Concepts) = &build_foil_index($ORdata);
 1110:     #
 1111:     # Create excel worksheet
 1112:     my $filename = '/prtspool/'.
 1113:         $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
 1114:         time.'_'.rand(1000000000).'.xls';
 1115:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
 1116:     if (! defined($workbook)) {
 1117:         $r->log_error("Error creating excel spreadsheet $filename: $!");
 1118:         $r->print('<p>'.&mt("Unable to create new Excel file.  ".
 1119:                             "This error has been logged.  ".
 1120:                             "Please alert your LON-CAPA administrator").
 1121:                   '</p>');
 1122:         return undef;
 1123:     }
 1124:     #
 1125:     $workbook->set_tempdir('/home/httpd/perl/tmp');
 1126:     my $format = &Apache::loncommon::define_excel_formats($workbook);
 1127:     #
 1128:     # Create and populate main worksheets
 1129:     my $problem_data_sheet  = $workbook->addworksheet('Problem Data');
 1130:     my $student_data_sheet = &build_student_data_worksheet($workbook,$format);
 1131:     my $response_data_sheet = $workbook->addworksheet('Response Data');
 1132:     foreach my $sheet ($problem_data_sheet,$student_data_sheet,
 1133:                        $response_data_sheet) {
 1134:         $sheet->write(0,0,$resource->{'title'},$format->{'h2'});
 1135:         $sheet->write(1,0,$resource->{'src'},$format->{'h3'});
 1136:     }
 1137:     #
 1138:     my $result;
 1139:     $result = &OR_build_problem_data_worksheet($problem_data_sheet,$format,
 1140:                                             $Concepts,$ORdata);
 1141:     if ($result ne 'okay') {
 1142:         # Do something useful
 1143:     }
 1144:     $result = &OR_build_response_data_worksheet($response_data_sheet,$format,
 1145:                                              $PerformanceData,$Foils,
 1146:                                              $ORdata);
 1147:     if ($result ne 'okay') {
 1148:         # Do something useful
 1149:     }
 1150:     $response_data_sheet->activate();
 1151:     #
 1152:     # Close the excel file
 1153:     $workbook->close();
 1154:     #
 1155:     # Write a link to allow them to download it
 1156:     $result .= '<h2>'.&mt('Excel Raw Data Output').'</h2>'.
 1157:               '<p><a href="'.$filename.'">'.
 1158:               &mt('Your Excel spreadsheet.').
 1159:               '</a></p>'."\n";
 1160:     return $result;
 1161: }
 1162: 
 1163: sub OR_build_problem_data_worksheet {
 1164:     my ($worksheet,$format,$Concepts,$ORdata) = @_;
 1165:     my $rows_output = 3;
 1166:     my $cols_output = 0;
 1167:     $worksheet->write($rows_output++,0,'Problem Structure',$format->{'h3'});
 1168:     ##
 1169:     ##
 1170:     my @Headers;
 1171:     if (@$Concepts > 1) {
 1172:         @Headers = ("Concept\nNumber",'Concept',"Foil\nNumber",
 1173:                     'Foil Name','Foil Text','Correct value');
 1174:     } else {
 1175:         @Headers = ('Foil Number','FoilName','Foil Text','Correct value');
 1176:     }
 1177:     $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
 1178:     my %Foildata = %{$ORdata->{'_Foils'}};
 1179:     my $conceptindex = 1;
 1180:     my $foilindex = 1;
 1181:     foreach my $concept (@$Concepts) {
 1182:         my @FoilsInConcept = @{$concept->{'foils'}};
 1183:         my $firstfoil = shift(@FoilsInConcept);
 1184:         if (@$Concepts > 1) {
 1185:             $worksheet->write_row($rows_output++,0,
 1186:                                   [$conceptindex,
 1187:                                    $concept->{'name'},
 1188:                                    $foilindex++,
 1189:                                    $Foildata{$firstfoil}->{'name'},
 1190:                                    $Foildata{$firstfoil}->{'text'},
 1191:                                    $Foildata{$firstfoil}->{'value'},]);
 1192:         } else {
 1193:             $worksheet->write_row($rows_output++,0,
 1194:                                   [ $foilindex++,
 1195:                                     $Foildata{$firstfoil}->{'name'},
 1196:                                     $Foildata{$firstfoil}->{'text'},
 1197:                                     $Foildata{$firstfoil}->{'value'},]);
 1198:         }
 1199:         foreach my $foilid (@FoilsInConcept) {
 1200:             if (@$Concepts > 1) {
 1201:                 $worksheet->write_row($rows_output++,0,
 1202:                                       ['',
 1203:                                        '',
 1204:                                        $foilindex,
 1205:                                        $Foildata{$foilid}->{'name'},
 1206:                                        $Foildata{$foilid}->{'text'},
 1207:                                        $Foildata{$foilid}->{'value'},]);
 1208:             } else {
 1209:                 $worksheet->write_row($rows_output++,0,                
 1210:                                       [$foilindex,
 1211:                                        $Foildata{$foilid}->{'name'},
 1212:                                        $Foildata{$foilid}->{'text'},
 1213:                                        $Foildata{$foilid}->{'value'},]);
 1214:             }                
 1215:         } continue {
 1216:             $foilindex++;
 1217:         }
 1218:     } continue {
 1219:         $conceptindex++;
 1220:     }
 1221:     $rows_output++;
 1222:     $rows_output++;
 1223:     ##
 1224:     ## Option data output
 1225:     $worksheet->write($rows_output++,0,'Options',$format->{'header'});
 1226:     foreach my $string (@{$ORdata->{'_Options'}}) {
 1227:         $worksheet->write($rows_output++,0,$string);
 1228:     }
 1229:     return 'okay';
 1230: }
 1231: 
 1232: sub OR_build_response_data_worksheet {
 1233:     my ($worksheet,$format,$PerformanceData,$Foils,$ORdata)=@_;
 1234:     my $rows_output = 3;
 1235:     my $cols_output = 0;
 1236:     $worksheet->write($rows_output++,0,'Response Data',$format->{'h3'});
 1237:     $worksheet->set_column(1,1,20);
 1238:     $worksheet->set_column(2,2,13);
 1239:     my @Headers = ('identifier','time','award detail','attempt');
 1240:     foreach my $foil (@$Foils) {
 1241:         push (@Headers,$foil.' submission');
 1242:         push (@Headers,$foil.' grading');
 1243:     }
 1244:     $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
 1245:     #
 1246:     foreach my $row (@$PerformanceData) {
 1247:         next if (! defined($row));
 1248:         my ($student,$award,$grading,$submission,$time,$tries) = @$row;
 1249:         my @Foilgrades = split('&',$grading);
 1250:         my @Foilsubs   = split('&',$submission);
 1251:         my %ResponseData;
 1252:         for (my $j=0;$j<=$#Foilgrades;$j++) {
 1253:             my ($foilid,$correct)  = split('=',$Foilgrades[$j]);
 1254:             my (undef,$submission) = split('=',$Foilsubs[$j]);
 1255:             $submission = &Apache::lonnet::unescape($submission);
 1256:             $ResponseData{$foilid.' submission'}=$submission;
 1257:             $ResponseData{$foilid.' award'}=$correct;
 1258:         }
 1259:         $worksheet->write($rows_output,$cols_output++,$student);
 1260:         $worksheet->write($rows_output,$cols_output++,
 1261:                           &calc_serial($time),$format->{'date'});
 1262:         $worksheet->write($rows_output,$cols_output++,$award);
 1263:         $worksheet->write($rows_output,$cols_output++,$tries);
 1264:         foreach my $foilid (@$Foils) {
 1265:             $worksheet->write($rows_output,$cols_output++,
 1266:                               $ResponseData{$foilid.' submission'});
 1267:             $worksheet->write($rows_output,$cols_output++,
 1268:                               $ResponseData{$foilid.' award'});
 1269:         }
 1270:         $rows_output++;
 1271:         $cols_output = 0;
 1272:     }
 1273:     return;
 1274: }
 1275: 
 1276: 
 1277: ##
 1278: ## The following is copied from datecalc1.pl, part of the 
 1279: ## Spreadsheet::WriteExcel CPAN module.
 1280: ##
 1281: ##
 1282: ######################################################################
 1283: #
 1284: # Demonstration of writing date/time cells to Excel spreadsheets,
 1285: # using UNIX/Perl time as source of date/time.
 1286: #
 1287: # Copyright 2000, Andrew Benham, adsb@bigfoot.com
 1288: #
 1289: ######################################################################
 1290: #
 1291: # UNIX/Perl time is the time since the Epoch (00:00:00 GMT, 1 Jan 1970)
 1292: # measured in seconds.
 1293: #
 1294: # An Excel file can use exactly one of two different date/time systems.
 1295: # In these systems, a floating point number represents the number of days
 1296: # (and fractional parts of the day) since a start point. The floating point
 1297: # number is referred to as a 'serial'.
 1298: # The two systems ('1900' and '1904') use different starting points:
 1299: #  '1900'; '1.00' is 1 Jan 1900 BUT 1900 is erroneously regarded as
 1300: #          a leap year - see:
 1301: #            http://support.microsoft.com/support/kb/articles/Q181/3/70.asp
 1302: #          for the excuse^H^H^H^H^H^Hreason.
 1303: #  '1904'; '1.00' is 2 Jan 1904.
 1304: #
 1305: # The '1904' system is the default for Apple Macs. Windows versions of
 1306: # Excel have the option to use the '1904' system.
 1307: #
 1308: # Note that Visual Basic's "DateSerial" function does NOT erroneously
 1309: # regard 1900 as a leap year, and thus its serials do not agree with
 1310: # the 1900 serials of Excel for dates before 1 Mar 1900.
 1311: #
 1312: # Note that StarOffice (at least at version 5.2) does NOT erroneously
 1313: # regard 1900 as a leap year, and thus its serials do not agree with
 1314: # the 1900 serials of Excel for dates before 1 Mar 1900.
 1315: #
 1316: ######################################################################
 1317: #
 1318: # Calculation description
 1319: # =======================
 1320: #
 1321: # 1900 system
 1322: # -----------
 1323: # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 70 years after 1 Jan 1900.
 1324: # Of those 70 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68)
 1325: # were leap years with an extra day.
 1326: # Thus there were 17 + 70*365 days = 25567 days between 1 Jan 1900 and
 1327: # 1 Jan 1970.
 1328: # In the 1900 system, '1' is 1 Jan 1900, but as 1900 was not a leap year
 1329: # 1 Jan 1900 should really be '2', so 1 Jan 1970 is '25569'.
 1330: #
 1331: # 1904 system
 1332: # -----------
 1333: # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 66 years after 1 Jan 1904.
 1334: # Of those 66 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68)
 1335: # were leap years with an extra day.
 1336: # Thus there were 17 + 66*365 days = 24107 days between 1 Jan 1904 and
 1337: # 1 Jan 1970.
 1338: # In the 1904 system, 2 Jan 1904 being '1', 1 Jan 1970 is '24107'.
 1339: #
 1340: ######################################################################
 1341: #
 1342: # Copyright (c) 2000, Andrew Benham.
 1343: # This program is free software. It may be used, redistributed and/or
 1344: # modified under the same terms as Perl itself.
 1345: #
 1346: # Andrew Benham, adsb@bigfoot.com
 1347: # London, United Kingdom
 1348: # 11 Nov 2000
 1349: #
 1350: ######################################################################
 1351: 
 1352: # Use 1900 date system on all platforms other than Apple Mac (for which
 1353: # use 1904 date system).
 1354: my $DATE_SYSTEM = ($^O eq 'MacOS') ? 1 : 0;
 1355: 
 1356: #-----------------------------------------------------------
 1357: # calc_serial()
 1358: #
 1359: # Called with (up to) 2 parameters.
 1360: #   1.  Unix timestamp.  If omitted, uses current time.
 1361: #   2.  GMT flag. Set to '1' to return serial in GMT.
 1362: #       If omitted, returns serial in appropriate timezone.
 1363: #
 1364: # Returns date/time serial according to $DATE_SYSTEM selected
 1365: #-----------------------------------------------------------
 1366: sub calc_serial {
 1367:         my $time = (defined $_[0]) ? $_[0] : time();
 1368:         my $gmtflag = (defined $_[1]) ? $_[1] : 0;
 1369: 
 1370:         # Divide timestamp by number of seconds in a day.
 1371:         # This gives a date serial with '0' on 1 Jan 1970.
 1372:         my $serial = $time / 86400;
 1373: 
 1374:         # Adjust the date serial by the offset appropriate to the
 1375:         # currently selected system (1900/1904).
 1376:         if ($DATE_SYSTEM == 0) {        # use 1900 system
 1377:                 $serial += 25569;
 1378:         } else {                        # use 1904 system
 1379:                 $serial += 24107;
 1380:         }
 1381: 
 1382:         unless ($gmtflag) {
 1383:                 # Now have a 'raw' serial with the right offset. But this
 1384:                 # gives a serial in GMT, which is false unless the timezone
 1385:                 # is GMT. We need to adjust the serial by the appropriate
 1386:                 # timezone offset.
 1387:                 # Calculate the appropriate timezone offset by seeing what
 1388:                 # the differences between localtime and gmtime for the given
 1389:                 # time are.
 1390: 
 1391:                 my @gmtime = gmtime($time);
 1392:                 my @ltime  = localtime($time);
 1393: 
 1394:                 # For the first 7 elements of the two arrays, adjust the
 1395:                 # date serial where the elements differ.
 1396:                 for (0 .. 6) {
 1397:                         my $diff = $ltime[$_] - $gmtime[$_];
 1398:                         if ($diff) {
 1399:                                 $serial += _adjustment($diff,$_);
 1400:                         }
 1401:                 }
 1402:         }
 1403: 
 1404:         # Perpetuate the error that 1900 was a leap year by decrementing
 1405:         # the serial if we're using the 1900 system and the date is prior to
 1406:         # 1 Mar 1900. This has the effect of making serial value '60'
 1407:         # 29 Feb 1900.
 1408: 
 1409:         # This fix only has any effect if UNIX/Perl time on the platform
 1410:         # can represent 1900. Many can't.
 1411: 
 1412:         unless ($DATE_SYSTEM) {
 1413:                 $serial-- if ($serial < 61);    # '61' is 1 Mar 1900
 1414:         }
 1415:         return $serial;
 1416: }
 1417: 
 1418: sub _adjustment {
 1419:         # Based on the difference in the localtime/gmtime array elements
 1420:         # number, return the adjustment required to the serial.
 1421: 
 1422:         # We only look at some elements of the localtime/gmtime arrays:
 1423:         #    seconds    unlikely to be different as all known timezones
 1424:         #               have an offset of integral multiples of 15 minutes,
 1425:         #               but it's easy to do.
 1426:         #    minutes    will be different for timezone offsets which are
 1427:         #               not an exact number of hours.
 1428:         #    hours      very likely to be different.
 1429:         #    weekday    will differ when localtime/gmtime difference
 1430:         #               straddles midnight.
 1431:         #
 1432:         # Assume that difference between localtime and gmtime is less than
 1433:         # 5 days, then don't have to do maths for day of month, month number,
 1434:         # year number, etc...
 1435: 
 1436:         my ($delta,$element) = @_;
 1437:         my $adjust = 0;
 1438: 
 1439:         if ($element == 0) {            # Seconds
 1440:                 $adjust = $delta/86400;         # 60 * 60 * 24
 1441:         } elsif ($element == 1) {       # Minutes
 1442:                 $adjust = $delta/1440;          # 60 * 24
 1443:         } elsif ($element == 2) {       # Hours
 1444:                 $adjust = $delta/24;            # 24
 1445:         } elsif ($element == 6) {       # Day of week number
 1446:                 # Catch difference straddling Sat/Sun in either direction
 1447:                 $delta += 7 if ($delta < -4);
 1448:                 $delta -= 7 if ($delta > 4);
 1449: 
 1450:                 $adjust = $delta;
 1451:         }
 1452:         return $adjust;
 1453: }
 1454: 
 1455: sub build_foil_index {
 1456:     my ($ORdata) = @_;
 1457:     return if (! exists($ORdata->{'_Foils'}));
 1458:     my %Foildata = %{$ORdata->{'_Foils'}};
 1459:     my @Foils = sort(keys(%Foildata));
 1460:     my %Concepts;
 1461:     foreach my $foilid (@Foils) {
 1462:         push(@{$Concepts{$Foildata{$foilid}->{'_Concept'}}},
 1463:              $foilid);
 1464:     }
 1465:     undef(@Foils);
 1466:     # Having gathered the concept information in a hash, we now translate it
 1467:     # into an array because we need to be consistent about order.
 1468:     # Also put the foils in order, too.
 1469:     my $sortfunction = sub {
 1470:         my %Numbers = (one   => 1,
 1471:                        two   => 2,
 1472:                        three => 3,
 1473:                        four  => 4,
 1474:                        five  => 5,
 1475:                        six   => 6,
 1476:                        seven => 7,
 1477:                        eight => 8,
 1478:                        nine  => 9,
 1479:                        ten   => 10,);
 1480:         my $a1 = lc($a); 
 1481:         my $b1 = lc($b);
 1482:         if (exists($Numbers{$a1})) {
 1483:             $a1 = $Numbers{$a1};
 1484:         }
 1485:         if (exists($Numbers{$b1})) {
 1486:             $b1 = $Numbers{$b1};
 1487:         }
 1488:         if (($a1 =~/^\d+$/) && ($b1 =~/^\d+$/)) {
 1489:             return $a1 <=> $b1;
 1490:         } else {
 1491:             return $a1 cmp $b1;
 1492:         }
 1493:     };
 1494:     my @Concepts;
 1495:     foreach my $concept (sort $sortfunction (keys(%Concepts))) {
 1496:         if (! defined($Concepts{$concept})) {
 1497:             $Concepts{$concept}=[];
 1498: #            next;
 1499:         }
 1500:         push(@Concepts,{ name => $concept,
 1501:                         foils => [@{$Concepts{$concept}}]});
 1502:         push(@Foils,(@{$Concepts{$concept}}));
 1503:     }
 1504:     #
 1505:     # Build up the table of row labels.
 1506:     my $table = '<table border="1" >'."\n";
 1507:     if (@Concepts > 1) {
 1508:         $table .= '<tr>'.
 1509:             '<th>'.&mt('Concept Number').'</th>'.
 1510:             '<th>'.&mt('Concept').'</th>'.
 1511:             '<th>'.&mt('Foil Number').'</th>'.
 1512:             '<th>'.&mt('Foil Name').'</th>'.
 1513:             '<th>'.&mt('Foil Text').'</th>'.
 1514:             '<th>'.&mt('Correct Value').'</th>'.
 1515:             "</tr>\n";
 1516:     } else {
 1517:         $table .= '<tr>'.
 1518:             '<th>'.&mt('Foil Number').'</th>'.
 1519:             '<th>'.&mt('Foil Name').'</th>'.
 1520:             '<th>'.&mt('Foil Text').'</th>'.
 1521:             '<th>'.&mt('Correct Value').'</th>'.
 1522:             "</tr>\n";
 1523:     }        
 1524:     my $conceptindex = 1;
 1525:     my $foilindex = 1;
 1526:     foreach my $concept (@Concepts) {
 1527:         my @FoilsInConcept = @{$concept->{'foils'}};
 1528:         my $firstfoil = shift(@FoilsInConcept);
 1529:         if (@Concepts > 1) {
 1530:             $table .= '<tr>'.
 1531:                 '<td>'.$conceptindex.'</td>'.
 1532:                 '<td>'.&HTML::Entities::encode($concept->{'name'}).'</td>'.
 1533:                 '<td>'.$foilindex++.'</td>'.
 1534:                 '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'}).'</td>'.
 1535:                 '<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.
 1536:                 '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'}).'</td>'.
 1537:                 "</tr>\n";
 1538:         } else {
 1539:             $table .= '<tr>'.
 1540:                 '<td>'.$foilindex++.'</td>'.
 1541:                 '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'}).'</td>'.
 1542:                 '<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.
 1543:                 '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'}).'</td>'.
 1544:                 "</tr>\n";
 1545:         }
 1546:         foreach my $foilid (@FoilsInConcept) {
 1547:             if (@Concepts > 1) {
 1548:                 $table .= '<tr>'.
 1549:                     '<td></td>'.
 1550:                     '<td></td>'.
 1551:                     '<td>'.$foilindex.'</td>'.
 1552:                     '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'name'}).'</td>'.
 1553:                     '<td>'.$Foildata{$foilid}->{'text'}.'</td>'.
 1554:                     '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'value'}).'</td>'.
 1555:                     "</tr>\n";
 1556:             } else {
 1557:                 $table .= '<tr>'.
 1558:                     '<td>'.$foilindex.'</td>'.
 1559:                     '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'name'}).'</td>'.
 1560:                     '<td>'.$Foildata{$foilid}->{'text'}.'</td>'.
 1561:                     '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'value'}).'</td>'.
 1562:                     "</tr>\n";
 1563:             }                
 1564:         } continue {
 1565:             $foilindex++;
 1566:         }
 1567:     } continue {
 1568:         $conceptindex++;
 1569:     }
 1570:     $table .= "</table>\n";
 1571:     #
 1572:     # Build option index with color stuff
 1573:     return ($table,\@Foils,\@Concepts);
 1574: }
 1575: 
 1576: sub build_option_index {
 1577:     my ($ORdata)= @_;
 1578:     my $table = "<table>\n";
 1579:     my $optionindex = 0;
 1580:     my @Rows;
 1581:     foreach my $option (&mt('correct option chosen'),@{$ORdata->{'_Options'}}) {
 1582:         push (@Rows,
 1583:               '<tr>'.
 1584:               '<td bgcolor="'.$plotcolors->[$optionindex++].'">'.
 1585:               ('&nbsp;'x4).'</td>'.
 1586:               '<td>'.&HTML::Entities::encode($option).'</td>'.
 1587:               "</tr>\n");
 1588:     }
 1589:     shift(@Rows); # Throw away 'correct option chosen' color
 1590:     $table .= join('',reverse(@Rows));
 1591:     $table .= "</table>\n";
 1592: }
 1593: 
 1594: #########################################################
 1595: #########################################################
 1596: ##
 1597: ##   Generic Interface Routines
 1598: ##
 1599: #########################################################
 1600: #########################################################
 1601: sub CreateInterface {
 1602:     ##
 1603:     ## Environment variable initialization
 1604:     if (! exists$ENV{'form.AnalyzeOver'}) {
 1605:         $ENV{'form.AnalyzeOver'} = 'Tries';
 1606:     }
 1607:     ##
 1608:     ## Build the menu
 1609:     my $Str = '';
 1610:     $Str .= '<table cellspacing="5">'."\n";
 1611:     $Str .= '<tr>';
 1612:     $Str .= '<td align="center"><b>'.&mt('Sections').'</b></td>';
 1613:     $Str .= '<td align="center"><b>'.&mt('Enrollment Status').'</b></td>';
 1614: #    $Str .= '<td align="center"><b>'.&mt('Sequences and Folders').'</b></td>';
 1615:     $Str .= '<td align="center">&nbsp;</td>';
 1616:     $Str .= '</tr>'."\n";
 1617:     ##
 1618:     ## 
 1619:     $Str .= '<tr><td align="center">'."\n";
 1620:     $Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
 1621:     $Str .= '</td>';
 1622:     #
 1623:     $Str .= '<td align="center">';
 1624:     $Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5);
 1625:     $Str .= '</td>';
 1626:     #
 1627: #    $Str .= '<td align="center">';
 1628:     my $only_seq_with_assessments = sub { 
 1629:         my $s=shift;
 1630:         if ($s->{'num_assess'} < 1) { 
 1631:             return 0;
 1632:         } else { 
 1633:             return 1;
 1634:         }
 1635:     };
 1636:     &Apache::lonstatistics::MapSelect('Maps','multiple,all',5,
 1637:                                               $only_seq_with_assessments);
 1638:     ##
 1639:     ##
 1640:     $Str .= '<td>';
 1641:     { # These braces are here to organize the code, not scope it.
 1642:         {
 1643:             $Str .= '<nobr>'.&mt('Analyze Over ');
 1644:             $Str .= &Apache::loncommon::help_open_topic
 1645:                                                   ('Analysis_Analyze_Over');
 1646:             $Str .='<select name="AnalyzeOver" >';
 1647:             $Str .= '<option value="Tries" ';
 1648:             if (! exists($ENV{'form.AnalyzeOver'}) || 
 1649:                 $ENV{'form.AnalyzeOver'} eq 'Tries'){
 1650:                 # Default to Tries
 1651:                 $Str .= ' selected ';
 1652:             }
 1653:             $Str .= '>'.&mt('Tries').'</option>';
 1654:             $Str .= '<option value="Time" ';
 1655:             $Str .= ' selected ' if ($ENV{'form.AnalyzeOver'} eq 'Time');
 1656:             $Str .= '>'.&mt('Time').'</option>';
 1657:             $Str .= '</select>';
 1658:             $Str .= '</nobr><br />';
 1659:         }
 1660:         {
 1661:             $Str .= '<nobr>'.&mt('Analyze as ');
 1662:             $Str .= &Apache::loncommon::help_open_topic
 1663:                                                   ('Analysis_Analyze_as');
 1664:             $Str .='<select name="AnalyzeAs" >';
 1665:             $Str .= '<option value="Concepts" ';
 1666:             if (! exists($ENV{'form.AnalyzeAs'}) || 
 1667:                 $ENV{'form.AnalyzeAs'} eq 'Concepts'){
 1668:                 # Default to Concepts
 1669:                 $Str .= ' selected ';
 1670:             }
 1671:             $Str .= '>'.&mt('Concepts').'</option>';
 1672:             $Str .= '<option value="Foils" ';
 1673:             $Str .= ' selected ' if ($ENV{'form.AnalyzeAs'} eq 'Foils');
 1674:             $Str .= '>'.&mt('Foils').'</option>';
 1675:             $Str .= '</select></nobr><br />';
 1676:         }
 1677:         {
 1678:             $Str .= '<br /><nobr>'.&mt('Number of Plots:');
 1679:             $Str .= &Apache::loncommon::help_open_topic
 1680:                                                   ('Analysis_num_plots');
 1681:             $Str .= '<select name="NumPlots">';
 1682:             if (! exists($ENV{'form.NumPlots'}) 
 1683:                 || $ENV{'form.NumPlots'} < 1 
 1684:                 || $ENV{'form.NumPlots'} > 20) {
 1685:                 $ENV{'form.NumPlots'} = 5;
 1686:             }
 1687:             foreach my $i (1,2,3,4,5,6,7,8,10,15,20) {
 1688:                 $Str .= '<option value="'.$i.'" ';
 1689:                 if ($ENV{'form.NumPlots'} == $i) { $Str.=' selected '; }
 1690:                 $Str .= '>'.$i.'</option>';
 1691:             }
 1692:             $Str .= '</select></nobr>';
 1693:         }
 1694:     }
 1695:     $Str .= '</td>';
 1696:     ##
 1697:     ##
 1698:     $Str .= '</tr>'."\n";
 1699:     $Str .= '</table>'."\n";
 1700:     return $Str;
 1701: }
 1702: 
 1703: #########################################################
 1704: #########################################################
 1705: ##
 1706: ##              Misc Option Response functions
 1707: ##
 1708: #########################################################
 1709: #########################################################
 1710: sub get_time_from_row {
 1711:     my ($row) = @_;
 1712:     if (ref($row)) {
 1713:         return $row->[&Apache::loncoursedata::RD_timestamp()];
 1714:     } 
 1715:     return undef;
 1716: }
 1717: 
 1718: sub get_tries_from_row {
 1719:     my ($row) = @_;
 1720:     if (ref($row)) {
 1721:         return $row->[&Apache::loncoursedata::RD_tries()];
 1722:     }
 1723:     return undef;
 1724: }
 1725: 
 1726: sub hashify_attempt {
 1727:     my ($row) = @_;
 1728:     my %attempt;
 1729:     $attempt{'tries'}      = $row->[&Apache::loncoursedata::RD_tries()];
 1730:     $attempt{'submission'} = $row->[&Apache::loncoursedata::RD_submission()];
 1731:     $attempt{'award'}      = $row->[&Apache::loncoursedata::RD_awarddetail()];
 1732:     $attempt{'timestamp'}  = $row->[&Apache::loncoursedata::RD_timestamp()];
 1733:     return %attempt;
 1734: }
 1735: 
 1736: sub Process_OR_Row {
 1737:     my ($row) = @_;
 1738:     my %RowData;
 1739:     my $student_id = $row->[&Apache::loncoursedata::RD_student_id()];
 1740:     my $award      = $row->[&Apache::loncoursedata::RD_awarddetail()];
 1741:     my $grading    = $row->[&Apache::loncoursedata::RD_response_eval()];
 1742:     my $submission = $row->[&Apache::loncoursedata::RD_submission()];
 1743:     my $time       = $row->[&Apache::loncoursedata::RD_timestamp()];
 1744:     my $tries      = $row->[&Apache::loncoursedata::RD_tries()];
 1745:     return undef if ($award eq 'MISSING_ANSWER');
 1746:     if ($award =~ /(APPROX_ANS|EXACT_ANS)/) {
 1747:         $RowData{'_correct'} = 1;
 1748:     }
 1749:     $RowData{'_total'} = 1;
 1750:     my @Foilgrades = split('&',$grading);
 1751:     my @Foilsubs   = split('&',$submission);
 1752:     for (my $j=0;$j<=$#Foilgrades;$j++) {
 1753:         my ($foilid,$correct)  = split('=',$Foilgrades[$j]);
 1754:         $foilid = &Apache::lonnet::unescape($foilid);
 1755:         my (undef,$submission) = split('=',$Foilsubs[$j]);
 1756:         if ($correct) {
 1757:             $RowData{$foilid}->{'_correct'}++;
 1758:         } else {
 1759:             $submission = &Apache::lonnet::unescape($submission);
 1760:             $RowData{$foilid}->{$submission}++;
 1761:         }
 1762:         $RowData{$foilid}->{'_total'}++;
 1763:     }
 1764:     return %RowData;
 1765: }
 1766: 
 1767: 
 1768: sub analyze_problem_as_student {
 1769:     my ($resource,$sname,$sdom,$partid,$respid) = @_;
 1770:     my $url = $resource->{'src'};
 1771:     my $symb = $resource->{'symb'};
 1772:     my $courseid = $ENV{'request.course.id'};
 1773:     my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze',
 1774:                                         'grade_domain' => $sdom,
 1775:                                         'grade_username' => $sname,
 1776:                                         'grade_symb' => $symb,
 1777:                                         'grade_courseid' => $courseid));
 1778:     (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
 1779:     my %Answer=&Apache::lonnet::str2hash($Answ);
 1780:     my $key = $partid.'.'.$respid.'.answer';
 1781:     my $student_answer = $Answer{$key}->[0];
 1782:     if (! defined($student_answer)) {
 1783:         $student_answer = $Answer{$key}->[1];
 1784:     }
 1785:     return ($student_answer);
 1786: }
 1787: 
 1788: ##
 1789: ## get problem data and put it into a useful data structure.
 1790: ## note: we must force each foil and option to not begin or end with
 1791: ##       spaces as they are stored without such data.
 1792: ##
 1793: sub get_problem_data {
 1794:     my ($url) = @_;
 1795:     my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze'));
 1796:     (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
 1797:     my %Answer;
 1798:     %Answer=&Apache::lonnet::str2hash($Answ);
 1799:     my %Partdata;
 1800:     foreach my $part (@{$Answer{'parts'}}) {
 1801:         while (my($key,$value) = each(%Answer)) {
 1802:             #
 1803:             # Logging code:
 1804:             if (0) {
 1805:                 &Apache::lonnet::logthis($part.' got key "'.$key.'"');
 1806:                 if (ref($value) eq 'ARRAY') {
 1807:                     &Apache::lonnet::logthis('    '.join(',',@$value));
 1808:                 } else {
 1809:                     &Apache::lonnet::logthis('    '.$value);
 1810:                 }
 1811:             }
 1812:             # End of logging code
 1813:             next if ($key !~ /^$part/);
 1814:             $key =~ s/^$part\.//;
 1815:             if (ref($value) eq 'ARRAY') {
 1816:                 if ($key eq 'options') {
 1817:                     $Partdata{$part}->{'_Options'}=$value;
 1818:                 } elsif ($key eq 'concepts') {
 1819:                     $Partdata{$part}->{'_Concepts'}=$value;
 1820:                 } elsif ($key =~ /^concept\.(.*)$/) {
 1821:                     my $concept = $1;
 1822:                     foreach my $foil (@$value) {
 1823:                         $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=
 1824:                                                                       $concept;
 1825:                     }
 1826:                 } elsif ($key =~ /^(incorrect|answer|ans_low|ans_high)$/) {
 1827:                     $Partdata{$part}->{$key}=$value;
 1828:                 }
 1829:             } else {
 1830:                 if ($key=~ /^foil\.text\.(.*)$/) {
 1831:                     my $foil = $1;
 1832:                     $Partdata{$part}->{'_Foils'}->{$foil}->{'name'}=$foil;
 1833:                     $value =~ s/(\s*$|^\s*)//g;
 1834:                     $Partdata{$part}->{'_Foils'}->{$foil}->{'text'}=$value;
 1835:                 } elsif ($key =~ /^foil\.value\.(.*)$/) {
 1836:                     my $foil = $1;
 1837:                     $Partdata{$part}->{'_Foils'}->{$foil}->{'value'}=$value;
 1838:                 }
 1839:             }
 1840:         }
 1841:     }
 1842:     return %Partdata;
 1843: }
 1844: 
 1845: 1;
 1846: 
 1847: __END__

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