[BACK]Return to grades.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/grades.pm between versions 1.522 and 1.523

version 1.522, 2008/05/24 00:34:12 version 1.523, 2008/06/24 17:42:01
Line 5145  sub scantron_selectphase { Line 5145  sub scantron_selectphase {
 ');  ');
   
     &Apache::lonpickcode::code_list($r,2);      &Apache::lonpickcode::code_list($r,2);
   
       $r>print('<br /><form method="post" name="checkscantron">'.
                $default_form_data."\n".
                &Apache::loncommon::start_data_table('LC_scantron_action')."\n".
                &Apache::loncommon::start_data_table_header_row()."\n".
                '<th colspan="2">
                 &nbsp;'.&mt('Review scantron data and submissions for a previously graded folder/sequence')."\n".
                '</th>'."\n".
                 &Apache::loncommon::end_data_table_header_row()."\n".
                 &Apache::loncommon::start_data_table_row()."\n".
                 '<td> '.&mt('Graded folder/sequence:').' </td>'."\n".
                 '<td> '.$sequence_selector.' </td>'.
                 &Apache::loncommon::end_data_table_row()."\n".
                 &Apache::loncommon::start_data_table_row()."\n".
                 '<td> '.&mt('Filename of scoring office file:').' </td>'."\n".
                 '<td> '.$file_selector.' </td>'."\n".
                 &Apache::loncommon::end_data_table_row()."\n".
                 &Apache::loncommon::start_data_table_row()."\n".
                 '<td> '.&mt('Format of data file:').' </td>'."\n".
                 '<td> '.$format_selector.' </td>'."\n".
                 &Apache::loncommon::end_data_table_row()."\n".
                 &Apache::loncommon::start_data_table_row()."\n".
                 '<td colspan="2">'."\n".
                 '<input type="hidden" name="command" value="checksubmissions" />'."\n".
                 '<input type="submit" value="'.&mt('Review Scantron Data and Submission Records').'" />'."\n".
                 '</td>'."\n".
                 &Apache::loncommon::end_data_table_row()."\n".
                 &Apache::loncommon::end_data_table()."\n".
                 '</form><br />');
     $r->print($grading_menu_button);      $r->print($grading_menu_button);
     return      return;
 }  }
   
 =pod  =pod
