ヤミRoot VoidGate

Viewing: TermExtract.pm

###########################################
package Text::TermExtract;
###########################################

use strict;
use warnings;
use Lingua::StopWords;
use Text::Language::Guess;
use Log::Log4perl qw(:easy);

our $VERSION = "0.02";

###########################################
sub new {
###########################################
    my($class, %options) = @_;

    my $self = {
        languages => ['en'],
        %options,
    };

    bless $self, $class;
}

###########################################
sub exclude {
###########################################
    my($self, $aref) = @_;

    for (@$aref) {
        $self->{exclude}->{$_}++;
    }
}

###########################################
sub terms_extract {
###########################################
    my($self, $text, $opts) = @_;

    $opts = {} unless defined $opts;

    my $guesser = Text::Language::Guess->
            new(languages => $self->{languages});

    my $lang = 
        $guesser->language_guess_string($text);

    $lang = $self->{languages}->[0] unless $lang;
    DEBUG "Guessed language: $lang\n";

    my $stopwords =
      Lingua::StopWords::getStopWords($lang);

    my %words;

    while($text =~ /\b(\w+)\b/g) {
        my $word = lc($1);
        next if $stopwords->{$word};
        next if $word =~ /^\d+$/;
        next if length($word) <= 2;
        next if exists $self->{exclude}->{$word};
        $words{$word}++;
        $words{$word} += 3 if length $word > 6;
    }
    
    my @weighted_words = sort {
      $words{$b} <=> $words{$a} or
      $a cmp $b  # sort alphabetically on equal score
    } keys %words;

    if(get_logger()->is_debug()) {
        for my $word (@weighted_words) {
            DEBUG "$word scores $words{$word}";
        }
    }

    if(exists $opts->{max} and $opts->{max} < @weighted_words) {
        return @weighted_words[0..($opts->{max}-1)];
    } else {
        return @weighted_words;
    }
}

1;

__END__

=head1 NAME

Text::TermExtract - Extract terms from text

=head1 SYNOPSIS

    use Text::TermExtract;

    my $text = { Hey, hey, how's it going? Wanna go to Wendy's 
                 tonight? Wendy's has great sandwiches." };

    my $ext = Text::TermExtract->new();

    for my $word ( $ext->terms_extract( $text, { max => 3 }) ) {
        print "$word\n";
    }

    # "sandwiches"
    # "tonight"
    # "wendy"

=head1 DESCRIPTION

Text::TermExtract takes a simple approach at extracting the most interesting
terms from documents of arbitrary length.

There's more scientific methods to term extraction, like Yahoo's online 
term extraction API (but you can't have it locally) and the Lingua::YaTeA 
module on CPAN (which is so poorly documented that I couldn't figure out
how to use it). 

So I wrote Text::TermExtract, which first tries to
guess the language a text is written in, kicks out the language-
specific stopwords, weighs the rest with a hand-crafted formula and
returns a list of (hopefully) interesting words.

This is a very crude approach to term extraction, if you have a better
method and want to include it in Text::TermExtract, drop me an email,
I'm interested.

=head2 METHODS

=over 4

=item new()

Constructor.

=item terms_extract( $text, $opts )

Goes through the text stringin $text, extracts the keywords and returns
them as a list.

To limit the number of words returned, use the C<max> option:

    $extr->terms_extract( $text, { max => 10 } );

=item exclude( $array_ref )

Add a list of words to exclude. The words listed in the array passed
in as a reference will never be used as keywords.

    $extr->exclude( ['moe', 'joe'] );

=back

=head1 LEGALESE

Copyright 2008 by Mike Schilli, all rights reserved.
This program is free software, you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 AUTHOR

2008, Mike Schilli <cpan@perlmeister.com>
User / IP	: 216.73.216.33
Host / Server	: 146.88.233.70 / dev.loger.cm
System	: Linux hybrid1120.fr.ns.planethoster.net 3.10.0-957.21.2.el7.x86_64 #1 SMP Wed Jun 5 14:26:44 UTC 2019 x86_64