[BACK]Return to grades.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/grades.pm between versions 1.86 and 1.89

version 1.86, 2003/04/21 18:39:43 version 1.89, 2003/05/16 19:00:23
Line 46  use Apache::lonhomework; Line 46  use Apache::lonhomework;
 use Apache::loncoursedata;  use Apache::loncoursedata;
 use Apache::lonmsg qw(:user_normal_msg);  use Apache::lonmsg qw(:user_normal_msg);
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
   use String::Similarity;
   
   my %oldessays=();
   
 # ----- These first few routines are general use routines.----  # ----- These first few routines are general use routines.----
 #  #
Line 221  sub jscriptNform { Line 224  sub jscriptNform {
 }  }
   
 #------------------ End of general use routines --------------------  #------------------ 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  #------------------------------------ Receipt Verification Routines
Line 1075  sub submission { Line 1122  sub submission {
  $request->print($prnmsg);   $request->print($prnmsg);
   
  if ($ENV{'form.handgrade'} eq 'yes' && $ENV{'form.showgrading'} eq 'yes') {   if ($ENV{'form.handgrade'} eq 'yes' && $ENV{'form.showgrading'} eq 'yes') {
   #
   # Print out the keyword options line
   #
     $request->print(<<KEYWORDS);      $request->print(<<KEYWORDS);
 &nbsp;<b>Keyword Options:</b>&nbsp;  &nbsp;<b>Keyword Options:</b>&nbsp;
 <a href="javascript:keywords(document.SCORE.keywords)"; TARGET=_self>List</a>&nbsp; &nbsp;  <a href="javascript:keywords(document.SCORE.keywords)"; TARGET=_self>List</a>&nbsp; &nbsp;
Line 1082  sub submission { Line 1132  sub submission {
  CLASS="page">Paste Selection to List</a>&nbsp; &nbsp;   CLASS="page">Paste Selection to List</a>&nbsp; &nbsp;
 <a href="javascript:kwhighlight()"; TARGET=_self>Highlight Attribute</a><br /><br />  <a href="javascript:kwhighlight()"; TARGET=_self>Highlight Attribute</a><br /><br />
 KEYWORDS  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);
         }          }
     }      }
   
Line 1189  KEYWORDS Line 1247  KEYWORDS
  my ($partid,$respid) = /^resource\.(\d+)\.(\d+)\.submission/;   my ($partid,$respid) = /^resource\.(\d+)\.(\d+)\.submission/;
  if ($part eq ($partid.'_'.$respid)) {   if ($part eq ($partid.'_'.$respid)) {
     my ($ressub,$subval) = split(/:/,$_,2);      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 '.      $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.
  $partid.'</b> <font color="#999999">( ID '.$respid.   $partid.'</b> <font color="#999999">( ID '.$respid.
  ' )</font>&nbsp; &nbsp;'.   ' )</font>&nbsp; &nbsp;'.
Line 1196  KEYWORDS Line 1263  KEYWORDS
                                 '<a href="'.                                  '<a href="'.
                                 &Apache::lonnet::tokenwrapper($record{"resource.$partid.$respid.uploadedurl"}).                                  &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 />':'').     '"><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>'.                                  '<b>Answer: </b><blockquote>'.
  &keywords_highlight($subval).'</td></tr>'."\n"   &keywords_highlight($subval).'</blockquote><br />&nbsp;'.$similar.'</td></tr>'."\n"
  if ($ENV{'form.lastSub'} eq 'lastonly' ||    if ($ENV{'form.lastSub'} eq 'lastonly' || 
     ($ENV{'form.lastSub'} eq 'hdgrade' &&       ($ENV{'form.lastSub'} eq 'hdgrade' && 
      $$handgrade{$part} =~ /:yes$/));       $$handgrade{$part} =~ /:yes$/));
Line 1235  KEYWORDS Line 1302  KEYWORDS
  my $lastone = pop @col_fullnames;   my $lastone = pop @col_fullnames;
  $msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.';   $msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.';
     }      }
     $msgfor =~ s/\'/\\'/g; #\'      $msgfor =~ s/\'/\\'/g; #' stupid emacs
     $result.='<tr><td bgcolor="#ffffff">'."\n".      $result.='<tr><td bgcolor="#ffffff">'."\n".
  '&nbsp;<a href="javascript:msgCenter(document.SCORE,'.$counter.   '&nbsp;<a href="javascript:msgCenter(document.SCORE,'.$counter.
  ',\''.$msgfor.'\')"; TARGET=_self>'.   ',\''.$msgfor.'\')"; TARGET=_self>'.
Line 1847  sub viewgrades { Line 1914  sub viewgrades {
     my $ctr = 0;      my $ctr = 0;
     foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {      foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
  my ($uname,$udom) = split(/:/);   my ($uname,$udom) = split(/:/);
  $result.='<input type="hidden" name="ctr'.$ctr.'" value="'.$uname.'" />'."\n";   $result.='<input type="hidden" name="ctr'.$ctr.'" value="'.$_.'" />'."\n";
  $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},   $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},
    $_,$$fullname{$_},\@parts,\%weight);     $_,$$fullname{$_},\@parts,\%weight);
  $ctr++;   $ctr++;
