--- loncom/homework/grades.pm 2003/04/21 18:39:43 1.86 +++ loncom/homework/grades.pm 2003/05/30 20:57:40 1.90 @@ -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.90 2003/05/30 20:57:40 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(<Keyword Options:  List    @@ -1082,6 +1132,14 @@ sub submission { CLASS="page">Paste Selection to List    Highlight Attribute

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='

Essay is '.$osim.'% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom). + '

'. + &keywords_highlight($oessay).'
'; + } $lastsubonly.='Part '. $partid.' ( ID '.$respid. ' )   '. @@ -1196,8 +1263,8 @@ KEYWORDS ' File uploaded by student Like all files provided by users, this file may contain virusses
':''). - 'Answer: '. - &keywords_highlight($subval).''."\n" + 'Answer:
'. + &keywords_highlight($subval).'

 '.$similar.''."\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.=''."\n". ' '. @@ -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.=''."\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=''. ''."\n"; + 'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n"; $result.=''."\n"; } elsif ($type eq 'solved') { my ($status,$foo)=split(/_/,$score,2); $status = 'nothing' if ($status eq ''); - $result.=''."\n"; $result.='\n"; } else { $result.=''. + 'GD_'.$student.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'. "\n"; $result.=''."\n"; } } @@ -1918,7 +1987,7 @@ sub editgrades { $title.='Section: '.$ENV{'form.section'}.''."\n"; my $result= '
'."\n"; $result.= ''. - ''."\n"; + ''."\n"; my %scoreptr = ( 'correct' =>'correct_by_override', @@ -1969,13 +2038,13 @@ sub editgrades { for ($i=0; $i<$ENV{'form.total'}; $i++) { my $user = $ENV{'form.ctr'.$i}; + my ($uname,$udom)=split(/:/,$user); my %newrecord; my $updateflag = 0; - my @userdom = grep /^$user:/,keys %$classlist; - my (undef,$udom) = split(/:/,$userdom[0]); - $result .= ''; + $result .= ''; foreach (@partid) { my $old_aw = $ENV{'form.GD_'.$user.'_'.$_.'_awarded_s'}; my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1); @@ -2026,7 +2095,7 @@ sub editgrades { if ($updateflag) { $count++; &Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'}, - $udom,$user); + $udom,$uname); } } $result .= '
UsernameFullnameUsernameDomainFullname
'.$user.' '. - $$fullname{$userdom[0]}.' 
'.$uname.' '. + $udom.' '. + $$fullname{$user}.' 
'."\n". @@ -2590,8 +2659,8 @@ sub displayPage { if($curRes == $iterator->END_MAP) { $depth++; } if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { - my $parts = $curRes->parts(); - $parts = &temp_parts_fix($parts); # remove line when lonnavmap is fixed + my $parts = ['0',@{$curRes->parts()}]; + &APache::lonnet::logthis("parts ".join(':',@$parts)); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); $studentTable.=''.$question. @@ -2684,18 +2753,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; @@ -2735,8 +2792,8 @@ sub updateGradeByPage { if($curRes == $iterator->END_MAP) { $depth++; } if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { - my $parts = $curRes->parts(); - $parts = &temp_parts_fix($parts); # remove line when lonnavmap is fixed + my $parts = ['0',@{$curRes->parts()}]; + &APache::lonnet::logthis("parts ".join(':',@$parts)); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); $studentTable.=''.$question.