File Coverage

blib/lib/WordNet/Similarity/lesk.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

# WordNet::Similarity::lesk.pm version 2.04
# (Last updated $Id: lesk.pm,v 1.30 2015/10/04 15:06:16 tpederse Exp $)
#
# Module to accept two WordNet synsets and to return a floating point
# number that indicates how similar those two synsets are, using an
# adaptation of the Lesk method as outlined in
# Satanjeev Banerjee, Ted Pedersen>
#
# Copyright (c) 2005,
#
# Ted Pedersen, University of Minnesota Duluth
# tpederse at d.umn.edu
#
# Satanjeev Banerjee, Carnegie Mellon University, Pittsburgh
# banerjee+ at cs.cmu.edu
#
# Siddharth Patwardhan, University of Utah, Salt Lake City
# sidd at cs.utah.edu
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to
#
# The Free Software Foundation, Inc.,
# 59 Temple Place - Suite 330,
# Boston, MA  02111-1307, USA.
#
# ------------------------------------------------------------------

package WordNet::Similarity::lesk;

=head1 NAME

WordNet::Similarity::lesk - Perl module for computing semantic relatedness
of word senses using gloss overlaps as described by Banerjee and Pedersen
(2002) -- a method that adapts the Lesk approach to WordNet.

=head1 SYNOPSIS

  use WordNet::Similarity::lesk;

  use WordNet::QueryData;

  my $wn = WordNet::QueryData->new();

  my $lesk = WordNet::Similarity::lesk->new($wn);

  my $value = $lesk->getRelatedness("car#n#1", "bus#n#2");

  ($error, $errorString) = $lesk->getError();

  die "$errorString\n" if($error);

  print "car (sense 1) <-> bus (sense 2) = $value\n";

=head1 DESCRIPTION

Lesk (1985) proposed that the relatedness of two words is proportional to
to the extent of overlaps of their dictionary definitions. Banerjee and
Pedersen (2002) extended this notion to use WordNet as the dictionary
for the word definitions. This notion was further extended to use the rich
network of relationships between concepts present is WordNet. This adapted
lesk measure has been implemented in this module.

=head2 Methods

=over

=cut

use strict;
use warnings;
use Text::OverlapFinder;
use WordNet::Similarity;
use File::Spec;
use WordNet::Similarity::GlossFinder;

our @ISA = qw(WordNet::Similarity::GlossFinder);
our $VERSION = '2.04';

WordNet::Similarity::addConfigOption ("normalize", 0, "i", 0);

=item $measure->initialize($file)

Overrides the initialize method in the parent class (GlossFinder.pm). This method
essentially initializes the measure for use.

Parameters: $file -- configuration file.

Returns: none.

=cut

# Initialization of the WordNet::Similarity::lesk object... parses the config file and sets up
# global variables, or sets them to default values.
# INPUT PARAMS  : $paramFile .. File containing the module specific params.
# RETURN VALUES : (none)
sub initialize
{
    my $self = shift;
    my $paramFile;
    my $wn = $self->{wn};
    my $class = ref $self || $self;

    # Stemming? Normalizing?
    $self->{stem} = 0;
    $self->{normalize} = 0;

    # Look for the default lesk relation file...
    if(!defined $self->{relationDefault})
    {
        my $path;
        my $header;
        my @possiblePaths = ();

        # Look for all possible default data files installed.
        foreach $path (@INC)
        {
            # JM 1-16-04  -- modified to use File::Spec
            my $file = File::Spec->catfile($path, 'WordNet', 'lesk-relation.dat');
            push @possiblePaths, $file if(-e $file);
        }

        # If there are multiple possibilities, get the one in the correct format.
        foreach $path (@possiblePaths)
        {
            next if(!open(RELATIONS, $path));
            $header = ;
            $header =~ s/\s+//g;
            if($header =~ /RelationFile/)
            {
                $self->{relationDefault} = $path;
                close(RELATIONS);
                last;
            }
            close(RELATIONS);
        }
    }

    # Call the initialize method in the parent...
    $self->SUPER::initialize (@_);

    # initialize string compare module. No stemming in string
    # comparison, so put 0.
    #&string_compare_initialize(0, %stopHash);
    my @finder_args = ();

    if (defined $self->{stop}) {
	push @finder_args, stoplist => $self->{stop};
    }
    # lesk doesn't use a comp file, so we can ignore that

    $self->{finder} = Text::OverlapFinder->new (@finder_args);
}

=item $lesk->traceOptions()

This method is internally called to determine the extra options
specified by this measure (apart from the default options specified
in the WordNet::Similarity base class).

Parameters: none.

Returns: none.

=cut

# 12/5/03 JM (#1)
# show all config options specific to this module
sub traceOptions
{
  my $self = shift;
  $self->{traceString} .= "normalize :: $self->{normalize}\n";
  $self->SUPER::traceOptions();
}