Line 1875  sub viewstudentgrade { Line 1942  sub viewstudentgrade {
  if ($type eq 'awarded') {   if ($type eq 'awarded') {
     my $pts = $score eq '' ? '' : $score*$$weight{$part};      my $pts = $score eq '' ? '' : $score*$$weight{$part};
     $result.='<input type="hidden" name="'.      $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="'.      $result.='<td align="middle"><input type="text" name="'.
  'GD_'.$uname.'_'.$part.'_awarded" '.   'GD_'.$student.'_'.$part.'_awarded" '.
  'onChange="javascript:changeSelect(\''.$part.'\',\''.$uname.   'onChange="javascript:changeSelect(\''.$part.'\',\''.$student.
  '\')" value="'.$pts.'" size="4" /></td>'."\n";   '\')" value="'.$pts.'" size="4" /></td>'."\n";
  } elsif ($type eq 'solved') {   } elsif ($type eq 'solved') {
     my ($status,$foo)=split(/_/,$score,2);      my ($status,$foo)=split(/_/,$score,2);
     $status = 'nothing' if ($status eq '');      $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";   $part.'_solved_s" value="'.$status.'" />'."\n";
     $result.='<td align="middle"><select name="'.      $result.='<td align="middle"><select name="'.
  'GD_'.$uname.'_'.$part.'_solved" '.   'GD_'.$student.'_'.$part.'_solved" '.
  'onChange="javascript:changeOneScore(\''.$part.'\',\''.$uname.'\')" >'."\n";   'onChange="javascript:changeOneScore(\''.$part.'\',\''.$student.'\')" >'."\n";
     my $optsel = '<option selected="on"> </option><option>excused</option>'."\n";      my $optsel = '<option selected="on"> </option><option>excused</option>'."\n";
     $optsel = '<option> </option><option selected="on">excused</option>'."\n"      $optsel = '<option> </option><option selected="on">excused</option>'."\n"
  if ($status eq 'excused');   if ($status eq 'excused');
Line 1895  sub viewstudentgrade { Line 1962  sub viewstudentgrade {
     $result.="</select></td>\n";      $result.="</select></td>\n";
  } else {   } else {
     $result.='<input type="hidden" name="'.      $result.='<input type="hidden" name="'.
  'GD_'.$uname.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'.   'GD_'.$student.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'.
     "\n";      "\n";
     $result.='<td align="middle"><input type="text" name="'.      $result.='<td align="middle"><input type="text" name="'.
  'GD_'.$uname.'_'.$part.'_'.$type.'" '.   'GD_'.$student.'_'.$part.'_'.$type.'" '.
  'value="'.$score.'" size="4" /></td>'."\n";   'value="'.$score.'" size="4" /></td>'."\n";
  }   }
     }      }
Line 1918  sub editgrades { Line 1985  sub editgrades {
     $title.='<font size=+1><b>Section: </b>'.$ENV{'form.section'}.'</font>'."\n";      $title.='<font size=+1><b>Section: </b>'.$ENV{'form.section'}.'</font>'."\n";
     my $result= '<table border="0"><tr><td bgcolor="#777777">'."\n";      my $result= '<table border="0"><tr><td bgcolor="#777777">'."\n";
     $result.= '<table border="0"><tr bgcolor="#deffff">'.      $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 = (      my %scoreptr = (
     'correct'  =>'correct_by_override',      'correct'  =>'correct_by_override',
Line 1969  sub editgrades { Line 2036  sub editgrades {
   
     for ($i=0; $i<$ENV{'form.total'}; $i++) {      for ($i=0; $i<$ENV{'form.total'}; $i++) {
  my $user = $ENV{'form.ctr'.$i};   my $user = $ENV{'form.ctr'.$i};
    my ($uname,$udom)=split(/:/,$user);
  my %newrecord;   my %newrecord;
  my $updateflag = 0;   my $updateflag = 0;
  my @userdom = grep /^$user:/,keys %$classlist;  
  my (undef,$udom) = split(/:/,$userdom[0]);  
   
  $result .= '<tr bgcolor="#ffffde"><td>'.$user.'&nbsp;</td><td>'.   $result .= '<tr bgcolor="#ffffde"><td>'.$uname.'&nbsp;</td><td>'.
     $$fullname{$userdom[0]}.'&nbsp;</td>';      $udom.'&nbsp;</td><td>'.
    $$fullname{$user}.'&nbsp;</td>';
  foreach (@partid) {   foreach (@partid) {
     my $old_aw    = $ENV{'form.GD_'.$user.'_'.$_.'_awarded_s'};      my $old_aw    = $ENV{'form.GD_'.$user.'_'.$_.'_awarded_s'};
     my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);      my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);
Line 2026  sub editgrades { Line 2093  sub editgrades {
  if ($updateflag) {   if ($updateflag) {
     $count++;      $count++;
     &Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'},      &Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'},
     $udom,$user);      $udom,$uname);
  }   }
     }      }
     $result .= '</table></td></tr></table>'."\n".      $result .= '</table></td></tr></table>'."\n".
Removed from v.1.86  
changed lines
  Added in v.1.89

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>