[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.105 and 1.106

version 1.105, 2004/11/12 19:47:29 version 1.106, 2004/12/02 21:53:33
Line 38  use Apache::lonstudentsubmissions(); Line 38  use Apache::lonstudentsubmissions();
 use HTML::Entities();  use HTML::Entities();
 use Time::Local();  use Time::Local();
 use Spreadsheet::WriteExcel();  use Spreadsheet::WriteExcel();
   use capa;
   
 my $plotcolors = ['#33ff00',   my $plotcolors = ['#33ff00', 
                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',                    '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
Line 201  sub numerical_response_analysis { Line 202  sub numerical_response_analysis {
                                                        'stats_status');                                                         'stats_status');
         $r->print(&numerical_one_dimensional_plot($r,600,150,$answers));          $r->print(&numerical_one_dimensional_plot($r,600,150,$answers));
     }      }
       #
       if (ref($response_data) ne 'ARRAY') {
           $r->print('<h2>'.
                     &mt('There is no submission data for this resource').
                     '</h2>');
           return;
       }
     my $analysis_html = '<table>';      my $analysis_html = '<table>';
     for (my $plot_num = 1;$plot_num<=$ENV{'form.NumPlots'};$plot_num++) {      for (my $plot_num = 1;$plot_num<=$ENV{'form.NumPlots'};$plot_num++) {
         my $restriction_function;          my $restriction_function;
Line 253  sub numerical_response_analysis { Line 261  sub numerical_response_analysis {
             $no_data_message = 'No data for [_2] to [_3]';              $no_data_message = 'No data for [_2] to [_3]';
         }          }
         #          #
         my ($correct,$intervals,$answers) =           my ($correct,$answers) = 
             &numerical_response_determine_intervals($r,$resource,$partid,              &numerical_determine_answers($r,$resource,$partid,
                                                     $respid,$students);                                           $respid,$students);
         if ($c->aborted()) { return; };          if ($c->aborted()) { return; };
         #          #
         my $responses = &numerical_classify_responses($response_data,          my $responses = &numerical_classify_responses($response_data,$correct,
                                                       $correct,  
                                                       $restriction_function);                                                        $restriction_function);
         if ($responses->{'_count'} == 0) {          if ($responses->{'_count'} == 0) {
             $analysis_html.=               $analysis_html.= 
Line 301  sub numerical_plot_percent { Line 308  sub numerical_plot_percent {
     #      #
     my $total = $responses->{'_count'};      my $total = $responses->{'_count'};
     return '' if ($total == 0);      return '' if ($total == 0);
     my $minbin = 0.5;      my $minbin = 5;
     while (my ($interval,$submissions) = each(%$responses)) {      while (my ($interval,$submissions) = each(%$responses)) {
         next if ($interval =~ /^_/);          next if ($interval =~ /^_/);
         my ($ans,$ans_low,$ans_high) = split(" ",$interval);          my ($ans,$ans_low,$ans_high) = split(" ",$interval);
         my $low_percent  = abs(($ans-$ans_low)/$ans);          my $low_percent  = abs(100*($ans-$ans_low)/$ans);
         my $high_percent = abs(($ans_high-$ans)/$ans);          my $high_percent = abs(100*($ans_high-$ans)/$ans);
         if ($minbin > $high_percent) { $minbin = $high_percent; }          if ($minbin > $high_percent) { $minbin = $high_percent; }
         if ($minbin > $low_percent) { $minbin = $low_percent; }          if ($minbin > $low_percent) { $minbin = $low_percent; }
     }          }
     #      #
     my @bins;      my @bins;
     if ($minbin < 1) {      if ($minbin < 1) {
Line 428  sub numerical_plot_differences { Line 435  sub numerical_plot_differences {
 }  }
   
 sub numerical_classify_responses {  sub numerical_classify_responses {
       &Apache::lonnet::logthis('--------------');
     my ($full_row_data,$correct,$function) = @_;      my ($full_row_data,$correct,$function) = @_;
     my %submission_data;      my %submission_data;
     my %students;      my %students;
     my $max=0;      my $max=0;
     foreach my $row (@$full_row_data) {      foreach my $row (@$full_row_data) {
   #        &Apache::lonnet::logthis(' row = '.join(',',@$row));
         my %subm = &hashify_attempt($row);          my %subm = &hashify_attempt($row);
         if (ref($correct) eq 'HASH') {          if (ref($correct) eq 'HASH') {
             $subm{'correct'} = $correct->{$subm{'student'}};              $subm{'correct'} = $correct->{$subm{'student'}}->{'answer'};
         } else {              $subm{'unit'} = $correct->{$subm{'student'}}->{'unit'};
             $subm{'correct'} = $correct;          } else { # This probably never happens....
               $subm{'correct'} = $correct->{'answer'};
               $subm{'unit'} = $correct->{'unit'};
         }          }
         $subm{'submission'} =~ s/=\d+\s*$//;          $subm{'submission'} =~ s/=\d+\s*$//;
         if (&$function(\%subm)) {          if (&$function(\%subm)) {
               my $scaled = '1';
               my ($sname,$sdom) = split(':',$subm{'student'});
               # Note that $subm{'unit'} is modified by the following call
               # We do not use it again but you should be aware just in case.
   #            my ($myunit,$mysub) = ($subm{'unit'},$subm{'submission'});
   #            $myunit = 'm';
   #            # &Apache::lonnet::logthis($myunit);
   #            my $result = 
   #                &capa::caparesponse_get_real_response($myunit,
   #                                                      $mysub,
   #                                                      \$scaled);
   #            # &Apache::lonnet::logthis('  '.$myunit.':'.$subm{'unit'}.
   #            #  ' '.$mysub.':'.$subm{'submission'}.'; '.$result);
   #            next if (! defined($scaled));
   #            next if ($result ne '6');
   #            my $submission = $scaled;
             my $submission = $subm{'submission'};              my $submission = $subm{'submission'};
             $students{$subm{'student'}}++;              $students{$subm{'student'}}++;
             if (&numerical_submission_is_correct($subm{'award'})) {               if (&numerical_submission_is_correct($subm{'award'})) { 
                   &Apache::lonnet::logthis('correct:'.$submission.':'.$subm{'correct'});
                 $submission_data{'_correct'}++;                  $submission_data{'_correct'}++;
                 $submission_data{'_count'}++;                  $submission_data{'_count'}++;
                 $submission_data{$subm{'correct'}}->{$submission}->[0]++;                  $submission_data{$subm{'correct'}}->{$submission}->[0]++;
             } elsif (&numerical_submission_is_incorrect($subm{'award'})) {               } elsif (&numerical_submission_is_incorrect($subm{'award'})) { 
                   &Apache::lonnet::logthis('incorrect:'.$submission.':'.$subm{'correct'});
                 $submission_data{'_count'}++;                  $submission_data{'_count'}++;
                 $submission_data{$subm{'correct'}}->{$submission}->[1]++;                  $submission_data{$subm{'correct'}}->{$submission}->[1]++;
             }              }
Line 464  sub numerical_classify_responses { Line 493  sub numerical_classify_responses {
   
 sub numerical_submission_is_correct {  sub numerical_submission_is_correct {
     my ($award) = @_;      my ($award) = @_;
       &Apache::lonnet::logthis('award = "'.$award.'"');
     if ($award =~ /^(APPROX_ANS|EXACT_ANS)$/) {      if ($award =~ /^(APPROX_ANS|EXACT_ANS)$/) {
         return 1;          return 1;
     } else {      } else {
Line 512  sub numerical_bin_table { Line 542  sub numerical_bin_table {
     return $table;      return $table;
 }  }
   
 sub numerical_response_determine_intervals {  sub numerical_determine_answers {
     my ($r,$resource,$partid,$respid,$students)=@_;      my ($r,$resource,$partid,$respid,$students)=@_;
     my $c = $r->connection();      my $c = $r->connection();
     #      #
Line 522  sub numerical_response_determine_interva Line 552  sub numerical_response_determine_interva
     &Apache::lonstathelpers::ensure_proper_cache($resource->{'symb'});      &Apache::lonstathelpers::ensure_proper_cache($resource->{'symb'});
     #      #
     my $correct;      my $correct;
     # %intervals differs from %answers because it may be possible for two  
     # students to have the same correct answer but different intervals.  
     my %intervals;   
     my %answers;      my %answers;
     foreach my $student (@$students) {      foreach my $student (@$students) {
         last if ($c->aborted());          last if ($c->aborted());
Line 537  sub numerical_response_determine_interva Line 564  sub numerical_response_determine_interva
                                                                 $sdom);                                                                  $sdom);
         # make the key          # make the key
         my $key = $partid.'.'.$respid;          my $key = $partid.'.'.$respid;
         my $interval = join(' ',($analysis->{$key.'.answer'}->[0],          $correct->{$sname.':'.$sdom}->{'answer'} = 
                                  $analysis->{$key.'.ans_low'}->[0],              $analysis->{$key.'.answer'}->[0];
                                  $analysis->{$key.'.ans_high'}->[0]));          $correct->{$sname.':'.$sdom}->{'unit'} = 
         $correct->{$sname.':'.$sdom} = $interval;              $analysis->{$key.'.unit'}->[0];
         $intervals{$interval}++;  
         $answers{$analysis->{$key.'.answer'}->[0]}++;          $answers{$analysis->{$key.'.answer'}->[0]}++;
     }      }
     &Apache::lonstathelpers::write_analysis_cache();      &Apache::lonstathelpers::write_analysis_cache();
     return ($correct,\%intervals,\%answers);      return ($correct,\%answers);
 }  }
   
 #  #
Line 571  sub numerical_one_dimensional_plot { Line 597  sub numerical_one_dimensional_plot {
         }          }
     }      }
     #      #
     my $h_scale = ($width-10)/($max_x-$min_x);      my $min_max_difference = $max_x - $min_x;
       if (! defined($min_max_difference) || $min_max_difference == 0) {
           $min_max_difference = 1;
       }
       my $h_scale = ($width-10)/$min_max_difference;
     #      #
     my $ticscale = 5;      my $ticscale = 5;
     if ($max_y * $ticscale > $height/2) {      if ($max_y * $ticscale > $height/2) {
Line 601  sub numerical_one_dimensional_plot { Line 631  sub numerical_one_dimensional_plot {
     }      }
     $plot .= '</drawimage>';      $plot .= '</drawimage>';
     my $plotresult =  &Apache::lonxml::xmlparse($r,'web',$plot);      my $plotresult =  &Apache::lonxml::xmlparse($r,'web',$plot);
       
     my $result = '<table>'.      my $result = '<table>'.
         '<tr><td colspan="3" align="center">'.          '<tr><td colspan="3" align="center">'.
         '<font size="+2">'.&mt('Distribution of correct answers').'</font>'.          '<font size="+2">'.&mt('Distribution of correct answers').'</font>'.
Line 652  sub circle { Line 681  sub circle {
     return &arc($x,$y,$radius,$radius,0,360,$color,$thickness,$filled);      return &arc($x,$y,$radius,$radius,0,360,$color,$thickness,$filled);
 }  }
   
 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;  
 }  
   
 #########################################################  #########################################################
 #########################################################  #########################################################
 ##  ##
Line 700  sub radio_response_analysis { Line 702  sub radio_response_analysis {
     my $analysis_html;      my $analysis_html;
     my $foildata = $problem_analysis->{'_Foils'};      my $foildata = $problem_analysis->{'_Foils'};
     my ($table,$foils,$concepts) = &build_foil_index($problem_analysis);      my ($table,$foils,$concepts) = &build_foil_index($problem_analysis);
       if (! defined($concepts)) {
           $concepts = [];
       }
     #      #
     my %true_foils;      my %true_foils;
     my $num_true = 0;      my $num_true = 0;
Line 1593  sub OR_time_process_data { Line 1598  sub OR_time_process_data {
 ##  ##
 #########################################################  #########################################################
 #########################################################  #########################################################
   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;
   }
   
 sub OR_excel_sheet {  sub OR_excel_sheet {
     my ($r,$resource,$performance_data,$ORdata) = @_;      my ($r,$resource,$performance_data,$ORdata) = @_;
     my $response = '';      my $response = '';
Removed from v.1.105  
changed lines
  Added in v.1.106

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