File Coverage

blib/lib/WordNet/Similarity/lch.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

# WordNet::Similarity::lch.pm version 2.04
# (Last update $Id: lch.pm,v 1.24 2008/03/27 06:21:17 sidz1979 Exp $)
#
# Semantic Similarity Measure package implementing the measure
# described by Leacock and Chodorow (1998).
#
# Copyright (c) 2005,
#
# Ted Pedersen, University of Minnesota Duluth
# tpederse at d.umn.edu
#
# Siddharth Patwardhan, University of Utah, Salt Lake City
# sidd at cs.utah.edu
#
# Jason Michelizzi, Univeristy of Minnesota Duluth
# mich0212 at d.umn.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::lch;

=head1 NAME

WordNet::Similarity::lch - Perl module for computing semantic relatedness
of word senses using the method described by Leacock and Chodorow (1998).

=head1 SYNOPSIS

  use WordNet::Similarity::lch;

  use WordNet::QueryData;

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

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

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

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

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

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

=head1 DESCRIPTION

This module computes the semantic relatedness of word senses according
to a method described by Leacock and Chodorow (1998). This method counts up
the number of edges between the senses in the 'is-a' hierarchy of WordNet.
The value is then scaled by the maximum depth of the WordNet 'is-a'
hierarchy. A relatedness value is obtained by taking the negative log
of this scaled value.

=head2 Methods

=over

=cut

use strict;
use Exporter;
use WordNet::Similarity::DepthFinder;

our @ISA = qw/WordNet::Similarity::DepthFinder/;

our $VERSION = '2.04';

=item $lch->setPosList()

This method is internally called to determine the parts of speech
this measure is capable of dealing with.

Parameters: none.

Returns: none.

=cut

sub setPosList
{
  my $self = shift;
  $self->{n} = 1;
  $self->{v} = 1;
}

=item $lch->getRelatedness ($synset1, $synset2)

Computes the relatedness of two word senses using a node counting scheme.
For details on how relatedness is computed, see the Discussion section
below.

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

Returns: Unless a problem occurs, the return value is the relatedness
score.  If no path exists between the two word senses, then a large
negative number is returned.  If an error occurs, then the error level
is set to non-zero and an error string is created (see the description
of getError()).  Note: the error level will also be set to 1 and an error
string will be created if no path exists between the words.

=cut

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

    my $class = ref $self || $self;

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

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

    # JM 1-21-04
    # moved input validation code to parseWps() in a super-class
    my $ret = $self->parseWps ($wps1, $wps2);
    ref $ret or return $ret;
    my ($word1, $pos1, $sense1, $offset1, $word2, $pos2, $sense2, $offset2)
      = @{$ret};

    my $pos = $pos1;

    # 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.

    # JM 3-9-04
    # Modified to use the methods of DepthFinder et al.

    my @LCSs = $self->getLCSbyPath ($offset1, $offset2, $pos1, 'offset');

    # check if there is no path between synsets
    unless (defined $LCSs[0]) {
      return $self->UNRELATED;
    }

    # find the LCS (well, path really) that is in the deepest taxonomy
    my $maxdepth = -1;
    my $length;
    foreach (@LCSs) {
	my $lcs;
	($lcs, $length) = @{$_};

	my @roots = $self->getTaxonomies ($lcs, $pos1);

	foreach my $root (@roots) {
	    my $depth = $self->getTaxonomyDepth ($root, $pos1);
	    unless (defined $depth) {
		$self->{error} = $self->{error} < 1 ? 1 : $self->{error};
		$self->{errorString} .="\nWarning (${class}::getRelatedness()) - ";
		$self->{errorString} .= "Taxonomy depth for $root undefined.";
		return undef;
	    }
	    $maxdepth = $depth if $depth > $maxdepth;
	}
    }

    if ($maxdepth <= 0) {
	$self->{error} = $self->{error} < 1 ? 1 : $self->{error};
	$self->{errorString} .= "\nWarning (${class}::getRelatedness()) - ";
	$self->{errorString} .= "Max depth of taxonomy is not positive.";
	return undef;
    }

    my $score = log (2 * $maxdepth / $length);

    $self->storeToCache ($offset1, $offset2, $score);

    return $score;
}

1;

__END__