Line 7300  sub scantron_get_maxbubble { Line 7329  sub scantron_get_maxbubble {
     my $bubble_line     = 0;      my $bubble_line     = 0;
     foreach my $resource (@resources) {      foreach my $resource (@resources) {
         my $symb = $resource->symb();          my $symb = $resource->symb();
   
           my (@parts,@allparts,@possible_parts);
   
         # Need to retrieve part IDs and response IDs because essayresponse,          # Need to retrieve part IDs and response IDs because essayresponse,
         # reactionresponse and organicresponse items are not included in           # reactionresponse and organicresponse items are not included in 
         # $analysis{'parts'} from lonnet::ssi.            # $analysis{'parts'} from lonnet::ssi.  
         my %possible_part_ids;           if (ref($resource->parts()) eq 'ARRAY') {
         if (ref($resource->parts()) eq 'ARRAY') {   
             foreach my $part (@{$resource->parts()}) {              foreach my $part (@{$resource->parts()}) {
                 if (!&Apache::loncommon::check_if_partid_hidden($part,$symb,$udom,$uname)) {                  if (!&Apache::loncommon::check_if_partid_hidden($part,$symb,$udom,$uname)) {
                     my @resp_ids = $resource->responseIds($part);                      my @resp_ids = $resource->responseIds($part);
                     foreach my $id (@resp_ids) {                      foreach my $id (@resp_ids) {
                         $possible_part_ids{$part.'.'.$id} = 1;                          my $part_id = $part.'.'.$id;
                           push(@possible_parts,$part_id);
                     }                      }
                 }                  }
             }              }
         }          }
  my $result=&ssi_with_retries($resource->src(), $ssi_retries,  
  ('symb' => $symb,  
  'grade_target' => 'analyze',  
  'grade_courseid' => $cid,  
  'grade_domain' => $udom,  
  'grade_username' => $uname));  
  my (undef, $an) =  
     split(/_HASH_REF__/,$result, 2);  
   
         my @parts;          my $result=&ssi_with_retries($resource->src(), $ssi_retries,
                                           ('symb' => $symb,
                                            'grade_target' => 'analyze',
                                            'grade_courseid' => $cid,
                                            'grade_domain' => $udom,
                                            'grade_username' => $uname));
           my (undef, $an) =
               split(/_HASH_REF__/,$result, 2);
   
  my %analysis = &Apache::lonnet::str2hash($an);   my %analysis = &Apache::lonnet::str2hash($an);
   
Line 7335  sub scantron_get_maxbubble { Line 7366  sub scantron_get_maxbubble {
                 }                  }
             }              }
         }          }
         # Add part_ids for any essayresponse items.           # Add part_ids for any essayresponse, reactionresponse or 
         foreach my $part_id (keys(%possible_part_ids)) {          # organicresponse items. 
             if (($analysis{$part_id.'.type'} eq 'essayresponse') ||          foreach my $part_id (@possible_parts) {
                 ($analysis{$part_id.'.type'} eq 'reactionresponse') ||              if (grep(/^\Q$part_id\E$/,@parts)) {
                 ($analysis{$part_id.'.type'} eq 'organicresponse')) {                  push(@allparts,$part_id);
                 if (!grep(/^\Q$part_id\E$/,@parts)) {              } else {
                     push (@parts,$part_id);                  if (($analysis{$part_id.'.type'} eq 'essayresponse') ||
                       ($analysis{$part_id.'.type'} eq 'reactionresponse') ||
                       ($analysis{$part_id.'.type'} eq 'organicresponse')) {
                       push (@allparts,$part_id);
                 }                  }
             }              }
         }          }
   
  foreach my $part_id (@parts) {   foreach my $part_id (@allparts) {
             my $lines = $analysis{"$part_id.bubble_lines"};              my $lines;
   
     # TODO - make this a persistent hash not an array.      # TODO - make this a persistent hash not an array.
   
Line 7374  sub scantron_get_maxbubble { Line 7408  sub scantron_get_maxbubble {
                     $numshown = scalar(@{$analysis{$part_id.'.shown'}});                      $numshown = scalar(@{$analysis{$part_id.'.shown'}});
                 }                  }
                 my $bubbles_per_line = 10;                  my $bubbles_per_line = 10;
                 my $inner_bubble_lines = int($numshown/$bubbles_per_line);                  my $inner_bubble_lines = int($numbub/$bubbles_per_line);
                 if (($numshown % $bubbles_per_line) != 0) {                  if (($numbub % $bubbles_per_line) != 0) {
                     $inner_bubble_lines++;                      $inner_bubble_lines++;
                 }                  }
                 for (my $i=0; $i<$numshown; $i++) {                  for (my $i=0; $i<$numshown; $i++) {
Line 7383  sub scantron_get_maxbubble { Line 7417  sub scantron_get_maxbubble {
                         $inner_bubble_lines.',';                          $inner_bubble_lines.',';
                 }                  }
                 $subdivided_bubble_lines{$response_number} =~ s/,$//;                  $subdivided_bubble_lines{$response_number} =~ s/,$//;
                   $lines = $numshown * $inner_bubble_lines;
               } else {
                   $lines = $analysis{"$part_id.bubble_lines"};
             }               } 
   
             $first_bubble_line{$response_number} = $bubble_line;              $first_bubble_line{$response_number} = $bubble_line;
Line 7802  sub scantron_download_scantron_data { Line 7839  sub scantron_download_scantron_data {
     return '';      return '';
 }  }
   
   sub checkscantron_results {
       my ($r) = @_;
       my ($symb)=&get_symb($r);
       if (!$symb) {return '';}
       my $grading_menu_button=&show_grading_menu_form($symb);
       my $cid = $env{'request.course.id'};
       my %lettdig = (
                       A => 1,
                       B => 2,
                       C => 3,
                       D => 4,
                       E => 5,
                       F => 6,
                       G => 7,
                       H => 8,
                       I => 9,
                       J => 0,
                     );
       my $numletts = scalar(keys(%lettdig));
       my $cnum = $env{'course.'.$cid.'.num'};
       my $cdom = $env{'course.'.$cid.'.domain'};
       my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'});
       my %record;
       my %scantron_config =
           &Apache::grades::get_scantron_config($env{'form.scantron_format'});
       my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile();
       my $classlist=&Apache::loncoursedata::get_classlist();
       my %idmap=&Apache::grades::username_to_idmap($classlist);
       my $navmap=Apache::lonnavmaps::navmap->new();
       my $map=$navmap->getResourceByUrl($sequence);
       my @resources=$navmap->retrieveResources($map,undef,1,0);
       my (%scandata,%lastname,%bylast);
       $r->print('
   <form method="post" enctype="multipart/form-data" action="/adm/grades" name="checkscantron">'."\n");
   
       my @delayqueue;
       my %completedstudents;
   
       my $count=&Apache::grades::get_todo_count($scanlines,$scan_data);
       my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron/Submissions Comparison Status',
                                       'Progress of Scantron Data/Submission Records Comparison',$count,
                                       'inline',undef,'checkscantron');
       my ($username,$domain,$uname,$started);
   
       &Apache::grades::scantron_get_maxbubble();  # Need the bubble lines array to parse.
   
       &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
                                             'Processing first student');
       my $start=&Time::HiRes::time();
       my $i=-1;
   
       while ($i<$scanlines->{'count'}) {
           ($username,$domain,$uname)=('','','');
           $i++;
           my $line=&Apache::grades::scantron_get_line($scanlines,$scan_data,$i);
           if ($line=~/^[\s\cz]*$/) { next; }
           if ($started) {
               &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                                                        'last student');
           }
           $started=1;
           my $scan_record=
               &Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config,
                                                        $scan_data);
           unless ($uname=&Apache::grades::scantron_find_student($scan_record,$scan_data,
                                                                 \%idmap,$i)) {
               &Apache::grades::scantron_add_delay(\@delayqueue,$line,
                                   'Unable to find a student that matches',1);
               next;
           }
           if (exists $completedstudents{$uname}) {
               &Apache::grades::scantron_add_delay(\@delayqueue,$line,
                                   'Student '.$uname.' has multiple sheets',2);
               next;
           }
           my $pid = $scan_record->{'scantron.ID'};
           $lastname{$pid} = $scan_record->{'scantron.LastName'};
           push(@{$bylast{$lastname{$pid}}},$pid);
           my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};
           $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos);
           chomp($scandata{$pid});
           $scandata{$pid} =~ s/\r$//;
           ($username,$domain)=split(/:/,$uname);
           my $counter = -1;
           my (%expected,%startpos);
           foreach my $resource (@resources) {
               next if (!$resource->is_problem());
               my $symb = $resource->symb();
               my $partsref = $resource->parts();
               my @parts;
               my @part_ids = ();
               if (ref($partsref) eq 'ARRAY') {
                  @parts = @{$partsref};
                  foreach my $part (@parts) {
                      my @resp_ids = $resource->responseIds($part);
                      foreach my $resp (@resp_ids) {
                          $counter ++;
                          my $part_id = $part.'.'.$resp;
                          $expected{$part_id} = 0;
                          push(@part_ids,$part_id);
                          if ($env{"form.scantron.sub_bubblelines.$counter"}) {
                              my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$counter"});
                              foreach my $item (@sub_lines) {
                                  $expected{$part_id} += $item;
                              }
                          } else {
                              $expected{$part_id} = $env{"form.scantron.bubblelines.$counter"};
                          }
                          $startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"};
                      }
                   }
               }
               if ($symb) {
                   my %recorded;
                   my (%returnhash) =
                       &Apache::lonnet::restore($symb,$cid,$domain,$username);
                   if ($returnhash{'version'}) {
                       my %lasthash=();
                       my $version;
                       for ($version=1;$version<=$returnhash{'version'};$version++) {
                           foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                               $lasthash{$key}=$returnhash{$version.':'.$key};
                           }
                       }
                       foreach my $key (keys(%lasthash)) {
                           if ($key =~ /\.scantron$/) {
                               my $value = &unescape($lasthash{$key});
                               my ($part_id) = ($key =~ /^resource\.(.+)\.scantron$/);
                               if ($value eq '') {
                                   for (my $i=0; $i<$expected{$part_id}; $i++) {
                                       for (my $j=0; $j<$scantron_config{'length'}; $j++) {
                                           $recorded{$part_id} .= $;
                                       }
                                   }
                               } else {
                                   my @tocheck;
                                   my @items = split(//,$value);
                                   if (($scantron_config{'Qon'} eq 'letter') ||
                                       ($scantron_config{'Qon'} eq 'number')) {
                                       if (@items < $expected{$part_id}) {
                                           my $fragment = substr($scandata{$pid},$startpos{$part_id},$expected{$part_id});
                                           my @singles = split(//,$fragment);
                                           foreach my $pos (@singles) {
                                               if ($pos eq ' ') {
                                                   push(@tocheck,$pos);
                                               } else {
                                                   my $next = shift(@items);
                                                   push(@tocheck,$next);
                                               }
                                           }
                                       } else {
                                           @tocheck = @items;
                                       }
                                       foreach my $letter (@tocheck) {
                                           if ($scantron_config{'Qon'} eq 'letter') {
                                               if ($letter !~ /^[A-J]$/) {
                                                   $letter = $scantron_config{'Qoff'};
                                               }
                                               $recorded{$part_id} .= $letter;
                                           } elsif ($scantron_config{'Qon'} eq 'number') {
                                               my $digit;
                                               if ($letter !~ /^[A-J]$/) {
                                                   $digit = $scantron_config{'Qoff'};
                                               } else {
                                                   $digit = $lettdig{$letter};
                                               }
                                               $recorded{$part_id} .= $digit;
                                           }
                                       }
                                   } else {
                                       @tocheck = @items;
                                       for (my $i=0; $i<$expected{$part_id}; $i++) {
                                           my $curr_sub = shift(@tocheck);
                                           my $digit;
                                           if ($curr_sub =~ /^[A-J]$/) {
                                               $digit = $lettdig{$curr_sub}-1;
                                           }
                                           if ($curr_sub eq 'J') {
                                               $digit += scalar($numletts);
                                           }
                                           for (my $j=0; $j<$scantron_config{'Qlength'}; $j++) {
                                               if ($j == $digit) {
                                                   $recorded{$part_id} .= $scantron_config{'Qon'};
                                               } else {
                                                   $recorded{$part_id} .= $scantron_config{'Qoff'};
                                               }
                                           }
                                       }
                                   }
                               }
                           }
                       }
                   }
                   foreach my $part_id (@part_ids) {
                       if ($recorded{$part_id} eq '') {
                           for (my $i=0; $i<$expected{$part_id}; $i++) {
                               for (my $j=0; $j<$scantron_config{'Qlength'}; $j++) {
                                   $recorded{$part_id} .= $scantron_config{'Qoff'};
                               }
                           }
                       }
                       $record{$pid} .= $recorded{$part_id};
                   }
               }
           }
       }
       &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
       $r->print('<br />');
       my ($okstudents,$badstudents,$numstudents,$passed,$failed);
       $passed = 0;
       $failed = 0;
       $numstudents = 0;
       foreach my $last (sort(keys(%bylast))) {
           if (ref($bylast{$last}) eq 'ARRAY') {
               foreach my $pid (sort(@{$bylast{$last}})) {
                   my $showscandata = $scandata{$pid};
                   my $showrecord = $record{$pid};
                   $showscandata =~ s/\s/&nbsp;/g;
                   $showrecord =~ s/\s/&nbsp;/g;
                   if ($scandata{$pid} eq $record{$pid}) {
                       my $css_class = ($passed % 2)?'LC_odd_row':'LC_even_row';
                       $okstudents .= '<tr class="'.$css_class.'">'.
   '<td>'.&mt('Scantron').'</td><td>'.$showscandata.'</td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n".
   '</tr>'."\n".
   '<tr class="'.$css_class.'">'."\n".
   '<td>Submissions</td><td>'.$showrecord.'</td></tr>'."\n";
                       $passed ++;
                   } else {
                       my $css_class = ($failed % 2)?'LC_odd_row':'LC_even_row';
                       $badstudents .= '<tr class="'.$css_class.'"><td>'.&mt('Scantron').'</td><td><span class="LC_nobreak">'.$scandata{$pid}.'</span></td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n".
   '</tr>'."\n".
   '<tr class="'.$css_class.'">'."\n".
   '<td>Submissions</td><td><span class="LC_nobreak">'.$record{$pid}.'</span></td>'."\n".
   '</tr>'."\n";
                       $failed ++;
                   }
                   $numstudents ++;
               }
           }
       }
       $r->print('<p>'.&mt('Comparison of scantron data (including corrections) with corresponding submission records (most recent submission) for <b>[quant,_1,student]</b>  ([_2] scantron lines/student).',$numstudents,$env{'form.scantron_maxbubble'}).'</p>');
       $r->print('<p>'.&mt('Exact matches for <b>[quant,_1,student]</b>.',$passed).'<br />'.&mt('Discrepancies detected for <b>[quant,_1,student]</b>.',$failed).'</p>');
       if ($passed) {
           $r->print(&mt('Students with exact correspondence between scantron data and submissions are as follows:').'<br /><br />');
           $r->print(&Apache::loncommon::start_data_table()."\n".
                    &Apache::loncommon::start_data_table_header_row()."\n".
                    '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'.
                    &Apache::loncommon::end_data_table_header_row()."\n".
                    $okstudents."\n".
                    &Apache::loncommon::end_data_table().'<br />');
       }
       if ($failed) {
           $r->print(&mt('Students with differences between scantron data and submissions are as follows:').'<br /><br />');
           $r->print(&Apache::loncommon::start_data_table()."\n".
                    &Apache::loncommon::start_data_table_header_row()."\n".
                    '<th>'.&mt('Source').'</th><th>'.&mt('Bubble records').'</th><th>'.&mt('Name').'</th><th>'.&mt('ID').'</th>'.
                    &Apache::loncommon::end_data_table_header_row()."\n".
                    $badstudents."\n".
                    &Apache::loncommon::end_data_table()).'<br />'.
                    &mt('Differences can occur if submissions were modified using manual grading after a scantron grading pass.').'<br />'.&mt('If unexpected discrepancies were detected, it is recommended that you inspect the original scantron sheets.');  
       }
       $r->print('</form><br />'.$grading_menu_button);
       return;
   }
   
 =pod  =pod
   
 =back  =back
