--- loncom/homework/grades.pm 2006/02/13 22:11:51 1.312 +++ loncom/homework/grades.pm 2006/02/27 02:06:52 1.319 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.312 2006/02/13 22:11:51 banghart Exp $ +# $Id: grades.pm,v 1.319 2006/02/27 02:06:52 bowersj2 Exp $ # # Copyright Michigan State University Board of Trustees # @@ -40,6 +40,7 @@ use Apache::lonmsg qw(:user_normal_msg); use Apache::Constants qw(:common); use Apache::lonlocal; use String::Similarity; +use POSIX qw(floor); my %oldessays=(); my %perm=(); @@ -467,6 +468,33 @@ sub jscriptNform { return $jscript; } +# Given the score (as a number [0-1] and the weight) what is the final +# point value? This function will round to the nearest tenth, third, +# or quarter if one of those is within the tolerance of .00001. +sub compute_points { + my ($score, $weight) = @_; + + my $tolerance = .00001; + my $points = $score * $weight; + + # Check for nearness to 1/x. + my $check_for_nearness = sub { + my ($factor) = @_; + my $num = ($points * $factor) + $tolerance; + my $floored_num = floor($num); + if ($num - $floored_num < 2 * $tolerance * $factor) { + return $floored_num / $factor; + } + return $points; + }; + + $points = $check_for_nearness->(10); + $points = $check_for_nearness->(3); + $points = $check_for_nearness->(4); + + return $points; +} + #------------------ End of general use routines -------------------- # @@ -1385,31 +1413,26 @@ SUBJAVASCRIPT #--- 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,$record,$respid) = @_; my $checkIcon = ''; - my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname); my $wgtmsg = ($wgt > 0 ? '(problem weight)' : 'problem weight assigned by computer'); $wgt = ($wgt > 0 ? $wgt : '1'); my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ? - '' : $$record{'resource.'.$partid.'.awarded'}*$wgt); + '' : compute_points($$record{'resource.'.$partid.'.awarded'},$wgt)); my $result=''."\n"; - + $result.='
'.$partid.' - '.$respid.'
'; my $display_part=&get_display_part($partid,undef,$symb); - my %last_resets = &get_last_resets($symb,$env{'request.course.id'}, [$partid]); my $aggtries = $$record{'resource.'.$partid.'.tries'}; if ($last_resets{$partid}) { $aggtries = &get_num_tries($record,$last_resets{$partid},$partid); } - $result.=''."\n"; $result.='
'. 'Part: '.$display_part.' Points: '."\n"; - my $ctr = 0; $result.=''."\n"; # display radio buttons in a nice table 10 across while ($ctr<=$wgt) { @@ -1421,7 +1444,6 @@ sub gradeBox { $ctr++; } $result.='
'; - $result.='
 or '."\n"; - $result.=''."\n"; $result.='
'."\n"; + $result.=&handbackBox($uname,$udom,$counter,$partid,$record,$respid); return $result; } +sub handbackBox { + my ($uname,$udom,$counter,$partid,$record,$respid) = @_; + my $files=&get_submitted_files($udom,$uname,$partid,$respid,$record); + my $result; + if (@$files) { + my $file_counter = 0; + foreach my $file (@$files) { + $result.=' Return commented document to student. '."\n"; + $result.=''; + $result.='
'; + } + } + return $result; +} sub show_problem { my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode) = @_; @@ -1792,31 +1829,14 @@ KEYWORDS $lastsubonly.='Part: '. $display_part.' ( ID '.$respid. ' )   '; - my @files; - if ($record{"resource.$partid.$respid.portfiles"}) { - my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio'; - foreach my $file (split(',',$record{"resource.$partid.$respid.portfiles"})) { - push(@files,$file_url.$file); - - &Apache::lonnet::logthis("found a portfolio file".$record{"resource.$partid.$respid.portfiles"}); - &Apache::lonnet::logthis("uploaded URL file".$record{"resource.$partid.$respid.uploadedurl"}); - } - } - if ($record{"resource.$partid.$respid.uploadedurl"}) { - push(@files,$record{"resource.$partid.$respid.uploadedurl"}); - } - if (@files) { + my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record); + if (@$files) { $lastsubonly.='
Like all files provided by users, this file may contain virusses
'; my $file_counter = 0; - foreach my $file (@files) { + foreach my $file (@$files) { $file_counter ++; &Apache::lonnet::allowuploaded('/adm/grades',$file); - $lastsubonly.='
'.$file.''; - $lastsubonly.=' Return commented document to student. '."\n"; - $lastsubonly.=''; - $lastsubonly.=''; - + $lastsubonly.='
'.$file.''; } $lastsubonly.='
'; } @@ -1894,15 +1914,18 @@ KEYWORDS my %seen = (); my @partlist; my @gradePartRespid; - for (sort keys(%$handgrade)) { - my ($partid,$respid) = split(/_/); - next if ($seen{$partid} > 0); + for my $part_resp(sort keys(%$handgrade)) { + my ($partid,$respid) = split(/_/, $part_resp); + #next if ($seen{$partid} > 0); + if ($seen{$partid} > 0) { + $request->print(&handbackBox($uname,$udom,$counter,$partid,\%record,$respid)); + next; + } $seen{$partid}++; - next if ($$handgrade{$_} =~ /:no$/ && $env{'form.lastSub'} =~ /^(hdgrade)$/); + next if ($$handgrade{$part_resp} =~ /:no$/ && $env{'form.lastSub'} =~ /^(hdgrade)$/); 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,\%record,$respid)); } $result=''."\n"; @@ -2351,7 +2374,20 @@ sub saveHandGrade { } return ('',$pts,$wgt); } - +sub get_submitted_files { + my ($udom,$uname,$partid,$respid,$record) = @_; + my @files; + if ($$record{"resource.$partid.$respid.portfiles"}) { + my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio'; + foreach my $file (split(',',$$record{"resource.$partid.$respid.portfiles"})) { + push(@files,$file_url.$file); + } + } + if ($$record{"resource.$partid.$respid.uploadedurl"}) { + push(@files,$$record{"resource.$partid.$respid.uploadedurl"}); + } + return (\@files); +} # ----------- Provides number of tries since last reset. sub get_num_tries { my ($record,$last_reset,$part) = @_; @@ -2857,7 +2893,7 @@ sub viewstudentgrade { $aggregates{$part} = 1; } if ($type eq 'awarded') { - my $pts = $score eq '' ? '' : $score*$$weight{$part}; + my $pts = $score eq '' ? '' : compute_points($score,$$weight{$part}); $result.=''."\n"; $result.='