[BACK]Return to lonproblemanalysis.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface / statistics

Diff for /loncom/interface/statistics/lonproblemanalysis.pm between versions 1.58 and 1.74

version 1.58, 2004/01/19 18:55:10 version 1.74, 2004/03/01 16:39:19
Line 33  use Apache::lonhtmlcommon(); Line 33  use Apache::lonhtmlcommon();
 use Apache::loncoursedata();  use Apache::loncoursedata();
 use Apache::lonstatistics;  use Apache::lonstatistics;
 use Apache::lonlocal;  use Apache::lonlocal;
   use Apache::lonstathelpers();
   use Apache::lonstudentsubmissions();
 use HTML::Entities();  use HTML::Entities();
 use Time::Local();  use Time::Local();
 use Spreadsheet::WriteExcel();  use Spreadsheet::WriteExcel();
Line 58  my @SubmitButtons = ({ name => 'PrevProb Line 60  my @SubmitButtons = ({ name => 'PrevProb
                      { name => 'ExcelOutput',                       { name => 'ExcelOutput',
                        text => 'Produce Excel Output' });                         text => 'Produce Excel Output' });
   
 sub render_resource {  
     my ($resource) = @_;  
     ##  
     ## Render the problem  
     my $base;  
     ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);  
     $base = "http://".$ENV{'SERVER_NAME'}.$base;  
     my $rendered_problem =   
         &Apache::lonnet::ssi_body($resource->{'src'});  
     $rendered_problem =~ s/<\s*form\s*/<nop /g;  
     $rendered_problem =~ s|(<\s*/form\s*>)|<\/nop>|g;  
     return '<table bgcolor="ffffff"><tr><td>'.  
         '<base href="'.$base.'" />'.  
         $rendered_problem.  
         '</td></tr></table>';  
 }  
   
 sub BuildProblemAnalysisPage {  sub BuildProblemAnalysisPage {
     my ($r,$c)=@_;      my ($r,$c)=@_;
Line 91  sub BuildProblemAnalysisPage { Line 77  sub BuildProblemAnalysisPage {
     #      #
     &Apache::lonstatistics::PrepareClasslist();      &Apache::lonstatistics::PrepareClasslist();
     #      #
     $r->print('<h2>'.&mt('Option Response Problem Analysis').'</h2>');  
     $r->print(&CreateInterface());      $r->print(&CreateInterface());
     #      #
     my @Students = @Apache::lonstatistics::Students;      my @Students = @Apache::lonstatistics::Students;
Line 114  sub BuildProblemAnalysisPage { Line 99  sub BuildProblemAnalysisPage {
     }      }
     $r->rflush();      $r->rflush();
     #      #
       my $problem_types = '(option|radiobutton|numerical)';
     if (exists($ENV{'form.problemchoice'}) &&       if (exists($ENV{'form.problemchoice'}) && 
         ! exists($ENV{'form.SelectAnother'})) {          ! exists($ENV{'form.SelectAnother'})) {
         foreach my $button (@SubmitButtons) {          foreach my $button (@SubmitButtons) {
Line 130  sub BuildProblemAnalysisPage { Line 116  sub BuildProblemAnalysisPage {
         $r->rflush();          $r->rflush();
         #          #
         # Determine which problem we are to analyze          # Determine which problem we are to analyze
         my $current_problem = &get_target_from_id($ENV{'form.problemchoice'});          my $current_problem = &Apache::lonstathelpers::get_target_from_id
               ($ENV{'form.problemchoice'});
         #          #
         my ($prev,$curr,$next) = &get_prev_curr_next($current_problem);          my ($prev,$curr,$next) = 
               &Apache::lonstathelpers::get_prev_curr_next($current_problem,
                                                           $problem_types,
                                                           'response',
                                                           );
         if (exists($ENV{'form.PrevProblemAnalysis'}) && defined($prev)) {          if (exists($ENV{'form.PrevProblemAnalysis'}) && defined($prev)) {
             $current_problem = $prev;              $current_problem = $prev;
         } elsif (exists($ENV{'form.NextProblemAnalysis'}) && defined($next)) {          } elsif (exists($ENV{'form.NextProblemAnalysis'}) && defined($next)) {
Line 142  sub BuildProblemAnalysisPage { Line 133  sub BuildProblemAnalysisPage {
         }          }
         #          #
         # Store the current problem choice and send it out in the form          # Store the current problem choice and send it out in the form
         $ENV{'form.problemchoice'} = &make_target_id($current_problem);          $ENV{'form.problemchoice'} = 
               &Apache::lonstathelpers::make_target_id($current_problem);
         $r->print('<input type="hidden" name="problemchoice" value="'.          $r->print('<input type="hidden" name="problemchoice" value="'.
                   $ENV{'form.problemchoice'}.'" />');                    $ENV{'form.problemchoice'}.'" />');
         #          #
Line 152  sub BuildProblemAnalysisPage { Line 144  sub BuildProblemAnalysisPage {
             my $resource = $current_problem->{'resource'};              my $resource = $current_problem->{'resource'};
             $r->print('<h1>'.$resource->{'title'}.'</h1>');              $r->print('<h1>'.$resource->{'title'}.'</h1>');
             $r->print('<h3>'.$resource->{'src'}.'</h3>');              $r->print('<h3>'.$resource->{'src'}.'</h3>');
             $r->print(&render_resource($resource));              $r->print(&Apache::lonstathelpers::render_resource($resource));
             $r->rflush();              $r->rflush();
             my %Data = &get_problem_data($resource->{'src'});              my %Data = &Apache::lonstathelpers::get_problem_data
                   ($resource->{'src'});
             my $ProblemData = $Data{$current_problem->{'part'}.              my $ProblemData = $Data{$current_problem->{'part'}.
                                     '.'.                                      '.'.
                                     $current_problem->{'respid'}};                                      $current_problem->{'respid'}};
Line 166  sub BuildProblemAnalysisPage { Line 159  sub BuildProblemAnalysisPage {
                 &RadioResponseAnalysis($r,$current_problem,                  &RadioResponseAnalysis($r,$current_problem,
                                        $ProblemData,                                         $ProblemData,
                                        \@Students);                                         \@Students);
               } elsif ($current_problem->{'resptype'} eq 'numerical') {
   #                if (exists($ENV{'form.ExcelOutput'})) {
                       &Apache::lonstudentsubmissions::prepare_excel_output
                           ($r,$current_problem,$ProblemData,\@Students);
   #                } else {
   #                    &NumericalResponseAnalysis($r,$current_problem,
   #                                               $ProblemData,\@Students);
   #                }
             } else {              } else {
                 $r->print('<h2>This analysis is not supported</h2>');                  $r->print('<h2>This analysis is not supported</h2>');
             }              }
Line 176  sub BuildProblemAnalysisPage { Line 177  sub BuildProblemAnalysisPage {
                   &mt('Analyze Problem').'" />');                    &mt('Analyze Problem').'" />');
         $r->print('&nbsp;'x5);          $r->print('&nbsp;'x5);
         $r->print('<h3>'.&mt('Please select a problem to analyze').'</h3>');          $r->print('<h3>'.&mt('Please select a problem to analyze').'</h3>');
         $r->print(&ProblemSelector());          $r->print(&Apache::lonstathelpers::ProblemSelector
                     ($problem_types));
     }      }
 }  }
   
Line 184  sub BuildProblemAnalysisPage { Line 186  sub BuildProblemAnalysisPage {
 #########################################################  #########################################################
 #########################################################  #########################################################
 ##  ##
   ##      Numerical Response Routines
   ##
   #########################################################
   #########################################################
   sub NumericalResponseAnalysis {
       my ($r,$problem,$ProblemData,$Students) = @_;
       $r->print('<h2>This analysis is not yet supported</h2>');
       my ($resource,$respid) = ($problem->{'resource'},
                                 $problem->{'respid'});
       my $analysis_html;
       my $PerformanceData = 
           &Apache::loncoursedata::get_response_data
           ($Students,$resource->{'symb'},$respid);
       if (! defined($PerformanceData) || 
           ref($PerformanceData) ne 'ARRAY' ) {
           $analysis_html = '<h2>'.
               &mt('There is no submission data for this resource').
               '</h2>';
           $r->print($analysis_html);
           return;
       }
       my ($max,$min) = &GetStudentAnswers($r,$problem,$Students);
       $r->print('Maximum = '.$max.' Minimum = '.$min);
       my $max_students = 0;
       my %Data;
       foreach my $student (@$Students) {
           my $answer = $student->{'answer'};
           $Data{$answer}++;
           if ($max_students < $Data{$answer}) {
               $max_students = $Data{$answer};
           }
       }
       foreach (5,10,20,25,50,75,100,150,200,250,500,1000,1500,2000,2500,5000) {
           if ($max_students < $_) {
               $max_students = $_;
               last;
           }
       }
       my @Labels = sort {$a <=> $b } keys(%Data);
       $r->print('number of labels = '.scalar(@Labels));
       my @PlotData = @Data{@Labels};
       $r->print('number of PlotData = '.scalar(@PlotData));
       my $graph = 
           &Apache::loncommon::DrawXYGraph('Correct Answer Distribution',
                                           'Correct Answer',
                                           'Number of students',
                                           $max_students,
                                           undef,
                                           \@Labels,
                                           [\@PlotData],
                                           (xskip=>10));
       $r->print($graph);
       return;
   }
   
   sub GetStudentAnswers {
       my ($r,$problem,$Students) = @_;
       my %Answers;
       my ($resource,$partid,$respid) = ($problem->{'resource'},
                                         $problem->{'part'},
                                         $problem->{'respid'});
       # Open progress window
       my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin
           ($r,'Student Answer Compilation Status',
            'Student Answer Compilation Progress', scalar(@$Students));
       $r->print("<table>\n");
       $r->rflush();
       foreach my $student (@$Students) {
           my $sname = $student->{'username'};
           my $sdom = $student->{'domain'};
           my $answer = &Apache::lonstathelpers::analyze_problem_as_student
               ($resource,$sname,$sdom,$partid,$respid);
           &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                                                    &mt('last student'));
           $student->{'answer'} = $answer;
       }
       $r->print("</table>\n");
       $r->rflush();
       # close progress window
       &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
       return;
   }
   
   sub build_student_data_worksheet {
       my ($workbook,$format) = @_;
       my $rows_output = 3;
       my $cols_output = 0;
       my $worksheet  = $workbook->addworksheet('Student Data');
       $worksheet->write($rows_output++,0,'Student Data',$format->{'h3'});
       my @Headers = ('full name','username','domain','section',
                      "student\nnumber",'identifier');
       $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});
       my @Students = @Apache::lonstatistics::Students;
       my $studentrows = &Apache::loncoursedata::get_student_data(\@Students);
       my %ids;
       foreach my $row (@$studentrows) {
           my ($mysqlid,$student) = @$row;
           $ids{$student}=$mysqlid;
       }
       foreach my $student (@Students) {
           my $name_domain = $student->{'username'}.':'.$student->{'domain'};
           $worksheet->write_row($rows_output++,0,
                             [$student->{'fullname'},
                              $student->{'username'},$student->{'domain'},
                              $student->{'section'},$student->{'id'},
                              $ids{$name_domain}]);
       }
       return $worksheet;
   }
   
   #########################################################
   #########################################################
   ##
 ##      Radio Response Routines  ##      Radio Response Routines
 ##  ##
 #########################################################  #########################################################
Line 191  sub BuildProblemAnalysisPage { Line 306  sub BuildProblemAnalysisPage {
 sub RadioResponseAnalysis {  sub RadioResponseAnalysis {
     my ($r,$problem,$ProblemData,$Students) = @_;      my ($r,$problem,$ProblemData,$Students) = @_;
     my ($resource,$respid) = ($problem->{'resource'},      my ($resource,$respid) = ($problem->{'resource'},
                                     $problem->{'respid'});                                $problem->{'respid'});
     my $analysis_html;      my $analysis_html;
     my $PerformanceData =       my $PerformanceData = 
         &Apache::loncoursedata::get_response_data          &Apache::loncoursedata::get_response_data
Line 309  sub RR_Tries_Foil_Analysis { Line 424  sub RR_Tries_Foil_Analysis {
                                                   'Percent Choosing',                                                    'Percent Choosing',
                                                   100,                                                    100,
                                                   ['#33ff00','#ff3300'],                                                    ['#33ff00','#ff3300'],
                                                     undef,
                                                   \@PlotData_Correct,                                                    \@PlotData_Correct,
                                                   \@PlotData_Incorrect);                                                    \@PlotData_Incorrect);
     }      }
Line 501  sub OR_Tries_Foil_Analysis { Line 617  sub OR_Tries_Foil_Analysis {
         }          }
         my $correctgraph = &Apache::loncommon::DrawBarGraph          my $correctgraph = &Apache::loncommon::DrawBarGraph
             ($title,'Foil Number','Percent Correct',              ($title,'Foil Number','Percent Correct',
              100,$plotcolors,$Datasets[0]);               100,$plotcolors,undef,$Datasets[0]);
         $analysis_html.= '<tr><td>'.$correctgraph.'</td>';          $analysis_html.= '<tr><td>'.$correctgraph.'</td>';
         ##          ##
         ##          ##
Line 520  sub OR_Tries_Foil_Analysis { Line 636  sub OR_Tries_Foil_Analysis {
         $title = 'Attempt '.$i.', '.$count;          $title = 'Attempt '.$i.', '.$count;
         my $incorrectgraph = &Apache::loncommon::DrawBarGraph          my $incorrectgraph = &Apache::loncommon::DrawBarGraph
             ($title,'Foil Number','% Option Chosen Incorrectly',              ($title,'Foil Number','% Option Chosen Incorrectly',
              100,$plotcolors,@Datasets);               100,$plotcolors,undef,@Datasets);
         $analysis_html.= '<td>'.$incorrectgraph.'</td>';          $analysis_html.= '<td>'.$incorrectgraph.'</td>';
         $analysis_html.= '<td>'.$foilkey."<td></tr>\n";          $analysis_html.= '<td>'.$foilkey."<td></tr>\n";
     }      }
Line 587  sub OR_Tries_Concept_Analysis { Line 703  sub OR_Tries_Concept_Analysis {
         $title = 'Attempt '.$i.', '.$count;          $title = 'Attempt '.$i.', '.$count;
         my $graphlink = &Apache::loncommon::DrawBarGraph          my $graphlink = &Apache::loncommon::DrawBarGraph
             ($title,'Concept Number','Percent Correct',              ($title,'Concept Number','Percent Correct',
              100,$plotcolors,$PlotData[$i]->{'_correct'});               100,$plotcolors,undef,$PlotData[$i]->{'_correct'});
         $analysis_html.= '<tr><td>'.$graphlink."</td></tr>\n";          $analysis_html.= '<tr><td>'.$graphlink."</td></tr>\n";
     }      }
     $analysis_html .= "</table>\n";      $analysis_html .= "</table>\n";
Line 752  sub OR_Foil_Time_Analysis { Line 868  sub OR_Foil_Time_Analysis {
                                                        'Percent Correct',                                                         'Percent Correct',
                                                        100,                                                         100,
                                                        $plotcolors,                                                         $plotcolors,
                                                          undef,
                                                        $Plotdata[0]);                                                         $Plotdata[0]);
     for (my $j=0; $j< scalar(@{$Plotdata[0]});$j++) {      for (my $j=0; $j< scalar(@{$Plotdata[0]});$j++) {
         $Plotdata[0]->[$j]=0;          $Plotdata[0]->[$j]=0;
Line 769  sub OR_Foil_Time_Analysis { Line 886  sub OR_Foil_Time_Analysis {
                                                  'Incorrect Option Choice',                                                   'Incorrect Option Choice',
                                                  100,                                                   100,
                                                  $plotcolors,                                                   $plotcolors,
                                                    undef,
                                                  @Plotdata);                                                           @Plotdata);        
     $analysis_html.='<tr>'.      $analysis_html.='<tr>'.
         '<td>'.$correctplot.'</td>'.          '<td>'.$correctplot.'</td>'.
Line 833  sub OR_Concept_Time_Analysis { Line 951  sub OR_Concept_Time_Analysis {
                                                     'Percent Correct',                                                      'Percent Correct',
                                                     100,                                                      100,
                                                     $plotcolors,                                                      $plotcolors,
                                                       undef,
                                                     \@Plotdata);                                                      \@Plotdata);
     $analysis_html.='<tr>'.      $analysis_html.='<tr>'.
         '<td>'.$correctplot.'</td>'.          '<td>'.$correctplot.'</td>'.
Line 874  sub OR_excel_sheet { Line 993  sub OR_excel_sheet {
     }      }
     #      #
     $workbook->set_tempdir('/home/httpd/perl/tmp');      $workbook->set_tempdir('/home/httpd/perl/tmp');
     #      my $format = &Apache::loncommon::define_excel_formats($workbook);
     # Define some potentially useful formats  
     my $format;  
     $format->{'header'} = $workbook->add_format(bold      => 1,   
                                                 bottom    => 1,  
                                                 align     => 'center');  
     $format->{'bold'} = $workbook->add_format(bold=>1);  
     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);  
     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);  
     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);  
     $format->{'date'} = $workbook->add_format(num_format=>  
                                               'mmm d yyyy hh:mm AM/PM');  
     #      #
     # Create and populate main worksheets      # Create and populate main worksheets
     my $problem_data_sheet  = $workbook->addworksheet('Problem Data');      my $problem_data_sheet  = $workbook->addworksheet('Problem Data');
     my $student_data_sheet  = $workbook->addworksheet('Student Data');      my $student_data_sheet = &build_student_data_worksheet($workbook,$format);
     my $response_data_sheet = $workbook->addworksheet('Response Data');      my $response_data_sheet = $workbook->addworksheet('Response Data');
     foreach my $sheet ($problem_data_sheet,$student_data_sheet,      foreach my $sheet ($problem_data_sheet,$student_data_sheet,
                        $response_data_sheet) {                         $response_data_sheet) {
Line 898  sub OR_excel_sheet { Line 1006  sub OR_excel_sheet {
     }      }
     #      #
     my $result;      my $result;
     $result = &build_problem_data_worksheet($problem_data_sheet,$format,      $result = &OR_build_problem_data_worksheet($problem_data_sheet,$format,
                                             $Concepts,$ORdata);                                              $Concepts,$ORdata);
     if ($result ne 'okay') {      if ($result ne 'okay') {
         # Do something useful          # Do something useful
     }      }
     $result = &build_student_data_worksheet($student_data_sheet,$format);      $result = &OR_build_response_data_worksheet($response_data_sheet,$format,
     if ($result ne 'okay') {  
         # Do something useful  
     }  
     $result = &build_response_data_worksheet($response_data_sheet,$format,  
                                              $PerformanceData,$Foils,                                               $PerformanceData,$Foils,
                                              $ORdata);                                               $ORdata);
     if ($result ne 'okay') {      if ($result ne 'okay') {
Line 995  sub OR_build_problem_data_worksheet { Line 1099  sub OR_build_problem_data_worksheet {
     return 'okay';      return 'okay';
 }  }
   
 sub OR_build_student_data_worksheet {  
     my ($worksheet,$format) = @_;  
     my $rows_output = 3;  
     my $cols_output = 0;  
     $worksheet->write($rows_output++,0,'Student Data',$format->{'h3'});  
     my @Headers = ('full name','username','domain','section',  
                    "student\nnumber",'identifier');  
     $worksheet->write_row($rows_output++,0,\@Headers,$format->{'header'});  
     my @Students = @Apache::lonstatistics::Students;  
     my $studentrows = &Apache::loncoursedata::get_student_data(\@Students);  
     my %ids;  
     foreach my $row (@$studentrows) {  
         my ($mysqlid,$student) = @$row;  
         $ids{$student}=$mysqlid;  
     }  
     foreach my $student (@Students) {  
         my $name_domain = $student->{'username'}.':'.$student->{'domain'};  
         $worksheet->write_row($rows_output++,0,  
                           [$student->{'fullname'},  
                            $student->{'username'},$student->{'domain'},  
                            $student->{'section'},$student->{'id'},  
                            $ids{$name_domain}]);  
     }  
     return;  
 }  
   
 sub OR_build_response_data_worksheet {  sub OR_build_response_data_worksheet {
     my ($worksheet,$format,$PerformanceData,$Foils,$ORdata)=@_;      my ($worksheet,$format,$PerformanceData,$Foils,$ORdata)=@_;
     my $rows_output = 3;      my $rows_output = 3;
Line 1050  sub OR_build_response_data_worksheet { Line 1128  sub OR_build_response_data_worksheet {
         }          }
         $worksheet->write($rows_output,$cols_output++,$student);          $worksheet->write($rows_output,$cols_output++,$student);
         $worksheet->write($rows_output,$cols_output++,          $worksheet->write($rows_output,$cols_output++,
                           &calc_serial($time),$format->{'date'});               &Apache::lonstathelpers::calc_serial($time),$format->{'date'});
         $worksheet->write($rows_output,$cols_output++,$award);          $worksheet->write($rows_output,$cols_output++,$award);
         $worksheet->write($rows_output,$cols_output++,$tries);          $worksheet->write($rows_output,$cols_output++,$tries);
         foreach my $foilid (@$Foils) {          foreach my $foilid (@$Foils) {
Line 1065  sub OR_build_response_data_worksheet { Line 1143  sub OR_build_response_data_worksheet {
     return;      return;
 }  }
   
   
 ##  
 ## The following is copied from datecalc1.pl, part of the   
 ## Spreadsheet::WriteExcel CPAN module.  
 ##  
 ##  
 ######################################################################  
 #  
 # Demonstration of writing date/time cells to Excel spreadsheets,  
 # using UNIX/Perl time as source of date/time.  
 #  
 # Copyright 2000, Andrew Benham, adsb@bigfoot.com  
 #  
 ######################################################################  
 #  
 # UNIX/Perl time is the time since the Epoch (00:00:00 GMT, 1 Jan 1970)  
 # measured in seconds.  
 #  
 # An Excel file can use exactly one of two different date/time systems.  
 # In these systems, a floating point number represents the number of days  
 # (and fractional parts of the day) since a start point. The floating point  
 # number is referred to as a 'serial'.  
 # The two systems ('1900' and '1904') use different starting points:  
 #  '1900'; '1.00' is 1 Jan 1900 BUT 1900 is erroneously regarded as  
 #          a leap year - see:  
 #            http://support.microsoft.com/support/kb/articles/Q181/3/70.asp  
 #          for the excuse^H^H^H^H^H^Hreason.  
 #  '1904'; '1.00' is 2 Jan 1904.  
 #  
 # The '1904' system is the default for Apple Macs. Windows versions of  
 # Excel have the option to use the '1904' system.  
 #  
 # Note that Visual Basic's "DateSerial" function does NOT erroneously  
 # regard 1900 as a leap year, and thus its serials do not agree with  
 # the 1900 serials of Excel for dates before 1 Mar 1900.  
 #  
 # Note that StarOffice (at least at version 5.2) does NOT erroneously  
 # regard 1900 as a leap year, and thus its serials do not agree with  
 # the 1900 serials of Excel for dates before 1 Mar 1900.  
 #  
 ######################################################################  
 #  
 # Calculation description  
 # =======================  
 #  
 # 1900 system  
 # -----------  
 # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 70 years after 1 Jan 1900.  
 # Of those 70 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68)  
 # were leap years with an extra day.  
 # Thus there were 17 + 70*365 days = 25567 days between 1 Jan 1900 and  
 # 1 Jan 1970.  
 # In the 1900 system, '1' is 1 Jan 1900, but as 1900 was not a leap year  
 # 1 Jan 1900 should really be '2', so 1 Jan 1970 is '25569'.  
 #  
 # 1904 system  
 # -----------  
 # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 66 years after 1 Jan 1904.  
 # Of those 66 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68)  
 # were leap years with an extra day.  
 # Thus there were 17 + 66*365 days = 24107 days between 1 Jan 1904 and  
 # 1 Jan 1970.  
 # In the 1904 system, 2 Jan 1904 being '1', 1 Jan 1970 is '24107'.  
 #  
 ######################################################################  
 #  
 # Copyright (c) 2000, Andrew Benham.  
 # This program is free software. It may be used, redistributed and/or  
 # modified under the same terms as Perl itself.  
 #  
 # Andrew Benham, adsb@bigfoot.com  
 # London, United Kingdom  
 # 11 Nov 2000  
 #  
 ######################################################################  
   
 # Use 1900 date system on all platforms other than Apple Mac (for which  
 # use 1904 date system).  
 my $DATE_SYSTEM = ($^O eq 'MacOS') ? 1 : 0;  
   
 #-----------------------------------------------------------  
 # calc_serial()  
 #  
 # Called with (up to) 2 parameters.  
 #   1.  Unix timestamp.  If omitted, uses current time.  
 #   2.  GMT flag. Set to '1' to return serial in GMT.  
 #       If omitted, returns serial in appropriate timezone.  
 #  
 # Returns date/time serial according to $DATE_SYSTEM selected  
 #-----------------------------------------------------------  
 sub calc_serial {  
         my $time = (defined $_[0]) ? $_[0] : time();  
         my $gmtflag = (defined $_[1]) ? $_[1] : 0;  
   
         # Divide timestamp by number of seconds in a day.  
         # This gives a date serial with '0' on 1 Jan 1970.  
         my $serial = $time / 86400;  
   
         # Adjust the date serial by the offset appropriate to the  
         # currently selected system (1900/1904).  
         if ($DATE_SYSTEM == 0) {        # use 1900 system  
                 $serial += 25569;  
         } else {                        # use 1904 system  
                 $serial += 24107;  
         }  
   
         unless ($gmtflag) {  
                 # Now have a 'raw' serial with the right offset. But this  
                 # gives a serial in GMT, which is false unless the timezone  
                 # is GMT. We need to adjust the serial by the appropriate  
                 # timezone offset.  
                 # Calculate the appropriate timezone offset by seeing what  
                 # the differences between localtime and gmtime for the given  
                 # time are.  
   
                 my @gmtime = gmtime($time);  
                 my @ltime  = localtime($time);  
   
                 # For the first 7 elements of the two arrays, adjust the  
                 # date serial where the elements differ.  
                 for (0 .. 6) {  
                         my $diff = $ltime[$_] - $gmtime[$_];  
                         if ($diff) {  
                                 $serial += _adjustment($diff,$_);  
                         }  
                 }  
         }  
   
         # Perpetuate the error that 1900 was a leap year by decrementing  
         # the serial if we're using the 1900 system and the date is prior to  
         # 1 Mar 1900. This has the effect of making serial value '60'  
         # 29 Feb 1900.  
   
         # This fix only has any effect if UNIX/Perl time on the platform  
         # can represent 1900. Many can't.  
   
         unless ($DATE_SYSTEM) {  
                 $serial-- if ($serial < 61);    # '61' is 1 Mar 1900  
         }  
         return $serial;  
 }  
   
 sub _adjustment {  
         # Based on the difference in the localtime/gmtime array elements  
         # number, return the adjustment required to the serial.  
   
         # We only look at some elements of the localtime/gmtime arrays:  
         #    seconds    unlikely to be different as all known timezones  
         #               have an offset of integral multiples of 15 minutes,  
         #               but it's easy to do.  
         #    minutes    will be different for timezone offsets which are  
         #               not an exact number of hours.  
         #    hours      very likely to be different.  
         #    weekday    will differ when localtime/gmtime difference  
         #               straddles midnight.  
         #  
         # Assume that difference between localtime and gmtime is less than  
         # 5 days, then don't have to do maths for day of month, month number,  
         # year number, etc...  
   
         my ($delta,$element) = @_;  
         my $adjust = 0;  
   
         if ($element == 0) {            # Seconds  
                 $adjust = $delta/86400;         # 60 * 60 * 24  
         } elsif ($element == 1) {       # Minutes  
                 $adjust = $delta/1440;          # 60 * 24  
         } elsif ($element == 2) {       # Hours  
                 $adjust = $delta/24;            # 24  
         } elsif ($element == 6) {       # Day of week number  
                 # Catch difference straddling Sat/Sun in either direction  
                 $delta += 7 if ($delta < -4);  
                 $delta -= 7 if ($delta > 4);  
   
                 $adjust = $delta;  
         }  
         return $adjust;  
 }  
   
 sub build_foil_index {  sub build_foil_index {
     my ($ORdata) = @_;      my ($ORdata) = @_;
     return if (! exists($ORdata->{'_Foils'}));      return if (! exists($ORdata->{'_Foils'}));
Line 1272  sub build_foil_index { Line 1171  sub build_foil_index {
         my $a1 = lc($a);           my $a1 = lc($a); 
         my $b1 = lc($b);          my $b1 = lc($b);
         if (exists($Numbers{$a1})) {          if (exists($Numbers{$a1})) {
             $a = $Numbers{$a1};              $a1 = $Numbers{$a1};
         }          }
         if (exists($Numbers{$b1})) {          if (exists($Numbers{$b1})) {
             $b = $Numbers{$b1};              $b1 = $Numbers{$b1};
         }          }
         if (($a =~/^\d+$/) && ($b =~/^\d+$/)) {          if (($a1 =~/^\d+$/) && ($b1 =~/^\d+$/)) {
             return $a <=> $b;              return $a1 <=> $b1;
         } else {          } else {
             return $a cmp $b;              return $a1 cmp $b1;
         }          }
     };      };
     my @Concepts;      my @Concepts;
Line 1321  sub build_foil_index { Line 1220  sub build_foil_index {
         if (@Concepts > 1) {          if (@Concepts > 1) {
             $table .= '<tr>'.              $table .= '<tr>'.
                 '<td>'.$conceptindex.'</td>'.                  '<td>'.$conceptindex.'</td>'.
                 '<td>'.$concept->{'name'}.'</td>'.                  '<td>'.&HTML::Entities::encode($concept->{'name'}).'</td>'.
                 '<td>'.$foilindex++.'</td>'.                  '<td>'.$foilindex++.'</td>'.
                 '<td>'.$Foildata{$firstfoil}->{'name'}.'</td>'.                  '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'}).'</td>'.
                 '<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.                  '<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.
                 '<td>'.$Foildata{$firstfoil}->{'value'}.'</td>'.                  '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'}).'</td>'.
                 "</tr>\n";                  "</tr>\n";
         } else {          } else {
             $table .= '<tr>'.              $table .= '<tr>'.
                 '<td>'.$foilindex++.'</td>'.                  '<td>'.$foilindex++.'</td>'.
                 '<td>'.$Foildata{$firstfoil}->{'name'}.'</td>'.                  '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'name'}).'</td>'.
                 '<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.                  '<td>'.$Foildata{$firstfoil}->{'text'}.'</td>'.
                 '<td>'.$Foildata{$firstfoil}->{'value'}.'</td>'.                  '<td>'.&HTML::Entities::encode($Foildata{$firstfoil}->{'value'}).'</td>'.
                 "</tr>\n";                  "</tr>\n";
         }          }
         foreach my $foilid (@FoilsInConcept) {          foreach my $foilid (@FoilsInConcept) {
Line 1341  sub build_foil_index { Line 1240  sub build_foil_index {
                     '<td></td>'.                      '<td></td>'.
                     '<td></td>'.                      '<td></td>'.
                     '<td>'.$foilindex.'</td>'.                      '<td>'.$foilindex.'</td>'.
                     '<td>'.$Foildata{$foilid}->{'name'}.'</td>'.                      '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'name'}).'</td>'.
                     '<td>'.$Foildata{$foilid}->{'text'}.'</td>'.                      '<td>'.$Foildata{$foilid}->{'text'}.'</td>'.
                     '<td>'.$Foildata{$foilid}->{'value'}.'</td>'.                      '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'value'}).'</td>'.
                     "</tr>\n";                      "</tr>\n";
             } else {              } else {
                 $table .= '<tr>'.                  $table .= '<tr>'.
                     '<td>'.$foilindex.'</td>'.                      '<td>'.$foilindex.'</td>'.
                     '<td>'.$Foildata{$foilid}->{'name'}.'</td>'.                      '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'name'}).'</td>'.
                     '<td>'.$Foildata{$foilid}->{'text'}.'</td>'.                      '<td>'.$Foildata{$foilid}->{'text'}.'</td>'.
                     '<td>'.$Foildata{$foilid}->{'value'}.'</td>'.                      '<td>'.&HTML::Entities::encode($Foildata{$foilid}->{'value'}).'</td>'.
                     "</tr>\n";                      "</tr>\n";
             }                              }                
         } continue {          } continue {
Line 1375  sub build_option_index { Line 1274  sub build_option_index {
               '<tr>'.                '<tr>'.
               '<td bgcolor="'.$plotcolors->[$optionindex++].'">'.                '<td bgcolor="'.$plotcolors->[$optionindex++].'">'.
               ('&nbsp;'x4).'</td>'.                ('&nbsp;'x4).'</td>'.
               '<td>'.$option.'</td>'.                '<td>'.&HTML::Entities::encode($option).'</td>'.
               "</tr>\n");                "</tr>\n");
     }      }
     shift(@Rows); # Throw away 'correct option chosen' color      shift(@Rows); # Throw away 'correct option chosen' color
Line 1399  sub CreateInterface { Line 1298  sub CreateInterface {
     ##      ##
     ## Build the menu      ## Build the menu
     my $Str = '';      my $Str = '';
       $Str .= &Apache::lonhtmlcommon::breadcrumbs
           (undef,'Detailed Problem Analysis');
     $Str .= '<table cellspacing="5">'."\n";      $Str .= '<table cellspacing="5">'."\n";
     $Str .= '<tr>';      $Str .= '<tr>';
     $Str .= '<td align="center"><b>'.&mt('Sections').'</b></td>';      $Str .= '<td align="center"><b>'.&mt('Sections').'</b></td>';
Line 1492  sub CreateInterface { Line 1393  sub CreateInterface {
     return $Str;      return $Str;
 }  }
   
 sub ProblemSelector {  
     my $Str;  
     $Str = "\n<table>\n";  
     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {  
         next if ($seq->{'num_assess'}<1);  
         my $seq_str = '';  
         foreach my $res (@{$seq->{'contents'}}) {  
             next if ($res->{'type'} ne 'assessment');  
             foreach my $part (@{$res->{'parts'}}) {  
                 my $partdata = $res->{'partdata'}->{$part};  
 #                &Apache::lonnet::logthis('----------------');  
 #                while (my ($k,$v)=each(%$partdata)) {  
 #                    if (ref($v) eq 'ARRAY') {  
 #                        &Apache::lonnet::logthis($k.' = '.join(',',@$v));  
 #                    } else {  
 #                        &Apache::lonnet::logthis($k.' = '.$v);  
 #                    }  
 #                }  
                 if ((! exists($partdata->{'option'}) ||   
                      $partdata->{'option'} == 0      ) &&  
                     (! exists($partdata->{'radiobutton'}) ||  
                      $partdata->{'radiobutton'} == 0)) {  
                     next;  
                 }  
                 for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){  
                     my $respid = $partdata->{'ResponseIds'}->[$i];  
                     my $resptype = $partdata->{'ResponseTypes'}->[$i];  
 #                    if ($resptype eq 'option' ){  
                     if ($resptype eq 'option' || $resptype eq 'radiobutton') {  
                         my $value = &make_target_id({symb=>$res->{'symb'},  
                                                      part=>$part,  
                                                      respid=>$respid,  
                                                      resptype=>$resptype});  
                         my $checked = '';  
                         if ($ENV{'form.problemchoice'} eq $value) {  
                             $checked = 'checked ';  
                         }  
                         my $title = $res->{'title'};  
                         if (! defined($title) || $title eq '') {  
                             ($title) = ($res->{'src'} =~ m:/([^/]*)$:);  
                         }  
                         $seq_str .= '<tr><td>'.  
   '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.  
   '</td><td>'.            
   $resptype.'</td><td>'.  
   '<a href="'.$res->{'src'}.'">'.$title.'</a> ';  
 #  '<a href="'.$res->{'src'}.'">'.$resptype.' '.$res->{'title'}.'</a> ';  
                         if ($partdata->{'option'} > 1) {  
                             $seq_str .= &mt('response').' '.$respid;  
                         }  
                         $seq_str .= "</td></tr>\n";  
                     }  
                 }  
             }  
         }  
         if ($seq_str ne '') {  
             $Str .= '<tr><td>&nbsp</td><td colspan="2"><b>'.$seq->{'title'}.'</b></td>'.  
                 "</tr>\n".$seq_str;  
         }  
     }  
     $Str .= "</table>\n";  
     return $Str;  
 }  
   
 #########################################################  
 #########################################################  
 ##  
 ##              Misc functions  
 ##  
 #########################################################  
 #########################################################  
 sub get_problem_symb {  
     my $problemstring = shift();  
     my ($symb,$partid,$respid,$resptype) = split(':',$problemstring);  
     return ({ symb   => $symb,  
               part   => $partid,  
               respid => $respid,  
               type   => $resptype } );  
 }  
   
 sub get_resource_from_symb {  
     my ($symb) = @_;  
     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {  
         foreach my $res (@{$seq->{'contents'}}) {  
             if ($res->{'symb'} eq $symb) {  
                 return $res;  
             }  
         }  
     }  
     return undef;  
 }  
   
 sub get_prev_curr_next {  
     my ($target) = @_;  
     #  
     # Build an array with the data we need to search through  
     my @Resource;  
     foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {  
         foreach my $res (@{$seq->{'contents'}}) {  
             next if ($res->{'type'} ne 'assessment');  
             foreach my $part (@{$res->{'parts'}}) {  
                 my $partdata = $res->{'partdata'}->{$part};  
                 for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){  
                     my $respid = $partdata->{'ResponseIds'}->[$i];  
                     my $resptype = $partdata->{'ResponseTypes'}->[$i];  
                     next if ($resptype ne 'option' &&   
                              $resptype ne 'radiobutton');  
                     push (@Resource,  
                             { symb     => $res->{symb},  
                               part     => $part,  
                               respid   => $partdata->{'ResponseIds'}->[$i],  
                               resource => $res,  
                               resptype => $resptype  
                             } );  
                 }  
             }  
         }  
     }  
     #  
     #  
     # Get the index of the current situation  
     my $curr_idx;  
     for ($curr_idx=0;$curr_idx<$#Resource;$curr_idx++) {  
         my $curr_item = $Resource[$curr_idx];  
         last if ($curr_item->{'symb'} eq $target->{'symb'} &&  
                  $curr_item->{'part'} eq $target->{'part'} &&  
                  $curr_item->{'respid'} eq $target->{'respid'} &&  
                  $curr_item->{'resptype'} eq $target->{'resptype'});  
     }  
     my $curr_item = $Resource[$curr_idx];  
     if ($curr_item->{'symb'}     ne $target->{'symb'} ||  
         $curr_item->{'part'}     ne $target->{'part'} ||  
         $curr_item->{'respid'}   ne $target->{'respid'} ||  
         $curr_item->{'resptype'} ne $target->{'resptype'}){  
         # bogus symb - return nothing  
         return (undef,undef,undef);  
     }  
     #  
     # Now just pick up the data we need  
     my ($prev,$curr,$next);  
     if ($curr_idx == 0) {  
         $prev = undef;  
         $curr = $Resource[$curr_idx  ];  
         $next = $Resource[$curr_idx+1];  
     } elsif ($curr_idx == $#Resource) {  
         $prev = $Resource[$curr_idx-1];  
         $curr = $Resource[$curr_idx  ];  
         $next = undef;  
     } else {  
         $prev = $Resource[$curr_idx-1];  
         $curr = $Resource[$curr_idx  ];  
         $next = $Resource[$curr_idx+1];  
     }  
     return ($prev,$curr,$next);  
 }  
   
 sub make_target_id {  
     my ($target) = @_;  
     my $id = &Apache::lonnet::escape($target->{'symb'}).':'.  
              &Apache::lonnet::escape($target->{'part'}).':'.  
              &Apache::lonnet::escape($target->{'respid'}).':'.  
              &Apache::lonnet::escape($target->{'resptype'});  
     return $id;  
 }  
   
 sub get_target_from_id {  
     my ($id) = @_;  
     my ($symb,$part,$respid,$resptype) = split(':',$id);  
     return ({ symb    =>&Apache::lonnet::unescape($symb),  
              part     =>&Apache::lonnet::unescape($part),  
              respid   =>&Apache::lonnet::unescape($respid),  
              resptype =>&Apache::lonnet::unescape($resptype)});  
 }  
   
 #########################################################  #########################################################
 #########################################################  #########################################################
 ##  ##
Line 1730  sub Process_OR_Row { Line 1457  sub Process_OR_Row {
     return %RowData;      return %RowData;
 }  }
   
 ##  
 ## get problem data and put it into a useful data structure.  
 ## note: we must force each foil and option to not begin or end with  
 ##       spaces as they are stored without such data.  
 ##  
 sub get_problem_data {  
     my ($url) = @_;  
     my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze'));  
     (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);  
     my %Answer;  
     %Answer=&Apache::lonnet::str2hash($Answ);  
     my %Partdata;  
     foreach my $part (@{$Answer{'parts'}}) {  
         while (my($key,$value) = each(%Answer)) {  
             next if ($key !~ /^$part/);  
             $key =~ s/^$part\.//;  
             if (ref($value) eq 'ARRAY') {  
                 if ($key eq 'options') {  
                     $Partdata{$part}->{'_Options'}=$value;  
                 } elsif ($key eq 'concepts') {  
                     $Partdata{$part}->{'_Concepts'}=$value;  
                 } elsif ($key =~ /^concept\.(.*)$/) {  
                     my $concept = $1;  
                     foreach my $foil (@$value) {  
                         $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=  
                                                                       $concept;  
                     }  
                 }  
             } else {  
                 if ($key=~ /^foil\.text\.(.*)$/) {  
                     my $foil = $1;  
                     $Partdata{$part}->{'_Foils'}->{$foil}->{'name'}=$foil;  
                     $value =~ s/(\s*$|^\s*)//g;  
                     $Partdata{$part}->{'_Foils'}->{$foil}->{'text'}=$value;  
                 } elsif ($key =~ /^foil\.value\.(.*)$/) {  
                     my $foil = $1;  
                     $Partdata{$part}->{'_Foils'}->{$foil}->{'value'}=$value;  
                 }  
             }  
         }  
     }  
     return %Partdata;  
 }  
   
 1;  1;
   
 __END__  __END__
   
 #####  
 # partdata{part}->{_Foils}->{foilid}->{'name'}     = $  
 #                                   ->{'text'}     = $  
 #                                   ->{'value'}    = $  
 #                                   ->{'_Concept'} = $  
 # partdata{part}->{_Options}  = @  
 # partdata{part}->{_Concepts} = @  
Removed from v.1.58  
changed lines
  Added in v.1.74

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