--- loncom/homework/grades.pm 2003/04/21 18:39:43 1.86 +++ loncom/homework/grades.pm 2003/06/18 18:59:20 1.101 @@ -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.101 2003/06/18 18:59:20 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 @@ -419,8 +466,13 @@ LISTJAVASCRIPT 'onClick="javascript:checkSelect(this.form.stuinfo);" '. 'value="'.$viewgrade.'" /></form>'."\n"; if ($ctr == 0) { - $gradeTable='<br /> <font color="red">'. - 'No submission found for this resource.</font><br />'; + my $num_students=(scalar(keys(%$fullname))); + if ($num_students eq 0) { + $gradeTable='<br /> <font color="red">There are no students currently enrolled.</font>'; + } else { + $gradeTable='<br /> <font color="red">'. + 'No submissions found for this resource for any students. ('.$num_students.' checked for submissions</font><br />'; + } } elsif ($ctr == 1) { $gradeTable =~ s/type=checkbox/type=checkbox checked/; } @@ -1075,6 +1127,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 +1137,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 +1252,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 +1268,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 +1307,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 +1918,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); @@ -1856,6 +1929,10 @@ sub viewgrades { $result.='<input type="hidden" name="total" value="'.$ctr.'" />'."\n"; $result.='<input type="button" value="Submit Changes" '. 'onClick="javascript:submit();" TARGET=_self /></form>'."\n"; + if (scalar(%$fullname) eq 0) { + my $colspan=3+scalar(@parts); + $result='<font color="red">There are no students in section "'.$ENV{'form.section'}.'" with enrollment status "'.$ENV{'form.status'}.'" to modify or grade.</font>'; + } $result.=&show_grading_menu_form($symb,$url); return $result; } @@ -1864,6 +1941,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 +1953,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 +1973,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 +1996,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 +2044,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 +2076,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 +2099,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. @@ -2308,7 +2395,7 @@ sub csvuploadassign { } $request->print('<h3>Assigning Grades</h3>'); my $courseid=$ENV{'request.course.id'}; - my ($classlist) = &getclasslist('all','1'); + my ($classlist) = &getclasslist('all',0); my @skipped; my $countdone=0; foreach my $grade (@gradedata) { @@ -2340,7 +2427,6 @@ sub csvuploadassign { $request->print('<br /><font size="+1"><b>Skipped Students</b></font><br />'); foreach my $student (@skipped) { $request->print("<br />$student"); } } - $request->print(&view_edit_entire_class_form($symb,$url)); $request->print(&show_grading_menu_form($symb,$url)); return ''; } @@ -2511,15 +2597,14 @@ sub getSymbMap { my $countProblems = 0; $mapiterator->next(); # skip the first BEGIN_MAP my $mapcurRes = $mapiterator->next(); # for "current resource" - my $ctr=0; - while ($mapdepth > 0 && $ctr < 100) { + while ($mapdepth > 0) { if($mapcurRes == $mapiterator->BEGIN_MAP) { $mapdepth++; } - if($mapcurRes == $mapiterator->END_MAP) { $mapdepth++; } + if($mapcurRes == $mapiterator->END_MAP) { $mapdepth--; } if (ref($mapcurRes) && $mapcurRes->is_problem() && !$mapcurRes->randomout) { $countProblems++; } - $ctr++; + $mapcurRes = $mapiterator->next(); } if ($countProblems > 0) { my $title = $curRes->compTitle(); @@ -2582,16 +2667,15 @@ sub displayPage { '<td align="center"><b> No </b></td>'. '<td><b> '.($ENV{'form.vProb'} eq 'no' ? 'Title' : 'Problem View').'/Grade</b></td></tr>'; - my ($depth,$ctr,$question) = (1,0,1); + my ($depth,$question) = (1,1); $iterator->next(); # skip the first BEGIN_MAP my $curRes = $iterator->next(); # for "current resource" - while ($depth > 0 && $ctr < 100) { # ctr, just in case it never gets out of loop + while ($depth > 0) { if($curRes == $iterator->BEGIN_MAP) { $depth++; } - if($curRes == $iterator->END_MAP) { $depth++; } + 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 $title = $curRes->compTitle(); my $symbx = $curRes->symb(); $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$question. @@ -2671,9 +2755,10 @@ sub displayPage { } $curRes = $iterator->next(); - $ctr++; } + $navmap->untieHashes(); + $studentTable.='</td></tr></table></td></tr></table>'."\n". ' <input type="button" value="Save" '. 'onClick="javascript:checkSubmitPage(this.form,'.$question.');" TARGET=_self />'. @@ -2684,18 +2769,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; @@ -2729,14 +2802,13 @@ sub updateGradeByPage { $iterator->next(); # skip the first BEGIN_MAP my $curRes = $iterator->next(); # for "current resource" - my ($depth,$ctr,$question,$changeflag)= (1,0,1,0); - while ($depth > 0 && $ctr < 100) { # ctr, just in case it never gets out of loop + my ($depth,$question,$changeflag)= (1,1,0); + while ($depth > 0) { if($curRes == $iterator->BEGIN_MAP) { $depth++; } - if($curRes == $iterator->END_MAP) { $depth++; } + 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 $title = $curRes->compTitle(); my $symbx = $curRes->symb(); $studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$question. @@ -2793,9 +2865,10 @@ sub updateGradeByPage { } $curRes = $iterator->next(); - $ctr++; } + $navmap->untieHashes(); + $studentTable.='</td></tr></table></td></tr></table>'; $studentTable.=&show_grading_menu_form($ENV{'form.symb'},$ENV{'form.url'}); my $grademsg=($changeflag == 0 ? 'No score was changed or updated.' : @@ -3352,15 +3425,14 @@ sub handler { if ($tsymb) { my ($map,$id,$url)=split(/\_\_\_/,$tsymb); if (&Apache::lonnet::allowed('mgr',$tcrsid)) { - $request->print( - &Apache::lonnet::ssi('/res/'.$url, - ('grade_username' => $tuname, - 'grade_domain' => $tudom, - 'grade_courseid' => $tcrsid, - 'grade_symb' => $tsymb))); + $request->print(&Apache::lonnet::ssi_body('/res/'.$url, + ('grade_username' => $tuname, + 'grade_domain' => $tudom, + 'grade_courseid' => $tcrsid, + 'grade_symb' => $tsymb))); } else { $request->print('<h3>Not authorized: '.$token.'</h3>'); - } + } } else { $request->print('<h3>Not a valid DocID: '.$token.'</h3>'); }