--- loncom/interface/loncommon.pm 2001/12/21 17:03:17 1.18 +++ loncom/interface/loncommon.pm 2001/12/28 19:48:42 1.22 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.18 2001/12/21 17:03:17 www Exp $ +# $Id: loncommon.pm,v 1.22 2001/12/28 19:48:42 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -29,6 +29,8 @@ # 2/13-12/7 Guy Albertelli # 12/11,12/12,12/17 Scott Harrison # 12/21 Gerd Kortemeyer +# 12/21 Scott Harrison +# 12/25,12/28 Gerd Kortemeyer # Makes a table out of the previous attempts # Inputs result_from_symbread, user, domain, course_id @@ -37,18 +39,33 @@ package Apache::loncommon; use strict; +use Apache::lonnet(); use POSIX qw(strftime); use Apache::Constants qw(:common); use Apache::lonmsg(); +my $readit; +# ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %cprtag; my %fe; my %fd; my %fc; +# -------------------------------------------------------------- Thesaurus data +my @therelated; +my @theword; +my @thecount; +my %theindex; +my $thetotalcount; +my $thefuzzy=2; +my $thethreshold=0.1/$thefuzzy; +my $theavecount; + # ----------------------------------------------------------------------- BEGIN BEGIN { + + unless ($readit) { # ------------------------------------------------------------------- languages { my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. @@ -104,6 +121,87 @@ BEGIN { } } } +# -------------------------------------------------------------- Thesaurus data + { + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. + '/thesaurus.dat'); + if ($fh) { + while (<$fh>) { + my ($tword,$tindex,$tcount,$trelated)=split(/\@/,$_); + $theindex{$tword}=$tindex; + $theword[$tindex]=$tword; + $thecount[$tindex]=$tcount; + $thetotalcount+=$tcount; + $therelated[$tindex]=$trelated; + } + } + $theavecount=$thetotalcount/$#thecount; + } + &Apache::lonnet::logthis( + "INFO: Read file types and thesaurus"); + $readit=1; +} + +} +# ============================================================= END BEGIN BLOCK + + +# ---------------------------------------------------------- Is this a keyword? + +sub keyword { + my $newword=shift; + $newword=~s/\W//g; + $newword=~tr/A-Z/a-z/; + my $tindex=$theindex{$newword}; + if ($tindex) { + if ($thecount[$tindex]>$theavecount) { + return 1; + } + } + return 0; +} +# -------------------------------------------------------- Return related words + +sub related { + my $newword=shift; + $newword=~s/\W//g; + $newword=~tr/A-Z/a-z/; + my $tindex=$theindex{$newword}; + if ($tindex) { + my %found=(); + foreach (split(/\,/,$therelated[$tindex])) { +# - Related word found + my ($ridx,$rcount)=split(/\:/,$_); +# - Direct relation index + my $directrel=$rcount/$thecount[$tindex]; + if ($directrel>$thethreshold) { + foreach (split(/\,/,$therelated[$ridx])) { + my ($rridx,$rrcount)=split(/\:/,$_); + if ($rridx==$tindex) { +# - Determine reverse relation index + my $revrel=$rrcount/$thecount[$ridx]; +# - Calculate full index + $found{$ridx}=$directrel*$revrel; + if ($found{$ridx}>$thethreshold) { + foreach (split(/\,/,$therelated[$ridx])) { + my ($rrridx,$rrrcount)=split(/\:/,$_); + unless ($found{$rrridx}) { + my $revrevrel=$rrrcount/$thecount[$ridx]; + if ( + $directrel*$revrel*$revrevrel>$thethreshold + ) { + $found{$rrridx}= + $directrel*$revrel*$revrevrel; + } + } + } + } + } + } + } + } + } + return (); } # ---------------------------------------------------------------- Language IDs @@ -167,9 +265,9 @@ sub get_previous_attempt { my %lasthash=(); my $version; for ($version=1;$version<=$returnhash{'version'};$version++) { - map { + foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) { $lasthash{$_}=$returnhash{$version.':'.$_}; - } sort(split(/\:/,$returnhash{$version.':keys'})); + } } $prevattempts=''; foreach (sort(keys %lasthash)) {
History