Changeset 17214

Timestamp:

2008-09-08 13:44:20 (3 months ago)

Author:

ak19

Message:

Significant changes: 1. Textcat can be restricted to a given encoding when the encoding of a file's contents is known. In this case we are after the language of the contents. 2. Code for working out most frequently occurring encoding has been moved into here from ReadTextFile?.pm. 3. Subroutines renamed and unnecessary parameters passed to the various versions of classify() have been moved into set and get methods instead.

Files:

• gsdl/trunk/perllib/textcat.pm (modified) (8 diffs)

gsdl/trunk/perllib/textcat.pm

@@ -87 +87 @@
-
-
-
-# CLASSIFICATION
-#
@@ -93 +92 @@
-#   Input:  text string
-#   Output: array of language names
-
+
+
+
+
+
-sub classify {
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-    my %results = ();
-    my $maxp = $self->{'opt_t'};
@@ -107 +131 @@
-    my $unknown = $self->create_lm($inputref);
-
-
-
+
-        # compare language model with input ngrams list
-        my ($i,$p)=(0,0);
@@ -133 +156 @@
-}
-
-
+
+
-# The cache is a map of the filename to the corresponding filename_encodings
-# (an array of results returned by textcat of the possible filename-encodings 
@@ -144 +168 @@
-# can also be cleared by a call to clear_filename_cache.
-sub classify_cached_filename {
-
-
+
-    
-    # if not already in the cache, work it out and put it there
@@ -153 +176 @@
-            $self->clear_filename_cache();
-        }
-, $opt_freq, $opt_factor, $opt_top
+
-    } 
-
@@ -161 +184 @@
-
-# Same as above, but caches textcat results on filecontents for subsequent use.
+# Textcat on a file's contents to work out its possible encodings. Uses the cache.
-# The cache is a map of the filename to an array of possible filename_encodings
-# for the *contents* of the file returned by textcat.
@@ -167 +191 @@
-# MAX_CACHE_SIZE by default or can be specified as a parameter. The cache
-# can also be cleared by a call to clear_filecontents_cache.
-
-
-
-
+
+
+
-    # if not already in the cache, work it out and put it there
- 
+
-    {      
-        if (scalar (keys %filecontents_cache) >= $self->{'max_cache_size'}) {
-            $self->clear_filecontents_cache();
-        }
-
-
-
+
+
+
+
-    # return cached array of content encodings for the given filename
-    return $filecontents_cache{$filename};
+}
+
+
+# Given the known encoding for a file's contents, performs a textcat 
+# filtering on the languages for the given encoding. Results are stored
+# in the cache TWICE: once under $filename|$filter_by_encoding, and
+# once under the usual $filename, so that subsequent calls to either
+# this method or classify_contents using the same filename will not
+# perform textcat again. 
+sub classify_contents_for_encoding {
+    my ($self, $contents_ref, $filename, $filter_by_encoding)=@_;
+
+    if (!defined $filecontents_cache{"$filename|$filter_by_encoding"})
+    {      
+        if (scalar (keys %filecontents_cache) >= $self->{'max_cache_size'}) {
+            $self->clear_filecontents_cache();
+        }       
+
+        $filecontents_cache{"$filename|$filter_by_encoding"} = $self->classify($contents_ref, $filter_by_encoding);
+        # store this in cache again under $filename entry, so that subsequent 
+        # calls to classify_contents will find it in the cache already
+        $filecontents_cache{$filename} = $self->classify($contents_ref, $filter_by_encoding);
+    }
+    return $filecontents_cache{$filename};
+}
+   
+
+# This method returns the most frequently occurring encoding 
+# but only if any encoding occurs more than once in the given results.
+# Otherwise, "" is returned.
+sub most_frequent_encoding {
+    my ($self, $results) = @_;
+    my $best_encoding = "";
+
+    # guessed_encodings is a hashmap of Encoding -> Frequency pairs
+    my %guessed_encodings = ();
+    foreach my $result (@$results) {
+        # Get the encoding portion of a language-model filename like en-iso8859_1
+        my ($encoding) = ($result =~ /^(?:[^\-]+)\-([^\-]+)$/);
+        if(!defined($guessed_encodings{$encoding})) {
+            $guessed_encodings{$encoding} = 0;
+        }
+        $guessed_encodings{$encoding}++;
+    }
+    
+    $guessed_encodings{""}=-1; # for default best_encoding of ""
+
+    foreach my $enc (keys %guessed_encodings) {
+        if ($guessed_encodings{$enc} > $guessed_encodings{$best_encoding}) {
+            $best_encoding = $enc;
+        }
+    }
+
+    # If best_encoding's frequency == 1, then the frequency for all encodings will 
+    # be 1 since the sum total of all frequencies is num_results: if any encoding
+    # has frequency > 1 (it's possibly the best_encoding), one or more of the others
+    # would have been at 0 frequency to compensate.
+    return ($guessed_encodings{$best_encoding} > 1) ? $best_encoding : "";
+}
+
+
+# set some of the specific member variables
+sub set_opts {
+    my ($self, $opt_freq, $opt_factor, $opt_top, $max_size_of_cache)=@_;
+         
+    $self->{'opt_f'} = $opt_freq if defined $opt_freq;
+    $self->{'opt_u'} = $opt_factor if defined $opt_factor;
+    $self->{'opt_t'} = $opt_top if defined $opt_top;
+
+    $self->{'max_cache_size'} = $max_size_of_cache if defined $max_size_of_cache;
+}
+
+sub get_opts {
+    my $self = shift (@_);
+    return ($self->{'opt_f'}, $self->{'opt_u'}, $self->{'opt_t'}, $self->{'max_cache_size'});
-}
-