--- loncom/homework/grades.pm 2003/03/28 23:44:31 1.81
+++ loncom/homework/grades.pm 2003/06/18 17:37:10 1.99
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.81 2003/03/28 23:44:31 albertel Exp $
+# $Id: grades.pm,v 1.99 2003/06/18 17:37:10 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.'" />'."\n";
if ($ctr == 0) {
- $gradeTable=' '.
- 'No submission found for this resource. ';
+ my $num_students=(scalar(keys(%$fullname)));
+ if ($num_students eq 0) {
+ $gradeTable=' There are no students currently enrolled.';
+ } else {
+ $gradeTable=' '.
+ 'No submissions found for this resource for any students. ('.$num_students.' checked for submissions ';
+ }
} elsif ($ctr == 1) {
$gradeTable =~ s/type=checkbox/type=checkbox checked/;
}
@@ -717,7 +769,7 @@ sub sub_page_kw_js {
height = 600;
scrollbar = "yes";
}
-// if (window.pWin) window.pWin.close();
+// if (window.pWin) {window.pWin.close(); window.pWin=null}
pWin = window.open('', 'MessageCenter', 'toolbar=no,location=no,scrollbars='+scrollbar+',screenx=70,screeny=75,width=600,height='+height);
pWin.focus();
pDoc = pWin.document;
@@ -752,11 +804,7 @@ sub sub_page_kw_js {
pDoc.write(" includemsg = 1;");
pDoc.write(" }");
pDoc.write(" imgformname = eval(\\"opener.document.SCORE.mailicon\\"+usrctr);");
- pDoc.write(" if (includemsg) {");
- pDoc.write(" imgformname.src = \\"$iconpath/mailto.gif\\";");
- pDoc.write(" } else {");
- pDoc.write(" imgformname.src = \\"$iconpath/mailbkgrd.gif\\";");
- pDoc.write(" }");
+ pDoc.write(" imgformname.src = \\"$iconpath/\\"+((includemsg) ? \\"mailto.gif\\" : \\"mailbkgrd.gif\\");");
pDoc.write(" var includemsg = eval(\\"opener.document.SCORE.includemsg\\"+usrctr);");
pDoc.write(" includemsg.value = msgchk;");
@@ -1079,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(<Keyword Options:
List
@@ -1086,6 +1137,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);
}
}
@@ -1112,7 +1171,6 @@ KEYWORDS
my @col_fullnames;
my ($classlist,$fullname);
if ($ENV{'form.handgrade'} eq 'yes') {
- my @col_list;
($classlist,undef,$fullname) = &getclasslist('all','0');
for (keys (%$handgrade)) {
my $ncol = &Apache::lonnet::EXT('resource.'.$_.
@@ -1121,56 +1179,46 @@ KEYWORDS
next if ($ncol <= 0);
s/\_/\./g;
next if ($record{'resource.'.$_.'.collaborators'} eq '');
- my (@colList) = split(/,?\s+/,
- $record{'resource.'.$_.'.collaborators'});
- my @collaborators = ();
- foreach (@colList) { #pre-filter list - throw out submitter
+ my @goodcollaborators = ();
+ my @badcollaborators = ();
+ foreach (split(/,?\s+/,$record{'resource.'.$_.'.collaborators'})) {
+ $_ =~ s/[\$\^\(\)]//g;
+ next if ($_ eq '');
my ($co_name,$co_dom) = split /\@|:/,$_;
- $co_dom = $udom if (! defined($co_dom));
+ $co_dom = $udom if (! defined($co_dom) || $co_dom =~ /^domain$/i);
next if ($co_name eq $uname && $co_dom eq $udom);
- push @collaborators, $_;
+ # Doing this grep allows 'fuzzy' specification
+ my @Matches = grep /^$co_name:$co_dom$/i,keys %$classlist;
+ if (! scalar(@Matches)) {
+ push @badcollaborators,$_;
+ } else {
+ push @goodcollaborators, @Matches;
+ }
}
- my (@badcollaborators);
- if (scalar(@collaborators) != 0) {
+ if (scalar(@goodcollaborators) != 0) {
$result.='Collaborators: ';
- foreach my $collaborator (@collaborators) {
- my ($co_name,$co_dom) = split /\@|:/,$collaborator;
- $co_dom = $udom if (! defined($co_dom));
- # Doing this grep allows 'fuzzy' specification
- my @Matches = grep /^$co_name:$co_dom$/i,
- keys %$classlist;
- if (! scalar(@Matches)) {
- push @badcollaborators,':'.$collaborator.':';
- next;
- }
- push @col_list, @Matches;
- foreach (@Matches) {
- my ($lastname,$givenn) = split(/,/,$$fullname{$_});
- push @col_fullnames, $givenn.' '.$lastname;
- $result.=$$fullname{$_}.' ';
- }
- }
+ foreach (@goodcollaborators) {
+ my ($lastname,$givenn) = split(/,/,$$fullname{$_});
+ push @col_fullnames, $givenn.' '.$lastname;
+ $result.=$$fullname{$_}.' ';
+ }
$result.=' '."\n";
- if (scalar(@badcollaborators) > 0) {
- $result.='
';
+ $result .= 'This student has submitted too many '.
+ 'collaborators. Maximum is '.$ncol.'.';
+ $result .= '
';
+ }
}
}
$request->print($result."\n");
@@ -1204,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='
Essay is '.$osim.'% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom).
+ '
'.
+ &keywords_highlight($oessay).'
';
+ }
$lastsubonly.='
Part '.
$partid.' ( ID '.$respid.
' ) '.
@@ -1211,8 +1268,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$/));
@@ -1250,6 +1307,7 @@ KEYWORDS
my $lastone = pop @col_fullnames;
$msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.';
}
+ $msgfor =~ s/\'/\\'/g; #' stupid emacs
$result.='
'."\n";
}
}
@@ -1925,7 +1996,7 @@ sub editgrades {
$title.='Section: '.$ENV{'form.section'}.''."\n";
my $result= '
'."\n";
$result.= '
'.
- '
Username
Fullname
'."\n";
+ '
Username
Domain
Fullname
'."\n";
my %scoreptr = (
'correct' =>'correct_by_override',
@@ -1973,16 +2044,19 @@ sub editgrades {
$result .= '
';
$result .= $header;
$result .= '
'."\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 .= '
'.$user.'
'.
- $$fullname{$userdom[0]}.'
';
+ $line .= '
'.$uname.'
'.
+ $udom.'
'.
+ $$fullname{$usercolon}.'
';
foreach (@partid) {
my $old_aw = $ENV{'form.GD_'.$user.'_'.$_.'_awarded_s'};
my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);
@@ -2002,7 +2076,7 @@ sub editgrades {
}
$score = 'excused' if (($ENV{'form.GD_'.$user.'_'.$_.'_solved'} eq 'excused') &&
($score ne 'excused'));
- $result .= '
'."\n".
&show_grading_menu_form ($symb,$url);
my $msg = 'Number of records updated = '.$rec_update.
@@ -2214,6 +2294,48 @@ sub csvuploadmap_footer {
ENDPICK
}
+sub upcsvScores_form {
+ my ($request) = shift;
+ my ($symb,$url)=&get_symb_and_url($request);
+ if (!$symb) {return '';}
+ my $result =<
+ function checkUpload(formname) {
+ if (formname.upfile.value == "") {
+ alert("Please use the browse button to select a file from your local directory.");
+ return false;
+ }
+ formname.submit();
+ }
+
+CSVFORMJS
+ $ENV{'form.probTitle'} = &Apache::lonnet::gettitle($symb);
+ $result.='
'."\n";
+ $result.='
'."\n";
+ $result.=' Specify a file containing the class scores for problem - '.$ENV{'form.probTitle'}.
+ '.
';
$studentTable.=&show_grading_menu_form($ENV{'form.symb'},$ENV{'form.url'});
my $grademsg=($changeflag == 0 ? 'No score was changed or updated.' :
@@ -2819,6 +2930,19 @@ sub scantron_uploads {
return $result;
}
+sub scantron_scantab {
+ my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
+ my $result=''."\n";
+
+ return $result;
+}
+
sub scantron_selectphase {
my ($r) = @_;
my ($symb,$url)=&get_symb_and_url($r);
@@ -2827,10 +2951,11 @@ sub scantron_selectphase {
my $default_form_data=&defaultFormData($symb,$url);
my $grading_menu_button=&show_grading_menu_form($symb,$url);
my $file_selector=&scantron_uploads();
+ my $format_selector=&scantron_scantab();
my $result;
$result.= <
-
+
-$grading_menu_button
SCANTRONFORM
- #FIXME Needs to present some lines from the file and allow the instructor to specify which columns represent what data, possibly have some nice defaults setup, probably should do a pass through all problems for a student to get an idea of how many questions there are, and homw many lines we'll have,
- return $result;
-}
+ $r->print($result);
-sub scantron_process_students {
+ my @delayqueue;
+ my $totalcorrect;
+ my $totalincorrect;
+
+ my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,
+ 'Scantron Status','Scantron Progress',scalar(@scanlines));
+ foreach my $line (@scanlines) {
+ my $studentcorrect;
+ my $studentincorrect;
+
+ chomp($line);
+ my $scan_record=&scantron_parse_scanline($line,\%scantron_config);
+ my ($uname,$udom);
+ if ($uname=&scantron_find_student($scan_record,\%idmap)) {
+ &scantron_add_delay(\@delayqueue,$line,
+ 'Unable to find a student that matches');
+ }
+ $r->print('
result is'.$result);
+ &Apache::lonhomework::showhash(%score);
+ # if ($i eq 3) {last;}
+ }
+ &Apache::lonnet::delenv('form.counter');
+ &Apache::lonnet::delenv('scantron\.');
+ &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
+ 'last student Who got a '.$studentcorrect.' correct and '.
+ $studentincorrect.' incorrect. The class has gotten '.
+ $totalcorrect.' correct and '.$totalincorrect.' incorrect');
+ last;
+ #FIXME
+ #get iterator for $sequence
+ #foreach question 'submit' the students answer to the server
+ # through grade target {
+ # generate data to pass back that includes grade recevied
+ #}
+ }
+ $Apache::lonxml::debug=0;
+ foreach my $delay (@delayqueue) {
+ #FIXME
+ #print out each delayed student with interface to select how
+ # to repair student provided info
+ #Expected errors include
+ # 1 bad/no stuid/username
+ # 2 invalid bubblings
+
+ }
#FIXME
- # loop through students, {
- # Check if studnet info valid, if not add line to delay queue
- # foreach question 'submit' the students answer to the server
- # through grade target {
- # generate data to pass back that includes grade recevied
- # }
- # }
- # loop through delay queue {
- # print out each delayed student with interface to select how
- # to repair student provided info
- # Expected errors include
- # 1 bad/no stuid/username
- # 2 invalid bubblings
- # }
# if delay queue exists 2 submits one to process delayed students one
# to ignore delayed students, possibly saving the delay queue for later
-
+
+ $navmap->untieHashes();
}
#-------- end of section for handling grading scantron forms -------
#
@@ -2972,10 +3238,7 @@ sub gradingmenu {
var cmd = formname.command;
formname.saveState.value = "saveCmd="+radioSelection(cmd)+":saveSec="+pullDownSelection(formname.section)+
":saveSub="+radioSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.status);
- if (cmd[0].checked || cmd[1].checked || cmd[2].checked || cmd[4].checked) formname.submit();
-
- if (cmd[3].checked) browseAndUpload();
-
+ if (cmd[0].checked || cmd[1].checked || cmd[2].checked || cmd[3].checked || cmd[4].checked) formname.submit();
if (cmd[5].checked) {
if (!checkReceiptNo(formname,'notOK')) { return false;}
formname.submit();
@@ -3024,57 +3287,6 @@ sub gradingmenu {
}
}
- function browseAndUpload() {
- bNLoad = window.open('', 'BrowseAndUpload', 'toolbar=no,location=no,scrollbars=no,width=550,height=200,screenx=100,screeny=75');
- bNLoad.focus();
- var lDoc = bNLoad.document;
- lDoc.write("");
- lDoc.write("Browse And Upload");
-
- lDoc.write("
GRADINGMENUJS
@@ -3136,8 +3348,8 @@ GRADINGMENUJS
($saveSub eq 'all' ? 'checked' : '').' /> everybody'."\n".
'