File Coverage

blib/lib/WordNet/Similarity/wup.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::wup.pm version 2.04
# (Last updated $Id: wup.pm,v 1.27 2008/03/27 06:21:17 sidz1979 Exp $)
#
# Semantic Similarity Measure package implementing the semantic
# relatedness measure described by Wu & Palmer (1994) as revised
# by Resnik (1999).
#
# Copyright (c) 2005,
#
# Ted Pedersen, University of Minnesota Duluth
# tpederse at d.umn.edu
#
# Jason Michelizzi, Univeristy of Minnesota Duluth
# mich0212 at d.umn.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::wup;

=head1 NAME

WordNet::Similarity::wup - Perl module for computing semantic
relatedness of word senses using the edge counting method of the
of Wu & Palmer (1994)

=head1 SYNOPSIS

 use WordNet::Similarity::wup;

 use WordNet::QueryData;

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

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

 my $value = $wup->getRelatedness('dog#n#1', 'cat#n#1');

 my ($error, $errorString) = $wup->getError();

 die $errorString if $error;

 print "dog (sense 1) <-> cat (sense 1) = $value\n";

=head1 DESCRIPTION

Resnik (1999) revises the Wu & Palmer (1994) method of measuring semantic
relatedness.  Resnik uses use an edge distance method by taking into
account the most specific node subsuming the two concepts.  Here we have
implemented the original Wu & Palmer method, which uses node-counting.

=head2 Methods

This module defines the following methods:

=over

=cut

use strict;
use warnings;

use WordNet::Similarity::DepthFinder;

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

our $VERSION = '2.04';

=item $wup->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 $in1 = shift;
  my $in2 = shift;

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

  # initialize trace string
  $self->{traceString} = "";

  # JM 1-21-04
  # moved input validation code to WordNet::Similarity::parseWps()
  my $ret = $self->parseWps ($in1, $in2);
  ref $ret or return $ret;
  my ($word1, $pos1, $sense1, $offset1, $word2, $pos2, $sense2, $offset2)
    = @{$ret};

  defined $word1 or return undef;

  my $wps1 = "$word1#$pos1#$sense1";
  my $wps2 = "$word2#$pos2#$sense2";

  my $score = $self->fetchFromCache ($wps1, $wps2);
  return $score if defined $score;

  my @LCSs = $self->getLCSbyDepth ($wps1, $wps2, $pos1, 'wps');
  my $temp = shift @LCSs;
  unless (ref $temp) {
    return $temp;
  }
  my ($lcs, $depth, $root) = @{$temp};

  unless (defined $lcs) {
    # no lcs found, return unrelated (errors already generated)
    return $self->UNRELATED;
  }

  # now find the depth of $wps1 and $wps2
  my $trace = $self->{trace};
  $self->{trace} = 0;
  my @paths1 = $self->getShortestPath ($wps1, $lcs, $pos1, 'wps');
  my @paths2 = $self->getShortestPath ($wps2, $lcs, $pos1, 'wps');
  $self->{trace} = $trace;

  my ($length1, undef) = @{shift @paths1};
  my ($length2, undef) = @{shift @paths2};

  if (ref $length1) {
      die "Length 1 is a ref\n";
  }
  # If we've already found an lcs, then there must be a path, so this
  # error should never occur, but there's little harm in checking anyways
  unless (defined $length1) {
      $self->{errorString} .= "Length 1 is undefined.";
      $self->{error} = 1;
      return undef;
  }
  unless (defined $length2) {
      $self->{errorString} .= "Length 2 is undefined.";
      $self->{error} = 1;
      return undef;
  }

  my $depth1 = $depth + $length1 - 1;
  my $depth2 = $depth + $length2 - 1;

  $score = 2 * $depth / ($depth1 + $depth2);

  $self->storeToCache ($wps1, $wps2, $score) if $self->{doCache};

  if ($self->{trace}) {
    $self->{traceString} .= "\nDepth(";
    $self->printSet ($pos1, 'wps', $in1);
    $self->{traceString} .= ") = $depth1\nDepth(";
    $self->printSet ($pos1, 'wps', $in2);
    $self->{traceString} .= ") = $depth2\n";
  }
  return $score;
}

###
# JM 1-16-04
# All of the code that used to follow here has been replaced by code in
# PathFinder.
###

1;

__END__