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

Diff for /loncom/homework/grades.pm between versions 1.596.2.12.2.6 and 1.596.2.12.2.11

version 1.596.2.12.2.6, 2012/05/02 17:04:19 version 1.596.2.12.2.11, 2012/12/10 15:00:08
Line 52  use POSIX qw(floor); Line 52  use POSIX qw(floor);
   
   
 my %perm=();  my %perm=();
   my %old_essays=();
   
 #  These variables are used to recover from ssi errors  #  These variables are used to recover from ssi errors
   
Line 263  sub showResourceInfo { Line 264  sub showResourceInfo {
 sub reset_caches {  sub reset_caches {
     &reset_analyze_cache();      &reset_analyze_cache();
     &reset_perm();      &reset_perm();
       &reset_old_essays();
 }  }
   
 {  {
Line 746  sub compute_points { Line 748  sub compute_points {
 #  #
   
 sub most_similar {  sub most_similar {
     my ($uname,$udom,$uessay,$old_essays)=@_;      my ($uname,$udom,$symb,$uessay)=@_;
   
       unless ($symb) { return ''; }
   
       unless (ref($old_essays{$symb}) eq 'HASH') { return ''; }
   
 # ignore spaces and punctuation  # ignore spaces and punctuation
   
Line 763  sub most_similar { Line 769  sub most_similar {
     my $scrsid='';      my $scrsid='';
     my $sessay='';      my $sessay='';
 # go through all essays ...  # go through all essays ...
     foreach my $tkey (keys(%$old_essays)) {      foreach my $tkey (keys(%{$old_essays{$symb}})) {
  my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey));   my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey));
 # ... except the same student  # ... except the same student
         next if (($tname eq $uname) && ($tdom eq $udom));          next if (($tname eq $uname) && ($tdom eq $udom));
  my $tessay=$old_essays->{$tkey};   my $tessay=$old_essays{$symb}{$tkey};
  $tessay=~s/\W+/ /gs;   $tessay=~s/\W+/ /gs;
 # String similarity gives up if not even limit  # String similarity gives up if not even limit
  my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit);   my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit);
Line 777  sub most_similar { Line 783  sub most_similar {
     $sname=$tname;      $sname=$tname;
     $sdom=$tdom;      $sdom=$tdom;
     $scrsid=$tcrsid;      $scrsid=$tcrsid;
     $sessay=$old_essays->{$tkey};      $sessay=$old_essays{$symb}{$tkey};
  }   }
     }      }
     if ($limit>0.6) {      if ($limit>0.6) {
Line 2027  sub submission { Line 2033  sub submission {
  '" src="'.$request->dir_config('lonIconsURL').   '" src="'.$request->dir_config('lonIconsURL').
  '/check.gif" height="16" border="0" />';   '/check.gif" height="16" border="0" />';
   
     my %old_essays;  
     # header info      # header info
     if ($counter == 0) {      if ($counter == 0) {
  &sub_page_js($request);   &sub_page_js($request);
Line 2143  KEYWORDS Line 2148  KEYWORDS
     my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);      my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);
     $apath=&escape($apath);      $apath=&escape($apath);
     $apath=~s/\W/\_/gs;      $apath=~s/\W/\_/gs;
     %old_essays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname);              &init_old_essays($symb,$apath,$adom,$aname);
         }          }
     }      }
   
Line 2280  KEYWORDS Line 2285  KEYWORDS
                     }                      }
     if($env{'form.checkPlag'}){      if($env{'form.checkPlag'}){
  my ($oname,$odom,$ocrsid,$oessay,$osim)=   my ($oname,$odom,$ocrsid,$oessay,$osim)=
     &most_similar($uname,$udom,$subval,\%old_essays);      &most_similar($uname,$udom,$symb,$subval);
  if ($osim) {   if ($osim) {
     $osim=int($osim*100.0);      $osim=int($osim*100.0);
     my %old_course_desc =       my %old_course_desc = 
Line 7170  sub scantron_validate_sequence { Line 7175  sub scantron_validate_sequence {
  my @resources=   my @resources=
     $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0);      $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0);
  if (@resources) {   if (@resources) {
     $r->print("<p>".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')."</p>");      $r->print('<p class="LC_warning">'
                  .&mt('Some resources in the sequence currently are not set to'
                      .' exam mode. Grading these resources currently may not'
                      .' work correctly.')
                  .'</p>'
               );
     return (1,$currentphase);      return (1,$currentphase);
  }   }
     }      }
Line 8069  sub scantron_process_students { Line 8079  sub scantron_process_students {
     my $default_form_data=&defaultFormData($symb);      my $default_form_data=&defaultFormData($symb);
   
     my %scantron_config=&get_scantron_config($env{'form.scantron_format'});      my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
       my $bubbles_per_row =
           &bubblesheet_bubbles_per_row(\%scantron_config);
     my ($scanlines,$scan_data)=&scantron_getfile();      my ($scanlines,$scan_data)=&scantron_getfile();
     my $classlist=&Apache::loncoursedata::get_classlist();      my $classlist=&Apache::loncoursedata::get_classlist();
     my %idmap=&username_to_idmap($classlist);      my %idmap=&username_to_idmap($classlist);
Line 8078  sub scantron_process_students { Line 8090  sub scantron_process_students {
         return '';          return '';
     }        }  
     my $map=$navmap->getResourceByUrl($sequence);      my $map=$navmap->getResourceByUrl($sequence);
       my $randomorder;
       if (ref($map)) {
           $randomorder = $map->randomorder();
       }
     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);      my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
     my (%grader_partids_by_symb,%grader_randomlists_by_symb);      my (%grader_partids_by_symb,%grader_randomlists_by_symb,%ordered);
     &graders_resources_pass(\@resources,\%grader_partids_by_symb,      &graders_resources_pass(\@resources,\%grader_partids_by_symb,
                             \%grader_randomlists_by_symb);                              \%grader_randomlists_by_symb,$bubbles_per_row);
     my $resource_error;      my ($resource_error,%symb_to_resource,@master_seq);
     foreach my $resource (@resources) {      foreach my $resource (@resources) {
         my $ressymb;          my $ressymb;
         if (ref($resource)) {          if (ref($resource)) {
             $ressymb = $resource->symb();              $ressymb = $resource->symb();
               push(@master_seq,$ressymb);
               $symb_to_resource{$ressymb} = $resource;
         } else {          } else {
             $resource_error = 1;              $resource_error = 1;
             last;              last;
Line 8121  SCANTRONFORM Line 8139  SCANTRONFORM
           
     my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam'));      my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam'));
     my $count=&get_todo_count($scanlines,$scan_data);      my $count=&get_todo_count($scanlines,$scan_data);
     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Bubblesheet Status',      my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count);
      'Bubblesheet Progress',$count,  
     'inline',undef,'scantronupload');  
     &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,      &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
   'Processing first student');    'Processing first student');
     $r->print('<br />');      $r->print('<br />');
Line 8175  SCANTRONFORM Line 8191  SCANTRONFORM
   'Student '.$uname.' has multiple sheets',2);    'Student '.$uname.' has multiple sheets',2);
      next;       next;
   }    }
           my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION];
           my $user = $uname.':'.$usec;
   ($uname,$udom)=split(/:/,$uname);    ($uname,$udom)=split(/:/,$uname);
   
           my $scancode;
           if ((exists($scan_record->{'scantron.CODE'})) &&
               (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) {
               $scancode = $scan_record->{'scantron.CODE'};
           } else {
               $scancode = '';
           }
   
           my @mapresources = @resources;
           if ($randomorder) {
               @mapresources =
                   &users_order($user,$scancode,$sequence,\@master_seq,\%ordered,
                                \%symb_to_resource);
           }
         my (%partids_by_symb,$res_error);          my (%partids_by_symb,$res_error);
         foreach my $resource (@resources) {          foreach my $resource (@mapresources) {
             my $ressymb;              my $ressymb;
             if (ref($resource)) {              if (ref($resource)) {
                 $ressymb = $resource->symb();                  $ressymb = $resource->symb();
Line 8210  SCANTRONFORM Line 8242  SCANTRONFORM
     &scantron_putfile($scanlines,$scan_data);      &scantron_putfile($scanlines,$scan_data);
  }   }
   
         my $scancode;  
         if ((exists($scan_record->{'scantron.CODE'})) &&  
             (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) {  
             $scancode = $scan_record->{'scantron.CODE'};  
         } else {  
             $scancode = '';  
         }  
   
         if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,          if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
                                    \@resources,\%partids_by_symb,                                     \@mapresources,\%partids_by_symb,
                                    $bubbles_per_row) eq 'ssi_error') {                                     $bubbles_per_row) eq 'ssi_error') {
             $ssi_error = 0; # So end of handler error message does not trigger.              $ssi_error = 0; # So end of handler error message does not trigger.
             $r->print("</form>");              $r->print("</form>");
Line 8237  SCANTRONFORM Line 8261  SCANTRONFORM
             $studentdata =~ s/\r$//;              $studentdata =~ s/\r$//;
             my $studentrecord = '';              my $studentrecord = '';
             my $counter = -1;              my $counter = -1;
             foreach my $resource (@resources) {              foreach my $resource (@mapresources) {
                 my $ressymb = $resource->symb();                  my $ressymb = $resource->symb();
                 ($counter,my $recording) =                  ($counter,my $recording) =
                     &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},                      &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},
Line 8248  SCANTRONFORM Line 8272  SCANTRONFORM
             if ($studentrecord ne $studentdata) {              if ($studentrecord ne $studentdata) {
                 &Apache::lonxml::clear_problem_counter();                  &Apache::lonxml::clear_problem_counter();
                 if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,                  if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
                                            \@resources,\%partids_by_symb,                                             \@mapresources,\%partids_by_symb,
                                            $bubbles_per_row) eq 'ssi_error') {                                             $bubbles_per_row) eq 'ssi_error') {
                     $ssi_error = 0; # So end of handler error message does not trigger.                      $ssi_error = 0; # So end of handler error message does not trigger.
                     $r->print("</form>");                      $r->print("</form>");
Line 8260  SCANTRONFORM Line 8284  SCANTRONFORM
                 }                  }
                 $counter = -1;                  $counter = -1;
                 $studentrecord = '';                  $studentrecord = '';
                 foreach my $resource (@resources) {                  foreach my $resource (@mapresources) {
                     my $ressymb = $resource->symb();                      my $ressymb = $resource->symb();
                     ($counter,my $recording) =                      ($counter,my $recording) =
                         &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},                          &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},
