--- loncom/homework/grades.pm 2003/04/21 18:39:43 1.86
+++ loncom/homework/grades.pm 2003/05/30 21:42:36 1.93
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.86 2003/04/21 18:39:43 ng Exp $
+# $Id: grades.pm,v 1.93 2003/05/30 21:42:36 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -46,6 +46,9 @@ use Apache::lonhomework;
use Apache::loncoursedata;
use Apache::lonmsg qw(:user_normal_msg);
use Apache::Constants qw(:common);
+use String::Similarity;
+
+my %oldessays=();
# ----- These first few routines are general use routines.----
#
@@ -221,6 +224,50 @@ sub jscriptNform {
}
#------------------ End of general use routines --------------------
+
+#
+# Find most similar essay
+#
+
+sub most_similar {
+ my ($uname,$udom,$uessay)=@_;
+
+# ignore spaces and punctuation
+
+ $uessay=~s/\W+/ /gs;
+
+# these will be returned. Do not care if not at least 50 percent similar
+ my $limit=0.6;
+ my $sname='';
+ my $sdom='';
+ my $scrsid='';
+ my $sessay='';
+# go through all essays ...
+ foreach my $tkey (keys %oldessays) {
+ my ($tname,$tdom,$tcrsid)=split(/\./,$tkey);
+# ... except the same student
+ if (($tname ne $uname) || ($tdom ne $udom)) {
+ my $tessay=$oldessays{$tkey};
+ $tessay=~s/\W+/ /gs;
+# String similarity gives up if not even limit
+ my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit);
+# Found one
+ if ($tsimilar>$limit) {
+ $limit=$tsimilar;
+ $sname=$tname;
+ $sdom=$tdom;
+ $scrsid=$tcrsid;
+ $sessay=$oldessays{$tkey};
+ }
+ }
+ }
+ if ($limit>0.6) {
+ return ($sname,$sdom,$scrsid,$sessay,$limit);
+ } else {
+ return ('','','','',0);
+ }
+}
+
#-------------------------------------------------------------------
#------------------------------------ Receipt Verification Routines
@@ -1075,6 +1122,9 @@ sub submission {
$request->print($prnmsg);
if ($ENV{'form.handgrade'} eq 'yes' && $ENV{'form.showgrading'} eq 'yes') {
+#
+# Print out the keyword options line
+#
$request->print(<<KEYWORDS);
<b>Keyword Options:</b>
<a href="javascript:keywords(document.SCORE.keywords)"; TARGET=_self>List</a>
@@ -1082,6 +1132,14 @@ sub submission {
CLASS="page">Paste Selection to List</a>
<a href="javascript:kwhighlight()"; TARGET=_self>Highlight Attribute</a><br /><br />
KEYWORDS
+#
+# Load the other essays for similarity check
+#
+ my $essayurl=&Apache::lonnet::declutter($url);
+ my ($adom,$aname,$apath)=($essayurl=~/^(\w+)\/(\w+)\/(.*)$/);
+ $apath=&Apache::lonnet::escape($apath);
+ $apath=~s/\W/\_/gs;
+ %oldessays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname);
}
}
@@ -1189,6 +1247,15 @@ KEYWORDS
my ($partid,$respid) = /^resource\.(\d+)\.(\d+)\.submission/;
if ($part eq ($partid.'_'.$respid)) {
my ($ressub,$subval) = split(/:/,$_,2);
+# Similarity check
+ my $similar='';
+ my ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval);
+ if ($osim) {
+ $osim=int($osim*100.0);
+ $similar='<hr /><h3><font color="#FF0000">Essay is '.$osim.'% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom).
+ '</font></h3><blockquote><i>'.
+ &keywords_highlight($oessay).'</i></blockquote><hr />';
+ }
$lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.
$partid.'</b> <font color="#999999">( ID '.$respid.
' )</font> '.
@@ -1196,8 +1263,8 @@ KEYWORDS
'<a href="'.
&Apache::lonnet::tokenwrapper($record{"resource.$partid.$respid.uploadedurl"}).
'"><img src="/adm/lonIcons/unknown.gif" border=0"> File uploaded by student</a> <font color="red" size="1">Like all files provided by users, this file may contain virusses</font><br />':'').
- '<b>Answer: </b>'.
- &keywords_highlight($subval).'</td></tr>'."\n"
+ '<b>Answer: </b><blockquote>'.
+ &keywords_highlight($subval).'</blockquote><br /> '.$similar.'</td></tr>'."\n"
if ($ENV{'form.lastSub'} eq 'lastonly' ||
($ENV{'form.lastSub'} eq 'hdgrade' &&
$$handgrade{$part} =~ /:yes$/));
@@ -1235,7 +1302,7 @@ KEYWORDS
my $lastone = pop @col_fullnames;
$msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.';
}
- $msgfor =~ s/\'/\\'/g; #\'
+ $msgfor =~ s/\'/\\'/g; #' stupid emacs
$result.='<tr><td bgcolor="#ffffff">'."\n".
' <a href="javascript:msgCenter(document.SCORE,'.$counter.
',\''.$msgfor.'\')"; TARGET=_self>'.
@@ -1846,7 +1913,8 @@ sub viewgrades {
my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'1');
my $ctr = 0;
foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
- my ($uname,$udom) = split(/:/);
+ my $uname = $_;
+ $uname=~s/:/_/;
$result.='<input type="hidden" name="ctr'.$ctr.'" value="'.$uname.'" />'."\n";
$result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},
$_,$$fullname{$_},\@parts,\%weight);
@@ -1864,6 +1932,7 @@ sub viewgrades {
sub viewstudentgrade {
my ($url,$symb,$courseid,$student,$fullname,$parts,$weight) = @_;
my ($uname,$udom) = split(/:/,$student);
+ $student=~s/:/_/;
my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname);
my $result='<tr bgcolor="#ffffdd"><td>'.
'<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom.
@@ -1875,19 +1944,19 @@ sub viewstudentgrade {
if ($type eq 'awarded') {
my $pts = $score eq '' ? '' : $score*$$weight{$part};
$result.='<input type="hidden" name="'.
- 'GD_'.$uname.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n";
+ 'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n";
$result.='<td align="middle"><input type="text" name="'.
- 'GD_'.$uname.'_'.$part.'_awarded" '.
- 'onChange="javascript:changeSelect(\''.$part.'\',\''.$uname.
+ 'GD_'.$student.'_'.$part.'_awarded" '.
+ 'onChange="javascript:changeSelect(\''.$part.'\',\''.$student.
'\')" value="'.$pts.'" size="4" /></td>'."\n";
} elsif ($type eq 'solved') {
my ($status,$foo)=split(/_/,$score,2);
$status = 'nothing' if ($status eq '');
- $result.='<input type="hidden" name="'.'GD_'.$uname.'_'.
+ $result.='<input type="hidden" name="'.'GD_'.$student.'_'.
$part.'_solved_s" value="'.$status.'" />'."\n";
$result.='<td align="middle"><select name="'.
- 'GD_'.$uname.'_'.$part.'_solved" '.
- 'onChange="javascript:changeOneScore(\''.$part.'\',\''.$uname.'\')" >'."\n";
+ 'GD_'.$student.'_'.$part.'_solved" '.
+ 'onChange="javascript:changeOneScore(\''.$part.'\',\''.$student.'\')" >'."\n";
my $optsel = '<option selected="on"> </option><option>excused</option>'."\n";
$optsel = '<option> </option><option selected="on">excused</option>'."\n"
if ($status eq 'excused');
@@ -1895,10 +1964,10 @@ sub viewstudentgrade {
$result.="</select></td>\n";
} else {
$result.='<input type="hidden" name="'.
- 'GD_'.$uname.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'.
+ 'GD_'.$student.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'.
"\n";
$result.='<td align="middle"><input type="text" name="'.
- 'GD_'.$uname.'_'.$part.'_'.$type.'" '.
+ 'GD_'.$student.'_'.$part.'_'.$type.'" '.
'value="'.$score.'" size="4" /></td>'."\n";
}
}
@@ -1918,7 +1987,7 @@ sub editgrades {
$title.='<font size=+1><b>Section: </b>'.$ENV{'form.section'}.'</font>'."\n";
my $result= '<table border="0"><tr><td bgcolor="#777777">'."\n";
$result.= '<table border="0"><tr bgcolor="#deffff">'.
- '<td rowspan=2><b>Username</b></td><td rowspan=2><b>Fullname</b></td>'."\n";
+ '<td rowspan=2><b>Username</b></td><td rowspan=2><b>Domain</b></td><td rowspan=2><b>Fullname</b></td>'."\n";
my %scoreptr = (
'correct' =>'correct_by_override',
@@ -1966,16 +2035,19 @@ sub editgrades {
$result .= '</tr><tr bgcolor="#deffff">';
$result .= $header;
$result .= '</tr>'."\n";
-
+ my $noupdate;
for ($i=0; $i<$ENV{'form.total'}; $i++) {
+ my $line;
my $user = $ENV{'form.ctr'.$i};
+ my $usercolon = $user;
+ $usercolon =~s/_/:/;
+ my ($uname,$udom)=split(/_/,$user);
my %newrecord;
my $updateflag = 0;
- my @userdom = grep /^$user:/,keys %$classlist;
- my (undef,$udom) = split(/:/,$userdom[0]);
- $result .= '<tr bgcolor="#ffffde"><td>'.$user.' </td><td>'.
- $$fullname{$userdom[0]}.' </td>';
+ $line .= '<tr bgcolor="#ffffde"><td>'.$uname.' </td><td>'.
+ $udom.' </td><td>'.
+ $$fullname{$usercolon}.' </td>';
foreach (@partid) {
my $old_aw = $ENV{'form.GD_'.$user.'_'.$_.'_awarded_s'};
my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);
@@ -1995,7 +2067,7 @@ sub editgrades {
}
$score = 'excused' if (($ENV{'form.GD_'.$user.'_'.$_.'_solved'} eq 'excused') &&
($score ne 'excused'));
- $result .= '<td align="center">'.$old_aw.' </td>'.
+ $line .= '<td align="center">'.$old_aw.' </td>'.
'<td align="center">'.$awarded.
($score eq 'excused' ? $score : '').' </td>';
@@ -2018,17 +2090,23 @@ sub editgrades {
$newrecord{'resource.'.$part.'regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}";
$updateflag=1;
}
- $result .= '<td align="center">'.$old_aw.' </td>'.
+ $line .= '<td align="center">'.$old_aw.' </td>'.
'<td align="center">'.$awarded.' </td>';
}
}
- $result .= '</tr>'."\n";
+ $line.='</tr>'."\n";
if ($updateflag) {
$count++;
&Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'},
- $udom,$user);
+ $udom,$uname);
+ $result.=$line;
+ } else {
+ $noupdate.=$line;
}
}
+ if ($noupdate) {
+ $result .= '<tr bgcolor="#ffffff"><td align="center" colspan="7">No Changes Occured For the Students Below</td></tr>'.$noupdate;
+ }
$result .= '</table></td></tr></table>'."\n".
&show_grading_menu_form ($symb,$url);
my $msg = '<b>Number of records updated = '.$rec_update.
@@ -2591,7 +2669,6 @@ sub displayPage {
if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) {
my $parts = $curRes->parts();
- $parts = &temp_parts_fix($parts); # remove line when lonnavmap is fixed
my $title = $curRes->compTitle();
my $symbx = $curRes->symb();
$studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$question.
@@ -2684,18 +2761,6 @@ sub displayPage {
return '';
}
-sub temp_parts_fix { #remove sub once lonnavmap is fixed
- my $parts = shift;
- my %seen = ();
- my @correctParts = ();
- foreach (@{$parts}) {
- next if ($seen{$_} > 0);
- $seen{$_}++;
- push @correctParts,$_;
- }
- return \@correctParts;
-}
-
sub updateGradeByPage {
my ($request) = shift;
@@ -2736,7 +2801,6 @@ sub updateGradeByPage {
if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) {
my $parts = $curRes->parts();
- $parts = &temp_parts_fix($parts); # remove line when lonnavmap is fixed
my $title = $curRes->compTitle();
my $symbx = $curRes->symb();
$studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$question.