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

Diff for /loncom/interface/loncommon.pm between versions 1.19 and 1.22

version 1.19, 2001/12/21 17:06:56 version 1.22, 2001/12/28 19:48:42
Line 29 Line 29
 # 2/13-12/7 Guy Albertelli  # 2/13-12/7 Guy Albertelli
 # 12/11,12/12,12/17 Scott Harrison  # 12/11,12/12,12/17 Scott Harrison
 # 12/21 Gerd Kortemeyer  # 12/21 Gerd Kortemeyer
   # 12/21 Scott Harrison
   # 12/25,12/28 Gerd Kortemeyer
   
 # Makes a table out of the previous attempts  # Makes a table out of the previous attempts
 # Inputs result_from_symbread, user, domain, course_id  # Inputs result_from_symbread, user, domain, course_id
Line 37 Line 39
 package Apache::loncommon;  package Apache::loncommon;
   
 use strict;  use strict;
   use Apache::lonnet();
 use POSIX qw(strftime);  use POSIX qw(strftime);
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::lonmsg();  use Apache::lonmsg();
   
   my $readit;
   
   # ----------------------------------------------- Filetypes/Languages/Copyright
 my %language;  my %language;
 my %cprtag;  my %cprtag;
 my %fe; my %fd;  my %fe; my %fd;
 my %fc;  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
 BEGIN {  BEGIN {
   
       unless ($readit) {
 # ------------------------------------------------------------------- languages  # ------------------------------------------------------------------- languages
     {      {
  my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.   my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
Line 104  BEGIN { Line 121  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(
                 "<font color=yellow>INFO: Read file types and thesaurus</font>");
       $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  # ---------------------------------------------------------------- Language IDs
Removed from v.1.19  
changed lines
  Added in v.1.22

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