Line 7874  sub grading_menu { Line 8176  sub grading_menu {
     $fields{'command'} = 'scantron_selectphase';      $fields{'command'} = 'scantron_selectphase';
     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);      $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
     push (@menu, { url => $url,      push (@menu, { url => $url,
                    name => &mt('Grade/Manage Scantron Forms'),                     name => &mt('Grade/Manage/Review Scantron Forms'),
                    short_description =>                      short_description => 
             &mt('')});              &mt('Grade scantron exams, upload/download scantron data files, and review previously graded scantron exams.')});
     $fields{'command'} = 'verify';      $fields{'command'} = 'verify';
     $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);      $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
     push (@menu, { url => "",      push (@menu, { url => "",
Line 8770  sub handler { Line 9072  sub handler {
   } elsif ($command eq 'scantron_download' &&    } elsif ($command eq 'scantron_download' &&
  &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {   &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
      $request->print(&scantron_download_scantron_data($request));       $request->print(&scantron_download_scantron_data($request));
           } elsif ($command eq 'checksubmissions' && $perm{'vgr'}) {
               $request->print(&checkscantron_results($request));     
  } elsif ($command) {   } elsif ($command) {
     $request->print("Access Denied ($command)");      $request->print("Access Denied ($command)");
  }   }
Removed from v.1.522  
changed lines
  Added in v.1.523

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