Line 8314  SCANTRONFORM Line 8338  SCANTRONFORM
 }  }
   
 sub graders_resources_pass {  sub graders_resources_pass {
     my ($resources,$grader_partids_by_symb,$grader_randomlists_by_symb) = @_;      my ($resources,$grader_partids_by_symb,$grader_randomlists_by_symb,
           $bubbles_per_row) = @_;
     if ((ref($resources) eq 'ARRAY') && (ref($grader_partids_by_symb)) &&       if ((ref($resources) eq 'ARRAY') && (ref($grader_partids_by_symb)) && 
         (ref($grader_randomlists_by_symb) eq 'HASH')) {          (ref($grader_randomlists_by_symb) eq 'HASH')) {
         foreach my $resource (@{$resources}) {          foreach my $resource (@{$resources}) {
Line 8335  sub graders_resources_pass { Line 8360  sub graders_resources_pass {
     return;      return;
 }  }
   
   =pod
   
   =item users_order
   
     Returns array of resources in current map, ordered based on either CODE,
     if this is a CODEd exam, or based on student's identity if this is a
     "NAMEd" exam.
   
     Should be used when randomorder applied when the corresponding exam was
     printed, prior to students completing bubblesheets for the version of the
     exam the student received.
   
   =cut
   
   sub users_order  {
       my ($user,$scancode,$mapurl,$master_seq,$ordered,$symb_to_resource) = @_;
       my @mapresources;
       unless ((ref($ordered) eq 'HASH') && (ref($symb_to_resource) eq 'HASH')) {
           return @mapresources;
       }
       if (($scancode) && (ref($ordered->{$scancode}) eq 'ARRAY')) {
           @mapresources = @{$ordered->{$scancode}};
       } elsif ($scancode) {
           $env{'form.CODE'} = $scancode;
           my $actual_seq =
               &Apache::lonprintout::master_seq_to_person_seq($mapurl,
                                                              $master_seq,
                                                              $user,$scancode);
           if (ref($actual_seq) eq 'ARRAY') {
               @{$ordered->{$scancode}} =
                   map { $symb_to_resource->{$_}; } @{$actual_seq};
               @mapresources = @{$ordered->{$scancode}};
           }
           delete($env{'form.CODE'});
       } else {
           my $actual_seq =
               &Apache::lonprintout::master_seq_to_person_seq($mapurl,
                                                              $master_seq,
                                                              $user);
           if (ref($actual_seq) eq 'ARRAY') {
               @mapresources =
                   map { $symb_to_resource->{$_}; } @{$actual_seq};
           }
        }
        return @mapresources;
   }
   
 sub grade_student_bubbles {  sub grade_student_bubbles {
     my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts,$bubbles_per_row) = @_;      my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts,$bubbles_per_row) = @_;
     if (ref($resources) eq 'ARRAY') {      if (ref($resources) eq 'ARRAY') {
Line 8640  sub checkscantron_results { Line 8712  sub checkscantron_results {
     my %record;      my %record;
     my %scantron_config =      my %scantron_config =
         &Apache::grades::get_scantron_config($env{'form.scantron_format'});          &Apache::grades::get_scantron_config($env{'form.scantron_format'});
       my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config);
     my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile();      my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile();
     my $classlist=&Apache::loncoursedata::get_classlist();      my $classlist=&Apache::loncoursedata::get_classlist();
     my %idmap=&Apache::grades::username_to_idmap($classlist);      my %idmap=&Apache::grades::username_to_idmap($classlist);
Line 8649  sub checkscantron_results { Line 8722  sub checkscantron_results {
         return '';          return '';
     }      }
     my $map=$navmap->getResourceByUrl($sequence);      my $map=$navmap->getResourceByUrl($sequence);
       my ($randomorder,@master_seq,%symb_to_resource);
       if (ref($map)) {
           $randomorder=$map->randomorder();
       }
     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);      my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
       foreach my $resource (@resources) {
           if (ref($resource)) {
               my $ressymb = $resource->symb();
               push(@master_seq,$ressymb);
               $symb_to_resource{$ressymb} = $resource;
           }
       }
     my (%grader_partids_by_symb,%grader_randomlists_by_symb);      my (%grader_partids_by_symb,%grader_randomlists_by_symb);
     &graders_resources_pass(\@resources,\%grader_partids_by_symb,                             \%grader_randomlists_by_symb);      &graders_resources_pass(\@resources,\%grader_partids_by_symb,
                               \%grader_randomlists_by_symb,$bubbles_per_row);
     my ($uname,$udom);      my ($uname,$udom);
     my (%scandata,%lastname,%bylast);      my (%scandata,%lastname,%bylast);
     $r->print('      $r->print('
Line 8662  sub checkscantron_results { Line 8746  sub checkscantron_results {
     my %completedstudents;      my %completedstudents;
   
     my $count=&Apache::grades::get_todo_count($scanlines,$scan_data);      my $count=&Apache::grades::get_todo_count($scanlines,$scan_data);
     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Bubblesheet/Submissions Comparison Status',      my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count);
                                     'Progress of Bubblesheet Data/Submission Records Comparison',$count,      my ($username,$domain,$started,%ordered);
                                     'inline',undef,'checkscantron');  
     my ($username,$domain,$started);  
     my $nav_error;      my $nav_error;
     &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse.      &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse.
     if ($nav_error) {      if ($nav_error) {
Line 8709  sub checkscantron_results { Line 8791  sub checkscantron_results {
         $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos);          $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos);
         chomp($scandata{$pid});          chomp($scandata{$pid});
         $scandata{$pid} =~ s/\r$//;          $scandata{$pid} =~ s/\r$//;
           my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION];
           my $user = $uname.':'.$usec;
         ($username,$domain)=split(/:/,$uname);          ($username,$domain)=split(/:/,$uname);
   
           my $scancode;
           if ((exists($scan_record->{'scantron.CODE'})) &&
               (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) {
               $scancode = $scan_record->{'scantron.CODE'};
           } else {
               $scancode = '';
           }
   
           my @mapresources = @resources;
           if ($randomorder) {
               @mapresources =
                   &users_order($user,$scancode,$sequence,\@master_seq,\%ordered,
                                \%symb_to_resource);
           }
         my $counter = -1;          my $counter = -1;
         foreach my $resource (@resources) {          foreach my $resource (@mapresources) {
             my $parts;              my $parts;
             my $ressymb = $resource->symb();              my $ressymb = $resource->symb();
             if ((exists($grader_randomlists_by_symb{$ressymb})) ||              if ((exists($grader_randomlists_by_symb{$ressymb})) ||
Line 9272  sub init_perm { Line 9371  sub init_perm {
     }      }
 }  }
   
   sub init_old_essays {
       my ($symb,$apath,$adom,$aname) = @_;
       if ($symb ne '') {
           my %essays = &Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname);
           if (keys(%essays) > 0) {
               $old_essays{$symb} = \%essays;
           }
       }
       return;
   }
   
   sub reset_old_essays {
       undef(%old_essays);
   }
   
 sub gather_clicker_ids {  sub gather_clicker_ids {
     my %clicker_ids;      my %clicker_ids;
   
Removed from v.1.596.2.12.2.6  
changed lines
  Added in v.1.596.2.12.2.11

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