[LON-CAPA-cvs] cvs: loncom /homework grades.pm lonhomework.pm structuretags.pm
raeburn
raeburn at source.lon-capa.org
Mon Aug 11 19:33:41 EDT 2025
raeburn Mon Aug 11 23:33:41 2025 EDT
Modified files:
/loncom/homework lonhomework.pm structuretags.pm grades.pm
Log:
- Bug 6623.
- Pass-back of grades to launcher CMS for assignments accessed via LTI
mediated deep-linking includes partial credit due to late submission.
- Grading screens for (i) Individual students, (ii) Grading table,
(iii) Grade page/folder include "raw" score in textbox, and also show
partial credit factor due to late submission. A modified score entered
by instructor, will have the partial credit applied to it when shown
in Individual Points Overview and Assessment Chart, and in student's
view of grades.
-------------- next part --------------
Index: loncom/homework/lonhomework.pm
diff -u loncom/homework/lonhomework.pm:1.395 loncom/homework/lonhomework.pm:1.396
--- loncom/homework/lonhomework.pm:1.395 Sat Jun 28 14:35:00 2025
+++ loncom/homework/lonhomework.pm Mon Aug 11 23:33:41 2025
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Homework handler
#
-# $Id: lonhomework.pm,v 1.395 2025/06/28 14:35:00 raeburn Exp $
+# $Id: lonhomework.pm,v 1.396 2025/08/11 23:33:41 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2118,7 +2118,8 @@
if (($pbscope eq 'map') || ($pbscope eq 'nonrec')) {
if ((keys(%total_by_symb)) && (keys(%possible_by_symb))) {
($total,$possible) =
- &get_lti_score($uname,$udom,$usec,$map,$pbscope,\%total_by_symb,\%possible_by_symb);
+ &get_lti_score($uname,$udom,$usec,$map,$pbscope,
+ \%total_by_symb,\%possible_by_symb);
} else {
($total,$possible) = &get_lti_score($uname,$udom,$usec,$map,$pbscope);
}
@@ -2246,7 +2247,15 @@
my $parts = $curRes->parts();
foreach my $part (@{$parts}) {
next if ($curRes->solved($part) eq 'excused');
- $total += $curRes->weight($part) * $curRes->awarded($part);
+ my $points = $curRes->weight($part) * $curRes->awarded($part);
+ if ($curRes->latefrac($part) ne '') {
+ my $latefrac = $curRes->latefrac($part);
+ if (($latefrac < 1) && ($latefrac >= 0)) {
+ $points = $curRes->weight($part) *
+ $curRes->awarded($part) * $latefrac;
+ }
+ }
+ $total += $points if ($points);
$possible += $curRes->weight($part);
}
}
Index: loncom/homework/structuretags.pm
diff -u loncom/homework/structuretags.pm:1.592 loncom/homework/structuretags.pm:1.593
--- loncom/homework/structuretags.pm:1.592 Sat Jun 28 14:35:00 2025
+++ loncom/homework/structuretags.pm Mon Aug 11 23:33:41 2025
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# definition of tags that give a structure to a document
#
-# $Id: structuretags.pm,v 1.592 2025/06/28 14:35:00 raeburn Exp $
+# $Id: structuretags.pm,v 1.593 2025/08/11 23:33:41 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1570,7 +1570,7 @@
sub store_aggregates {
my ($symb,$courseid) = @_;
- my (%aggregate,%anoncounter,%randtrycounter);
+ my (%aggregate,%anoncounter,%randtrycounter,%gracecounter);
my @parts;
my $cdomain = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cname = $env{'course.'.$env{'request.course.id'}.'.num'};
@@ -1621,6 +1621,11 @@
}
}
}
+ if (($Apache::lonhomework::results{'resource.'.$part.'.latefrac'} ne '') &&
+ ($Apache::lonhomework::results{'resource.'.$part.'.latefrac'} < 1) &&
+ ($Apache::lonhomework::results{'resource.'.$part.'.latefrac'} >= 0)) {
+ $gracecounter{$symb."\0".$part} = 1;
+ }
}
if (keys(%aggregate) > 0) {
&Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
@@ -1634,6 +1639,10 @@
&Apache::lonnet::cput('nohist_randomizetry',\%randtrycounter,
$cdomain,$cname);
}
+ if (keys(%gracecounter) > 0) {
+ &Apache::lonnet::cput('nohist_grace',\%gracecounter,
+ $cdomain,$cname);
+ }
}
sub access_status_msg {
Index: loncom/homework/grades.pm
diff -u loncom/homework/grades.pm:1.811 loncom/homework/grades.pm:1.812
--- loncom/homework/grades.pm:1.811 Sat Jun 28 14:35:00 2025
+++ loncom/homework/grades.pm Mon Aug 11 23:33:41 2025
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.811 2025/06/28 14:35:00 raeburn Exp $
+# $Id: grades.pm,v 1.812 2025/08/11 23:33:41 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -890,12 +890,13 @@
my ($score, $weight, $latefrac) = @_;
my $tolerance = .00001;
- my $points = $score * $weight;
+ my $points;
if (($latefrac ne '') &&
($latefrac < 1) && ($latefrac >= 0)) {
- $points = $points * $latefrac;
+ $points = $score * $weight * $latefrac;
+ } else {
+ $points = $score * $weight;
}
-
# Check for nearness to 1/x.
my $check_for_nearness = sub {
my ($factor) = @_;
@@ -1382,7 +1383,18 @@
if (($record{'version'}) && (exists($record{"resource.$part.awarded"}))) {
my $awarded = $record{"resource.$part.awarded"};
if ($awarded) {
- $total += $weight * $awarded;
+ my $latefrac;
+ if (exists($record{"resource.$part.latefrac"})) {
+ if (($record{"resource.$part.latefrac"} >= 0) &&
+ ($record{"resource.$part.latefrac"} < 1)) {
+ $latefrac = $record{"resource.$part.latefrac"};
+ }
+ }
+ if ($latefrac ne '') {
+ $total += $weight * $awarded * $latefrac;
+ } else {
+ $total += $weight * $awarded;
+ }
}
}
}
@@ -1730,15 +1742,16 @@
}
sub process_passbacks {
- my ($context,$symbs,$cdom,$cnum,$udom,$uname,$usec,$weights,$awardeds,$excuseds,$needpb,
- $skip_passback,$pbsave,$pbids) = @_;
+ my ($context,$symbs,$cdom,$cnum,$udom,$uname,$usec,$weights,$awardeds,$excuseds,
+ $latefracs,$needpb,$skip_passback,$pbsave,$pbids) = @_;
if ((ref($needpb) eq 'HASH') && (ref($skip_passback) eq 'HASH') && (ref($pbsave) eq 'HASH')) {
- my (%weight,%awarded,%excused);
+ my (%weight,%awarded,%excused,%latefrac);
if ((ref($symbs) eq 'ARRAY') && (ref($weights) eq 'HASH') && (ref($awardeds) eq 'HASH') &&
- (ref($excuseds) eq 'HASH')) {
+ (ref($excuseds) eq 'HASH') && (ref($latefracs) eq 'HASH')) {
%weight = %{$weights};
%awarded = %{$awardeds};
%excused = %{$excuseds};
+ %latefrac = %{$latefracs};
}
my $uhome = &Apache::lonnet::homeserver($uname,$udom);
my @launchers = keys(%{$needpb});
@@ -1807,7 +1820,7 @@
if (ref($symbs) eq 'ARRAY') {
foreach my $symb (@{$symbs}) {
if ((ref($weight{$symb}) eq 'HASH') && (ref($awarded{$symb}) eq 'HASH') &&
- (ref($excused{$symb}) eq 'HASH')) {
+ (ref($excused{$symb}) eq 'HASH') && (ref($latefrac{$symb}) eq 'HASH')) {
foreach my $part (keys(%{$weight{$symb}})) {
if ($excused{$symb}{$part}) {
next;
@@ -1815,7 +1828,14 @@
my $partweight = $weight{$symb}{$part} eq '' ? 1 :
$weight{$symb}{$part};
if ($awarded{$symb}{$part}) {
- $total_by_symb{$symb} += $partweight * $awarded{$symb}{$part};
+ if (($latefrac{$symb}{$part} ne '') &&
+ ($latefrac{$symb}{$part} < 1) &&
+ ($latefrac{$symb}{$part} >= 0)) {
+ $total_by_symb{$symb} += $partweight * $awarded{$symb}{$part}
+ * $latefrac{$symb}{$part};
+ } else {
+ $total_by_symb{$symb} += $partweight * $awarded{$symb}{$part};
+ }
}
$possible_by_symb{$symb} += $partweight;
}
@@ -2929,6 +2949,19 @@
}
sub gradeBox_start {
+ my ($parts_ref,$record,$has_late) = @_;
+ my $showlatefrac;
+ if ((ref($parts_ref) eq 'HASH') && (ref($record) eq 'HASH') &&
+ (ref($has_late))) {
+ foreach my $partid (keys(%{$parts_ref})) {
+ if ((exists($record->{'resource.'.$partid.'.latefrac'})) &&
+ ($record->{'resource.'.$partid.'.latefrac'} ne '')) {
+ $showlatefrac = '<th>'.&mt('Late (fraction)').'</th>';
+ $$has_late = 1;
+ last;
+ }
+ }
+ }
return (
&Apache::loncommon::start_data_table()
.&Apache::loncommon::start_data_table_header_row()
@@ -2937,6 +2970,7 @@
.'<th> </th>'
.'<th>'.&mt('Assign Grade').'</th>'
.'<th>'.&mt('Weight').'</th>'
+ .$showlatefrac
.'<th>'.&mt('Grade Status').'</th>'
.&Apache::loncommon::end_data_table_header_row()
);
@@ -2949,16 +2983,16 @@
}
#--- displays the grading box, used in essay type problem and grading by page/sequence
sub gradeBox {
- my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_;
+ my ($request,$symb,$uname,$udom,$counter,$partid,$has_late,$record) = @_;
my $checkIcon = '<img alt="'.&mt('Check Mark').
'" src="'.&Apache::loncommon::lonhttpdurl($request->dir_config('lonIconsURL').'/check.gif').'" height="16" border="0" />';
my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname);
my $wgtmsg = ($wgt > 0) ? &mt('(problem weight)')
: '<span class="LC_info">'.&mt('problem weight assigned by computer').'</span>';
$wgt = ($wgt > 0 ? $wgt : '1');
+ my $latefrac = $$record{'resource.'.$partid.'.latefrac'};
my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ?
- '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt,
- $$record{'resource.'.$partid.'.latefrac'}));
+ '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt));
my $data_WGT='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";
my $display_part= &get_display_part($partid,$symb);
my %last_resets = &get_last_resets($symb,$env{'request.course.id'},
@@ -2991,6 +3025,9 @@
$line.='<td>/'.$wgt.' '.$wgtmsg.
($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? ' '.$checkIcon : '').
' </td>'."\n";
+ if ($has_late) {
+ $line.='<td>'.$latefrac.'</td>';
+ }
$line.='<td><select name="GD_SEL'.$counter.'_'.$partid.'" '.
'onchange="javascript:clearRadBox(this.form,\''.$counter.'_'.$partid.'\')" >'."\n";
if ($$record{'resource.'.$partid.'.solved'} eq 'excused') {
@@ -3544,6 +3581,9 @@
my @partlist;
my @gradePartRespid;
my @part_response_id;
+ my %unique_parts;
+ my $has_late;
+
if ($is_tool) {
@part_response_id = ([0,'']);
} else {
@@ -3553,7 +3593,8 @@
'<div class="LC_Box">'
.'<h3 class="LC_hcell">'.&mt('Assign Grades').'</h3>'
);
- $request->print(&gradeBox_start());
+ map { $unique_parts{$_->[0]} = 1; } @part_response_id;
+ $request->print(&gradeBox_start(\%unique_parts,\%record,\$has_late));
foreach my $part_response_id (@part_response_id) {
my ($partid,$respid) = @{ $part_response_id };
my $part_resp = join('_',@{ $part_response_id });
@@ -3561,7 +3602,7 @@
$seen{$partid}++;
push(@partlist,$partid);
push(@gradePartRespid,$partid.'.'.$respid);
- $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record));
+ $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,$has_late,\%record));
}
$request->print(&gradeBox_end()); # </div>
$request->print('</div>');
@@ -4286,7 +4327,7 @@
if (ref($res)) {
my $partlist = $res->parts();
if (ref($partlist) eq 'ARRAY') {
- my (%weights,%awardeds,%excuseds);
+ my (%weights,%awardeds,%excuseds,%latefracs);
foreach my $part (@{$partlist}) {
if ($res->status($part) eq $res->EXCUSED) {
$excuseds{$symb}{$part} = 1;
@@ -4309,7 +4350,7 @@
}
}
&process_passbacks('handgrade',[$symb],$cdom,$cnum,$clbudom,$clbuname,$clbusec,\%weights,
- \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave);
+ \%awardeds,\%excuseds,\%latefracs,\%needpb,\%skip_passback,\%pbsave);
}
}
}
@@ -4490,7 +4531,7 @@
if ((ref($needpb) eq 'HASH') && (keys(%{$needpb}))) {
$poss_pb = 1;
}
- my (%weights,%awardeds,%excuseds);
+ my (%weights,%awardeds,%excuseds,%latefracs);
my @parts = split(/:/,$env{'form.partlist'.$newflg});
foreach my $new_part (@parts) {
#collaborator ($submitter may vary for different parts)
@@ -4612,7 +4653,7 @@
}
if (($sendupdate || $totchg) && (!$submitter) && ($poss_pb)) {
&process_passbacks('handgrade',[$symb],$cdom,$cnum,$domain,$stuname,$usec,\%weights,
- \%awardeds,\%excuseds,$needpb,$skip_passback,$pbsave);
+ \%awardeds,\%excuseds,\%latefracs,$needpb,$skip_passback,$pbsave);
}
return ('',$pts,$wgt,$totchg,$sendupdate);
}
@@ -5232,10 +5273,15 @@
&Apache::loncommon::start_data_table_header_row().
'<th>'.&mt('No.').'</th>'.
'<th>'.&nameUserString('header')."</th>\n";
- my $partserror;
+ my ($partserror,%symbpartgrace,$hasgracecol);
my (@parts) = sort(&getpartlist($symb,\$partserror));
if ($partserror) {
return &navmap_errormsg();
+ } else {
+ %symbpartgrace = &Apache::lonnet::dump('nohist_grace',
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'},
+ "^$symb\0");
}
my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
my @partids = ();
@@ -5254,8 +5300,12 @@
$result.='<th>'.
&mt('Score Part: [_1][_2](weight = [_3])',
$display_part,'<br />',$weight{$partid}).'</th>'."\n";
+ if ($symbpartgrace{"$symb\0$partid"}) {
+ $result.='<th>'.&mt('Grace (fraction)').'<br />'.&mt('Part:').
+ ' '.$display_part.'</th>'."\n";
+ $hasgracecol = 1;
+ }
next;
-
} else {
if ($display =~ /Problem Status/) {
my $grade_status_mt = &mt('Grade Status');
@@ -5264,7 +5314,6 @@
my $part_mt = &mt('Part:');
$display =~s{\[Part: \Q$partid\E\]}{$part_mt $display_part};
}
-
$result.='<th>'.$display.'</th>'."\n";
}
$result.=&Apache::loncommon::end_data_table_header_row();
@@ -5284,7 +5333,8 @@
return $a cmp $b;
} (keys(%$fullname))) {
$result.=&viewstudentgrade($symb,$env{'request.course.id'},
- $_,$$fullname{$_},\@parts,\%weight,\$ctr,\%last_resets,$is_tool);
+ $_,$$fullname{$_},\@parts,\%weight,\$ctr,
+ \%last_resets,$is_tool,$hasgracecol);
}
$result.=&Apache::loncommon::end_data_table();
$result.='<input type="hidden" name="total" value="'.$ctr.'" />'."\n";
@@ -5372,7 +5422,7 @@
#--- call by previous routine to display each student who satisfies submission filter.
sub viewstudentgrade {
- my ($symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets,$is_tool) = @_;
+ my ($symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets,$is_tool,$hasgracecol) = @_;
my ($uname,$udom) = split(/:/,$student);
my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname);
my $submitonly = $env{'form.submitonly'};
@@ -5443,13 +5493,20 @@
$aggregates{$part} = 1;
}
if ($type eq 'awarded') {
- my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part},$latefrac);
+ my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part});
$result.='<input type="hidden" name="'.
'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n";
$result.='<input type="text" name="'.
'GD_'.$student.'_'.$part.'_awarded" '.
'onchange="javascript:changeSelect(\''.$part.'\',\''.$student.
- '\')" value="'.$pts.'" size="4" /></td>'."\n";
+ '\')" value="'.$pts.'" size="5" /></td>'."\n";
+ if ($hasgracecol) {
+ $result.= '<td align="center">';
+ if (($latefrac ne '') && ($latefrac < 1) && ($latefrac >= 0)) {
+ $result.= $latefrac;
+ }
+ $result.= '</td>'."\n";
+ }
} elsif ($type eq 'solved') {
my ($status,$foo)=split(/_/,$score,2);
$status = 'nothing' if ($status eq '');
@@ -5575,7 +5632,7 @@
my %aggregate = ();
my $aggregateflag = 0;
$user=~s/:/_/; # colon doen't work in javascript for names
- my (%weights,%awardeds,%excuseds);
+ my (%weights,%awardeds,%excuseds,%latefracs);
foreach (@partid) {
my $old_aw = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'};
my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);
@@ -5701,7 +5758,8 @@
if (keys(%needpb)) {
$weights{$symb} = \%weight;
&process_passbacks('editgrades',[$symb],$cdom,$cnum,$udom,$uname,$usec,\%weights,
- \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave);
+ \%awardeds,\%excuseds,\%latefracs,\%needpb,
+ \%skip_passback,\%pbsave);
}
} else {
push(@noupdate,
@@ -6093,7 +6151,7 @@
return &navmap_errormsg();
}
}
- my (%skip_passback,%pbsave,%weights,%awardeds,%excuseds);
+ my (%skip_passback,%pbsave,%weights,%awardeds,%excuseds,%latefracs);
foreach my $grade (@gradedata) {
my %entries=&Apache::loncommon::record_sep($grade);
@@ -6252,7 +6310,7 @@
}
}
&process_passbacks('csvupload',[$symb],$cdom,$cnum,$domain,$username,$usec,\%weights,
- \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave);
+ \%awardeds,\%excuseds,\%latefracs,\%needpb,\%skip_passback,\%pbsave);
}
} else {
$request->print("<p><span class=\"LC_error\">".
@@ -6612,13 +6670,16 @@
}
if (&canmodify($usec)) {
- $studentTable.=&gradeBox_start();
+ my $has_late;
+ my %unique_parts;
+ map { $unique_parts{$_} = 1; } @{$parts};
+ $studentTable.=&gradeBox_start(\%unique_parts,\%record,\$has_late);
foreach my $partid (@{$parts}) {
- $studentTable.=&gradeBox($request,$symbx,$uname,$udom,$question,$partid,\%record);
+ $studentTable.=&gradeBox($request,$symbx,$uname,$udom,$question,$partid,$has_late,\%record);
$studentTable.='<input type="hidden" name="q_'.$question.'" value="'.$partid.'" />'."\n";
$question++;
}
- $studentTable.=&gradeBox_end();
+ $studentTable.=&gradeBox_end();
$prob++;
}
$studentTable.='</td></tr>';
@@ -6849,7 +6910,7 @@
$iterator->next(); # skip the first BEGIN_MAP
my $curRes = $iterator->next(); # for "current resource"
my ($depth,$question,$prob,$changeflag,$hideflag)= (1,1,1,0,0);
- my (@updates,%weights,%excuseds,%awardeds, at symbs_in_map);
+ my (@updates,%weights,%excuseds,%latefracs,%awardeds, at symbs_in_map);
while ($depth > 0) {
if($curRes == $iterator->BEGIN_MAP) { $depth++; }
if($curRes == $iterator->END_MAP) { $depth--; }
@@ -7065,7 +7126,8 @@
}
my @symbs = keys(%uniqsymbs);
&process_passbacks('updatebypage',\@symbs,$cdom,$cnum,$udom,$uname,$usec,\%weights,
- \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave,\%pbids);
+ \%awardeds,\%excuseds,\%latefracs,\%needpb,\%skip_passback,
+ \%pbsave,\%pbids);
if (@Apache::grades::ltipassback) {
unless ($registered_cleanup) {
my $handlers = $request->get_handlers('PerlCleanupHandler');
@@ -12720,13 +12782,13 @@
} else {
$storecount++;
if (keys(%needpb)) {
- my (%weights,%awardeds,%excuseds);
+ my (%weights,%awardeds,%excuseds,%latefracs);
my $usec = &Apache::lonnet::getsection($domain,$username,$env{'request.course.id'});
$weights{$symb}{$part} = &Apache::lonnet::EXT("resource.$part.weight",$symb,$domain,$username,$usec);
$awardeds{$symb}{$part} = $ave;
$excuseds{$symb}{$part} = '';
&process_passbacks('clickergrade',[$symb],$cdom,$cnum,$domain,$username,$usec,\%weights,
- \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave);
+ \%awardeds,\%excuseds,\%latefracs,\%needpb,\%skip_passback,\%pbsave);
}
}
}
More information about the LON-CAPA-cvs
mailing list