=item $lesk->getRelatedness

Computes the relatedness of two word senses using the Extended Gloss
Overlaps algorithm.

Parameters: two word senses in "word#pos#sense" format.

Returns: Unless a problem occurs, the return value is the relatedness
score, which is greater-than or equal-to 0. If an error occurs,
then the error level is set to non-zero and an error
string is created (see the description of getError()).

=cut

sub getRelatedness
{
    my $self = shift;
    my $wps1 = shift;
    my $wps2 = shift;
    my $wn = $self->{wn};
    my $class = ref $self || $self;

    # Check the existence of the WordNet::QueryData object.
    unless($wn)
    {
        $self->{errorString} .= "\nError (${class}::getRelatedness()) - ";
        $self->{errorString} .= "A WordNet::QueryData object is required.";
        $self->{error} = 2;
        return undef;
    }

    # Using validation code from parseWps() in a super-class
    my $ret = $self->parseWps($wps1, $wps2);
    ref $ret or return undef;

    # Initialize traces.
    $self->{traceString} = "";

    # Now check if the similarity value for these two synsets is in
    # fact in the cache... if so return the cached value.
    my $relatedness =
        $self->{doCache} ? $self->fetchFromCache ($wps1, $wps2) : undef;
    defined $relatedness and return $relatedness;

    # Now get down to really finding the relatedness of these two.
    # see if any traces reqd. if so, put in the synset arrays.
    if($self->{trace})
    {
	# ah so we do need SOME traces! put in the synset names.
	$self->{traceString}  = "Synset 1: $wps1\n";
	$self->{traceString} .= "Synset 2: $wps2\n";
    }

    # NOTE: Thanks to Wybo Wiersma for contributing optimizations
    #       in the following code.

    # Get the gloss strings from the get_wn_info module
    my ($firstStringArray, $secondStringArray, $weightsArray, $functionsStringArray) = $self->getSuperGlosses($wps1, $wps2);
    my $score = 0;
    for(my $i = 0; $i < scalar(@{$weightsArray}); $i++)
    {
        my $functionsScore = 0;
        my $funcStringPrinted = 0;

	# so those are the two strings for this relation pair. get the
	# string overlaps
	my ($overlaps, $wc1, $wc2);
        if(defined($firstStringArray->[$i]) && defined($secondStringArray->[$i])
           && $firstStringArray->[$i] ne "" && $secondStringArray->[$i] ne "")
        {
            ($overlaps, $wc1, $wc2) = $self->{finder}->getOverlaps($firstStringArray->[$i], $secondStringArray->[$i]);
        }

	my $overlapsTraceString = "";
	my $key;
	# modified by tdp oct 4 2015 to make matching more robust
	# results from keys can come back in various orders, so sort them
	#	foreach $key (keys %{$overlaps})
	foreach $key (sort keys %{$overlaps})
	{
	    # find the length of the key, square it, multiply with its
	    # value and finally with the weight associated with this
	    # relation pair to get the score for this particular
	    # overlap.

	    my @tempArray = split(/\s+/, $key);
	    my $value = ($#tempArray + 1) * ($#tempArray + 1) * $overlaps->{$key};
	    $functionsScore += $value;

	    # put this overlap into the trace string, if necessary
	    if($self->{trace} == 1)
	    {
		$overlapsTraceString .= "$overlaps->{$key} x \"$key\"  ";
	    }
	}

	# normalize the function score computed above if required
	if ($self->{normalize} && defined($wc1) && defined($wc2) && ($wc1 * $wc2))
	{
	    $functionsScore /= $wc1 * $wc2;
	}

	# weight functionsScore with weight of this function
	$functionsScore *= $weightsArray->[$i];

	# add to main score for this sense
	$score += $functionsScore;

	# if we have an overlap, send functionsString, functionsScore
	# and overlapsTraceString to trace string, if trace string requested
	if($self->{trace} == 1 && $overlapsTraceString ne "")
	{
	    $self->{traceString} .= "".($functionsStringArray->[$i]).": $functionsScore\n";
	    $funcStringPrinted = 1;

	    $self->{traceString} .= "Overlaps: $overlapsTraceString\n";
	}

	# check if the two strings need to be reported in the trace.
	if ($self->{trace} == 2)
	{
	    if(!$funcStringPrinted)
	    {
		$self->{traceString} .= "".($functionsStringArray->[$i])."\n";
		$funcStringPrinted = 1;
	    }

	    $self->{traceString} .= "String 1: \"".($firstStringArray->[$i])."\"\n";
	    $self->{traceString} .= "String 2: \"".($secondStringArray->[$i])."\"\n";
	}
    }

    # that does all the scoring. Put in cache if doing caching. Then
    # return the score.
    $self->{doCache} and $self->storeToCache($wps1, $wps2, $score);
    return $score;
}

1;
__END__