[LON-CAPA-cvs] cvs: loncom /homework grades.pm
raeburn
lon-capa-cvs-allow@mail.lon-capa.org
Tue, 24 Jun 2008 17:42:05 -0000
This is a MIME encoded message
--raeburn1214329325
Content-Type: text/plain
raeburn Tue Jun 24 13:42:05 2008 EDT
Modified files:
/loncom/homework grades.pm
Log:
Ability for a CC to run a comparison of raw scantron data with corresponding submission records for previously graded scantron exams.
- Discrepancies detected.
- Summary of recorded bubbles and corresponding submissions for each student.
--raeburn1214329325
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20080624134205.txt"
Index: loncom/homework/grades.pm
diff -u loncom/homework/grades.pm:1.522 loncom/homework/grades.pm:1.523
--- loncom/homework/grades.pm:1.522 Fri May 23 20:34:12 2008
+++ loncom/homework/grades.pm Tue Jun 24 13:42:01 2008
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.522 2008/05/24 00:34:12 www Exp $
+# $Id: grades.pm,v 1.523 2008/06/24 17:42:01 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -5145,8 +5145,37 @@
');
&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">
+ '.&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);
- return
+ return;
}
=pod
@@ -7300,30 +7329,32 @@
my $bubble_line = 0;
foreach my $resource (@resources) {
my $symb = $resource->symb();
+
+ my (@parts,@allparts,@possible_parts);
+
# Need to retrieve part IDs and response IDs because essayresponse,
# reactionresponse and organicresponse items are not included in
# $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()}) {
if (!&Apache::loncommon::check_if_partid_hidden($part,$symb,$udom,$uname)) {
my @resp_ids = $resource->responseIds($part);
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);
@@ -7335,19 +7366,22 @@
}
}
}
- # Add part_ids for any essayresponse items.
- foreach my $part_id (keys(%possible_part_ids)) {
- if (($analysis{$part_id.'.type'} eq 'essayresponse') ||
- ($analysis{$part_id.'.type'} eq 'reactionresponse') ||
- ($analysis{$part_id.'.type'} eq 'organicresponse')) {
- if (!grep(/^\Q$part_id\E$/,@parts)) {
- push (@parts,$part_id);
+ # Add part_ids for any essayresponse, reactionresponse or
+ # organicresponse items.
+ foreach my $part_id (@possible_parts) {
+ if (grep(/^\Q$part_id\E$/,@parts)) {
+ push(@allparts,$part_id);
+ } else {
+ 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) {
- my $lines = $analysis{"$part_id.bubble_lines"};
+ foreach my $part_id (@allparts) {
+ my $lines;
# TODO - make this a persistent hash not an array.
@@ -7374,8 +7408,8 @@
$numshown = scalar(@{$analysis{$part_id.'.shown'}});
}
my $bubbles_per_line = 10;
- my $inner_bubble_lines = int($numshown/$bubbles_per_line);
- if (($numshown % $bubbles_per_line) != 0) {
+ my $inner_bubble_lines = int($numbub/$bubbles_per_line);
+ if (($numbub % $bubbles_per_line) != 0) {
$inner_bubble_lines++;
}
for (my $i=0; $i<$numshown; $i++) {
@@ -7383,6 +7417,9 @@
$inner_bubble_lines.',';
}
$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;
@@ -7802,6 +7839,271 @@
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/ /g;
+ $showrecord =~ s/\s/ /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
=back
@@ -7874,9 +8176,9 @@
$fields{'command'} = 'scantron_selectphase';
$url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
push (@menu, { url => $url,
- name => &mt('Grade/Manage Scantron Forms'),
+ name => &mt('Grade/Manage/Review Scantron Forms'),
short_description =>
- &mt('')});
+ &mt('Grade scantron exams, upload/download scantron data files, and review previously graded scantron exams.')});
$fields{'command'} = 'verify';
$url = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
push (@menu, { url => "",
@@ -8770,6 +9072,8 @@
} elsif ($command eq 'scantron_download' &&
&Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
$request->print(&scantron_download_scantron_data($request));
+ } elsif ($command eq 'checksubmissions' && $perm{'vgr'}) {
+ $request->print(&checkscantron_results($request));
} elsif ($command) {
$request->print("Access Denied ($command)");
}
--raeburn1214329325--