[LON-CAPA-cvs] cvs: loncom /homework grades.pm

[www]

www		Wed Apr 30 11:52:28 2003 EDT

  Modified files:              
    /loncom/homework	grades.pm 
  Log:
  Continued work on bug 108. Find essay that is most similar to student work.
  
  
Index: loncom/homework/grades.pm
diff -u loncom/homework/grades.pm:1.86 loncom/homework/grades.pm:1.87
--- loncom/homework/grades.pm:1.86	Mon Apr 21 14:39:43 2003
+++ loncom/homework/grades.pm	Wed Apr 30 11:52:28 2003
@@ -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.87 2003/04/30 15:52:28 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -46,6 +46,9 @@
 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 @@
 }
 
 #------------------ 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.5;
+    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::similar($uessay,$tessay,$limit);
+# Found one
+            if ($tsimilar>$limit) {
+		$limit=$tsimilar;
+                $sname=$tname;
+                $sdom=$sdom;
+                $scrsid=$tcrsid;
+                $sessay=$oldessays{$tkey};
+            }
+        } 
+    }
+    if ($limit>0.5) {
+       return ($sname,$sdom,$scrsid,$sessay,$limit);
+    } else {
+       return ('','','','',0);
+    }
+}
+
 #-------------------------------------------------------------------
 
 #------------------------------------ Receipt Verification Routines