File Coverage

blib/lib/WordNet/Similarity.pm

Criterion	Covered	Total	%
statement	28	30	93.3
branch			n/a
condition			n/a
subroutine	10	10	100.0
pod			n/a
total	38	40	95.0

# WordNet::Similarity.pm version 2.05
# (Last updated $Id: Similarity.pm,v 1.50 2008/05/30 10:16:38 sidz1979 Exp $)
#
# Module containing the version information and pod
# for the WordNet::Similarity package, and all measures are
# derived from this class.
#
# 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
#
# Satanjeev Banerjee, Carnegie Mellon University, Pittsburgh
# banerjee+ at cs.cmu.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;

=head1 NAME

WordNet::Similarity - Perl modules for computing measures of semantic
relatedness.

=head1 SYNOPSIS

=head2 Basic Usage Example

  use WordNet::QueryData;

  use WordNet::Similarity::path;

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

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

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

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

  die $errorString if $error;

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

=head2 Using a configuration file to initialize the measure

  use WordNet::Similarity::path;

  my $sim = WordNet::Similarity::path->new($wn, "mypath.cfg");

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

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

  die $errorString if $error;

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

=head2 Printing traces

  print "Trace String -> ".($sim->getTraceString())."\n";

=head1 DESCRIPTION

=head2 Introduction

We observe that humans find it extremely easy to say if two words are
related and if one word is more related to a given word than another. For
example, if we come across two words, 'car' and 'bicycle', we know they
are related as both are means of transport. Also, we easily observe that
'bicycle' is more related to 'car' than 'fork' is. But is there some way to
assign a quantitative value to this relatedness? Some ideas have been put
forth by researchers to quantify the concept of relatedness of words, with
encouraging results.

Eight of these different measures of relatedness have been implemented in
this software package. A simple edge counting measure and a random measure
have also been provided. These measures rely heavily on the vast store of
knowledge available in the online electronic dictionary -- WordNet. So, we
use a Perl interface for WordNet called WordNet::QueryData to make it
easier for us to access WordNet. The modules in this package REQUIRE that
the WordNet::QueryData module be installed on the system before these
modules are installed.

=head2 Function

The following function is defined:

=over

=cut

use strict;
use Carp;
use Exporter;

# please use these, but remember that constants are not interpolated:
#  print "Root: ROOT\n";         # wrong!
#  print "Root: ".ROOT."\n";     # right
#  m/ROOT/;                      # wrong!
#  $pattern = ROOT; m/$pattern/; # okay
use constant ROOT => "*Root*";
use constant ROOT_N => "*Root*#n#1";
use constant ROOT_V => "*Root*#v#1";

# JM 12/9/03
# we would like this to be numeric
use constant UNRELATED => -1_000_000;

# if we are using an unlimited cache size, it's easier to fake an
# unlimited cache with a really big value.
use constant UNLIMITED_CACHE => 2_147_483_647;

use constant DEFAULT_CACHE => 5_000;

use WordNet::Tools;

our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

@ISA = qw(Exporter);

%EXPORT_TAGS = ();

@EXPORT_OK = ();

@EXPORT = ();

$VERSION = '2.05';

# a hash to contain the module-specific configuration options.
our %config_options;

=item addConfigOption ($name, $required, $type, $default_val)

Adds the configuration option, $name, to the list of known config
options (cf. configure()).  If $required is true, then the option
requires a value; otherwise, the value is optional, and the default
value $default_val is used if a value is not specified in the config
file.  $type is the type of value the option takes.  It can be
'i' for integer, 'f' for floating-point, 's' for string, or 'p' for
a file name.

returns: nothing, but will C on error.  You can put the call to
this function in an C block to trap the exception (N.B., the
C form of C does not significantly degrade performance,
unlike the C form of C.  See C).

=cut

sub addConfigOption
{
  my $name = shift;
  my $required = shift;
  my $type = shift;
  my $default = shift;

  my ($package, $filename, $line) = caller;
  if ($package eq 'vector') {
    print "vector\n"
  }

  $config_options{$name}->{$package} = [($required ? 1 : 0), $type, $default];
}

=back

=head2 Methods

The following methods are defined in this package:

=head3 Public methods

=over

=item $obj->new ($wn, $config_file)

The constructor for WordNet::Similarity::* objects.

Parameters: $wn is a WordNet::QueryData object, $config_file is a
configuration file (optional).

Return value: the new blessed object

=cut

sub new
{
  my $class = shift;
  my $this = {};

  $class = ref $class || $class;

  $this->{errorString} = '';
  $this->{error} = 0;

  if ($class eq 'WordNet::Similarity') {
    $this->{errorString} .= "\nWarning (${class}::new()) - ";
    $this->{errorString} .= "This class is intended to be an abstract base class for a measure.  Your class should override it.";
    $this->{error} = 1;
  }

  $this->{wn} = shift;
  unless (defined $this->{wn}) {
    $this->{errorString} .= "\nError (${class}::new()) - ";
    $this->{errorString} .= "A WordNet::QueryData object is required.";
    $this->{error} = 2;
  }
  else {
    # queryWord() in older versions of WordNet::QueryData was broken
    $this->{wn}->VERSION (1.30);
    my $wntools = WordNet::Tools->new($this->{wn});
    unless (defined $wntools) {
      $this->{errorString} .= "\nError (${class}::new()) - ";
      $this->{errorString} .= "Error creating WordNet::Tools object.";
      $this->{error} = 2;
    }
    $this->{wntools} = $wntools;
  }

  bless $this, $class;

  $this->initialize (shift) if $this->{error} < 2;

  $this->setPosList();

  # [trace]
  if ($this->{trace}) {
    $this->{traceString} = "${class} object created:\n";
    $this->{traceString} .= "trace :: $this->{trace}\n";
    $this->{traceString} .= "cache :: $this->{doCache}\n";
    $this->{traceString} .= "cache size :: $this->{maxCacheSize}\n";
    $this->traceOptions ();
  }
  # [/trace]

  return $this;
}


=item $obj->initialize ($config_file)

Performs some initialization on the module.

Parameter: the location of a configuration file

Returns: nothing

=cut

sub initialize
{
  my $self = shift;

  # initialize cache--caching is ON by default
  $self->{doCache} = 1;
  $self->{simCache} = ();
  $self->{traceCache} = ();
  $self->{cacheQ} = ();

  # (JM - 11/26/03)
  # Using unlimited cache can cause simCache and esp. traceCache
  # to use huge amounts of memory if a lot of queries are performed.
  # $self->{maxCacheSize} = UNLIMITED_CACHE;

  $self->{maxCacheSize} = DEFAULT_CACHE;

  # initialize tracing--tracing is OFF by default
  $self->{trace} = 0;

  # JM 1/26/04
  # moved option for root node to PathFinder.pm
  #
  # use a virtual root node (if applicable)
  #  six of the measures (res, lin, jcn, path, wup, lch) use a virtual
  #  root node in some way, and it is present by default in these cases.
  #  Three of the measures--path, wup, and lch--allow this root node to be
  #  turned off (i.e., the measure would be run without a root node).
  # $self->{rootNode} = 1;

  return $self->configure (@_);
}


=item $obj->configure($config_file)

Parses a configuration file.

If you write a module and want to add a new configuration option, you
can use the addConfigOption function to specify the name and nature
of the option.

The value of the option is place in "self": $self->{optionname}.

parameter: a file name

returns: true if parsing of config file was successful, false on error

=cut

sub configure
{
  my $self = shift;
  my $file = shift;
  my $class = ref $self || $self;

  while (my ($opt, $classHash) = each %config_options) {
      while (my ($class, $arrayRef) = each %$classHash) {
	  if ($self->isa ($class)) {
	      $self->{$opt} = $arrayRef->[2];
	  }
      }
  }
  return unless defined $file;

#  my %options = %config_options;
#  foreach my $optionstr (@options) {
#    next unless $optionstr;
#    my $patternstr = '^(\w+)([=:])([ifps])$';
#    unless ($optionstr =~ m/$patternstr/o) {
#      $self->{errorString} .= "\nWarning (${class}::configure) - ";
#      $self->{errorString} .= "Bad option string $optionstr: option strings";
#      $self->{errorString} .= " must match the pattern ${patternstr}.";
#      $self->{error} = ($self->{error} > 1) ? $self->{error} : 1;
#    }
#    $options{$1} = [$2, $3];
#  }

  unless (open CF, $file) {
    my $class = ref $self || $self;
    $self->{errorString} .= "\nError (${class}::configure) - ";
    $self->{errorString} .= "Unable to open config file $file.";
    $self->{error} = 2;
    return undef;
  }

  $_ = ;
  unless (m/^$class/) {
    close CF;
    my $class = ref $self || $self;
    $self->{errorString} .= "\nError (${class}::configure()) - ";
    $self->{errorString} .= "$file does not appear to be a config file for $class.";
    $self->{error} = 2;
    return undef;
  }

  # keep track of which options we've already seen
  my %optionCache;

  my %rtn;
 OPTION_READ:
  while () {
    s/\s+|\#.*//g; # ignore comments

    # JM 12/4/03 (#3)
    # edited the below to
    #  (1) ensure the values for options are valid
    #  (2) handle options without values in a consistent manner

    if ($_ eq "") {
      next;
    }

    # JM 1/9/04 (#1)
    # added the following block to check for repeated options
    my ($option, $value) = m/^(\w+)::(.*)$/;
    if ($option) {
      unless (defined $optionCache{$option}) {
	$optionCache{$option} = defined $value ? $value : 1;
      }
      else {
	# we've already seen this option
	$self->{errorString} .= "\nWarning (${class}::configure()) - ";
	$self->{errorString} .= "configuration option '$option' encountered twice in config file";
	$self->{error} = ($self->{error} > 1) ? $self->{error} : 1;
      }
    }

    if (m/^trace::(.*)/i) {
      my $trace = $1;

      # JM 12/4/03 (#3)
      # $self->{trace} = 1;
      # $self->{trace} = $trace if $trace =~ m/^[012]$/;

      next OPTION_READ if $trace eq "";
      if ($trace =~ m/^[012]$/) {
	$self->{trace} = $trace;
      }
      else {
	$self->{errorString} .= "\nWarning (${class}::configure()) - ";
	$self->{errorString} .= "$trace is an invalid value for option trace.";
	$self->{error} = ($self->{error} > 1) ? $self->{error} : 1;
      }
    }
    elsif (m/^cache::(.*)/i) {
      my $cache = $1;

      # JM 12/4/03 (#3)
      # $self->{doCache} = 1;
      # $self->{doCache} = $cache if $cache =~ m/^[01]$/;

      next OPTION_READ if $cache eq "";
      if ($cache =~ m/^[01]$/) {
	$self->{doCache} = $cache;
      }
      else {
	$self->{errorString} .= "\nWarning (${class}::configure()) - ";
	$self->{errorString} .= "$cache is an invalid value for option cache.";
	$self->{error} = ($self->{error} > 1) ? $self->{error} : 1;
      }
    }
    elsif (m/^maxCacheSize::(.*)/i) {
      my $mcs = $1;

      # JM 12/4/03 (#3)
      # $self->{maxCacheSize} = DEFAULT_CACHE;
      # if ($mcs =~ /unlimited/i) {
      #   $self->{maxCacheSize} = UNLIMITED_CACHE;
      #   next;
      # }
      # $self->{maxCacheSize} = $mcs if defined ($mcs) and $mcs =~ m/^\d+$/;

      next OPTION_READ if $mcs eq "";
      if ($mcs =~ m/^unlimited/i) {
	$self->{maxCacheSize} = UNLIMITED_CACHE;
      }
      elsif ($mcs =~ m/^\d+$/) {
	$self->{maxCacheSize} = $mcs + 0;
      }
      else {
	$self->{errorString} .= "\nWarning (${class}::configure()) - ";
	$self->{errorString} .= "$mcs is an invalid value for option maxCacheSize.";
	$self->{error} = ($self->{error} > 1) ? $self->{error} : 1;
      }
    }
    # JM 1/26/04
    # moved code for the rootNode option to PathFinder.pm
    else {
OPTION_LOOP:
      foreach my $option (keys %config_options) {
	  my $found = 0;
CLASS_LOOP:
	  foreach my $class (keys %{$config_options{$option}}) {
	      if ($self->isa ($class)
		  and defined $config_options{$option}->{$class}) {
		  $found = $class;
		  last CLASS_LOOP;
	      }
	  }
	  next OPTION_LOOP unless $found;

	  if (not defined $config_options{$option}->{$found}) {
	      print STDERR "$option $class\n";
	  }
	  my ($required, $type, $dflt)= @{$config_options{$option}->{$found}};


	if (m/^${option}::(.*)$/i) {
	  my $t = $1;
	  if ($t =~ m/^\s*$/) {
	    if ($required) {
	      #error
	      $self->{errorString} .= "\nWarning (${class}::configure()) - ";
	      $self->{errorString} .= "Option $option has no value.";
	      $self->{error} .= $self->{error} > 1 ? $self->{error} : 1;
	    }
	    else {
	      # do nothing
	      $self->{$option} = $dflt
	    }
	  }
	  else {
	    if ($type eq 'i') {
	      # JM 12/4/03 (#3)
	      # $self->{$option} = int ($t);
	      if ($t =~ m/^\d+$/) {
		$self->{$option} = $t + 0;
	      }
	      else {
		$self->{errorString} .= "\nWarning (${class}::configure()) - ";
		$self->{errorString} .=
		  "$t is an invalid value for option $option.";
		$self->{error} = ($self->{error} > 1) ? $self->{error} : 1;
	      }
	    }
	    elsif ($type eq 'f') {
	      # JM 12/4/03 (#3)

	      # check if this is a float
	      if ($t =~ /^[+-]?(?:\d+\.?\d*|\.\d+)(?:e[+-]?\d+)?$/) {
		$self->{$option} = $t + 0.0;
	      }
	      else {
		$self->{errorString} .= "\nWarning (${class}::configure()) - ";
		$self->{errorString} .=
		  "$t is an invalid value for option $option.";
		$self->{error} = ($self->{error} > 1) ? $self->{error} : 1;
	      }
	    }
	    elsif ($type eq 'p') {
	      if (-e $t) {
		$self->{$option} = $t;
	      }
	      else {
		$self->{errorString} .= "\nWarning (${class}::configure()) - ";
		$self->{errorString} .=
		  "$t is not a valid filename for option $option.";
		$self->{error} = ($self->{error} > 1) ? $self->{error} : 1;
	      }
	    }
	    elsif ($type eq 's') {
	      $self->{$option} = $t;
	    }
	    else {
	      $self->{errorString} .= "\nWarning (${class}::configure()) - ";
	      $self->{errorString} .=
		"Unknown/invalid option type $type.\n";
	    }
	  }
	  next OPTION_READ;
	}
      }
      # error
      s/::.*//;
      my $class = ref $self || $self;
      $self->{errorString} .="\nWarning (${class}::configure()) - ";
      $self->{errorString} .= "Ignoring unrecognized option '$_'.";
      $self->{error} = $self->{error} > 1 ? $self->{error} : 1;
    }
  }
  close CF;
  return 1;
}

=item $obj->getTraceString(Z<>)

Returns the current trace string and resets the trace string to empty.  If
tracing is turned off, then an empty string will always be returned.

=cut

sub getTraceString {
  my $self = shift;

  return '' unless $self->{trace} and defined $self->{traceString};
  my $str = $self->{traceString};
  $self->{traceString} = '';
  $str =~ s/\n{2,}$//;
  return $str;
}

=item $obj->getError(Z<>)

Checks to see if any errors have occurred.
Returns a list of the form S<($level, $string)>.  If $level is 0, then
no errors have occurred; if $level is non-zero, then an error has occurred.
A value of 1 is considered a warning, and a value of 2 is considered an
error.  If $level is non-zero, then $string will have a (hopefully)
meaningful error message.

=cut

sub getError {
  my $self = shift;
  my $error = $self->{error};
  my $errorString = $self->{errorString};
  $self->{error} = 0;
  $self->{errorString} = "";
  $errorString =~ s/^[\r\n\t ]+//;
  return ($error, $errorString);
}


=item $obj->traceOptions(Z<>)

Prints module-specific options to the trace string.  Any module that
adds configuration options via addConfigOption should override this
method.

Options should be printed out using the following format:

  $self->{traceString} .= "option_name :: $option_value\n"

Note that the option name is separated from its current value by a
space, two colons, and another space.  The string should be terminated
by a newline.

Since multiple modules may be overriding this method, any module
that overrides this method should insure that the superclass'
method gets called as well.  You do this by putting this line at
the end of your method:

  $self->SUPER::traceOptions();

returns: nothing

=cut

# JM 12/5/03 (#1)
sub traceOptions {
  # nothing to do here, this is a just a placeholder
  # subclasses should override this to print all config options to
  # the traceString
}


=item $obj->parseWps($synset1, $synset2)

parameters: synset1, synset2

returns: a reference to an array [$word1, $pos1, $sense1, $offset1, $word2,
$pos2, $sense2, $offset2] or undef

This method checks the format of the two input synsets by calling
validateSynset() for each synset.

If the synsets are in wps format, a reference to an array will be returned.
This array has the form [$word1, $pos1, $sense1, $offset1, $word2, $pos2,
$sense2, $offset2] where $word1 is the word part of $wps1, $pos1, is the
part of speech of $wps1, $sense1 is the sense from $wps.  $offset1 is the
offset for $wps1.

If an error occurs (such as a synset being poorly-formed), then undef
is returned, the error level is set to non-zero, and an error message is
appended to the error string.

=cut

sub parseWps
{
  my $self = shift;
  my $wps1 = shift;
  my $wps2 = shift;

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

  # Undefined input cannot go unpunished.
  unless (defined $wps1 and defined $wps2 and length $wps1 and length $wps2) {
    $self->{errorString} .= "\nWarning (${class}::parseWps()) - ";
    $self->{errorString} .= "Variable for input synset ".(length($wps1) ? 2 : 1)." undefined.";
    $self->{error} = ($self->{error} < 1) ? 1 : $self->{error};
    return undef;
  }

  my ($word1, $pos1, $sense1, $offset1) = $self->validateSynset ($wps1);
  my ($word2, $pos2, $sense2, $offset2) = $self->validateSynset ($wps2);

  # Check to see if validation of synsets succeeded, if not, then
  # bail out (error message already set by validateSynset).
  unless (defined $word1 and defined $pos1 and defined $sense1
	  and defined $word2 and defined $pos2 and defined $sense2) {
    return undef;
  }

  return [$word1, $pos1, $sense1, $offset1, $word2, $pos2, $sense2, $offset2];
}


=item $obj->validateSynset($synset)

parameter: synset

returns: a list or undef on error

synset is a string in word#pos#sense format

This method does the following:

=over

=item 1.

Verifies that the synset is well-formed (i.e., that it consists of three
parts separated by #s, the pos is one of {n, v, a, r} and that sense
is a natural number).  A synset that matches the pattern '[^\#]+\#[nvar]\#\d+'
is considered well-formed.

=item 2.

Checks if the synset exists by trying to find the offset for the synset

=back

If any of these tests fails, then the error level is set to non-zero, a
message is appended to the error string, and undef is returned.

If the synset is well-formed and exists, then a list is returned that
has the format ($word, $pos, $sense, $offset).

=cut

sub validateSynset
{
  my $self = shift;
  my $synset = shift;
  my $class = ref $self || $self;

  # check to see that synset is in w#p#s format

  unless (defined ($synset) and length ($synset)) {
    $self->{error} = $self->{error} < 1 ? 1 : $self->{error};
    $self->{errorString} .= "\nWarning (${class}::validateSynset()) - ";
    $self->{errorString} .= "Variable representing synset is undefined (or an empty string).";
    return undef;
  }

  my ($word, $pos, $sense) = split (/\#/, $synset);

  unless (defined $word) {
    $self->{error} = $self->{error} < 1 ? 1 : $self->{error};
    $self->{errorString} .= "\nWarning (${class}::validateSynset()) - ";
    $self->{errorString} .= "Invalid synset ($synset): word undefined.";
    return undef;
  }

  unless (defined $pos) {
    no strict 'vars';
    $self->{error} = $self->{error} < 1 ? 1 : $self->{error};
    $self->{errorString} .= "\nWarning (${class}::validateSynset()) - ";
    $self->{errorString} .= "Invalid synset ($synset): part of speech undefined.";
    return undef;
  }

  unless (defined $sense) {
    $self->{error} = $self->{error} < 1 ? 1 : $self->{error};
    $self->{errorString} .= "\nWarning (${class}::validateSynset()) - ";
    $self->{errorString} .= "Invalid synset ($synset): sense number undefined.";
    return undef;
  }

  # check to make sure the word, pos, and sense are well-formed
  if ($word !~ /^[^\#]+$/) {
    $self->{error} = $self->{error} < 1 ? 1 : $self->{error};
    $self->{errorString} .= "\nWarning (${class}::validateSynset()) - ";
    $self->{errorString} .= "$synset has a poorly-formed word ($word).";
    return undef;
  }
  elsif ($pos !~ /^[nvar]$/) {
    $self->{error} = $self->{error} < 1 ? 1 : $self->{error};
    $self->{errorString} .= "\nWarning (${class}::validateSynset()) - ";
    $self->{errorString} .= "$synset has a bad part of speech ($pos). Part of speech must be one of n, v, a, r.";
    return undef;
  }
  elsif ($sense !~ /^\d+$/) {
    $self->{error} = $self->{error} < 1 ? 1 : $self->{error};
    $self->{errorString} .= "\nWarning (${class}::validateSynset()) - ";
    $self->{errorString} .= "$synset has a bad sense number ($pos). Sense number must be a natural number.";
    return undef;
  }

  # check to see if synset exists
  my $offset = $self->{wn}->offset ($synset);
  unless ($offset) {
    $self->{error} = $self->{error} < 1 ? 1 : $self->{error};
    $self->{errorString} .= "\nWarning (${class}::validateSynset()) - ";
    $self->{errorString} .= "$synset not found in WordNet.";
    return undef;
  }

  return ($word, $pos, $sense, $offset);
}

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

parameters: synset1, synset2

returns: a relatedness score

This is a virtual method. It must be overridden by a module that
is derived from this class. This method takes two synsets and
returns a numeric value as their score of relatedness.

=cut

sub getRelatedness {
  my $self = shift;
  my $class = ref $self || $self;
  $self->{errorString} .= "\nError (${class}::getRelatedness()) - ";
  $self->{errorString} .= "This is a virtual method provided by ";
  $self->{errorString} .= __PACKAGE__ . " that must be overridden.";
  $self->{error} = 2;
  return undef;
}

# Subroutine that takes as input an array of offsets
# or offsets(POS) and for each prints to traceString the
# WORD#POS#(/)
# INPUT PARAMS  : $pos                             .. Part of speech
#               : ($offestpos1, $offsetpos2, ...)  .. Array of offsetPOS's
#                                                     or offests
# RETURN VALUES : none.
sub _printSet
{
  use Carp;
  carp "This method is deprecated; use printSet instead";
  my $self = shift;
  my $pos = shift;
  my $wn = $self->{wn};
  my @offsets = @_;
  my $wps;
  my $opstr = "";

  foreach my $offset (@offsets) {
    $offset =~ m/(\d+)([a-z])?/;
    $offset = $1;
    if($offset) {
      $wps = $wn->getSense($offset, ($2 ? $2 : $pos));
    }
    else {
      $wps = "*Root*\#". ($2 ? $2 : $pos) ."\#1";
    }
    $wps =~ s/ +/_/g;
    if($self->{trace} == 2 && defined $offset && $offset != 0) {
      $wps =~ s/\#[0-9]*$/\#$offset/;
    }
    $opstr .= "$wps ";
  }
  $opstr =~ s/\s+$//;
  $self->{traceString} .= $opstr if($self->{trace});
}


=item $obj->printSet ($pos, $mode, @synsets)

If tracing is turned on, prints the contents of @synsets to the trace string.
The contents of @synsets can be either wps strings or offsets.  If they
are wps strings, then $mode must be the string 'wps'; if they are offsets,
then the mode must be 'offset'.  Please don't try to mix wps and offsets.

Returns the string that was appended to the trace string.

=cut

sub printSet
{
  my $self = shift;
  my $pos = shift;
  my $mode = shift;
  my @synsets = @_;

  my $opstr = '';
  my $wn = $self->{wn};
  my $wps;

  if ($mode eq 'offset') {
    foreach my $offset (@synsets) {
      $offset =~ m/^(\d+)([a-z])?/;
      $offset = $1;
      if ($offset) {
	$wps = $wn->getSense ($offset, (defined $2 ? $2 : $pos));
      }
      else {
	$wps = "*Root*\#" . (defined $2 ? $2 : $pos) . "\#1";
      }
      $wps =~ tr/ /_/;
      if ($self->{trace} == 2 && defined $offset) {
	$wps =~ s/\#[0-9]+$/\#$offset/;
      }
      $opstr .= "$wps ";
    }
  }
  elsif ($mode eq 'wps') {
  WPS:
    foreach my $wps (@synsets) {
      unless ($self->{trace} == 2) {
	$opstr .= "$wps ";
	next WPS;
      }
      my $offset = scalar ($wps =~ /\*Root\*/i) ? 0 : $wn->offset ($wps);
      my ($word, $p) = $wps =~ /^(\S+)\#([nvar])\#\d+$/;
      $opstr .= "$word#$p#$offset ";
    }
  }
  $opstr =~ s/\s+$//;
  $self->{traceString} .= $opstr if $self->{trace};
  return $opstr;
}


# you should only call this if $self->{doCache} is true
# nothing bad will happen if you call anyways, but it will slow things down
#
# NEW!  You can specify whether or not relatedness is symmetric: if
# relatedness (c1, c2) = relatedness (c2, c1), then relatedness is symmetric.

=item $obj->fetchFromCache($wps1, $wps2, $non_symmetric)

Looks for the relatedness value of ($wps1, $wps2) in the cache.  If
$non_symmetric is false (or isn't specified), then the cache is searched
for ($wps2, $wps1) if ($wps1, $wps2) isn't found.

Returns: a relatedness value or undef if none found in the cache.

=cut

sub fetchFromCache
{
  my $self = shift;
  my ($wps1, $wps2, $non_symmetric) = @_;

  $self->{doCache} or return undef;

  $non_symmetric = 0 unless defined $non_symmetric;

  if (defined $self->{simCache}->{"${wps1}::$wps2"}) {
    if ($self->{traceCache}->{"${wps1}::$wps2"}) {
      $self->{traceString} .= $self->{traceCache}->{"${wps1}::$wps2"};
    }
    return $self->{simCache}->{"${wps1}::$wps2"};
  }
  elsif (!$non_symmetric and defined $self->{simCache}->{"${wps2}::$wps1"}) {
    if ($self->{traceCache}->{"${wps2}::$wps1"}) {
      $self->{traceString} .= $self->{traceCache}->{"${wps2}::$wps1"};
    }
    return $self->{simCache}->{"${wps2}::$wps1"};
  }
  return undef;
}

=item $obj->storeToCache ($wps1, $wps2, $score)

Stores the relatedness value, $score, of ($wps1, $wps2) to the cache.

Returns: nothing

=cut

sub storeToCache
{
  my $self = shift;
  my ($wps1, $wps2, $score) = @_;

  $self->{doCache} or return;

  $self->{simCache}->{"${wps1}::$wps2"} = $score;
  if ($self->{trace}) {
    $self->{traceCache}->{"${wps1}::$wps2"} = $self->{traceString}
  }
  push (@{$self->{cacheQ}}, "${wps1}::$wps2");
  if (($self->{maxCacheSize} >= 0)
      and ($self->{maxCacheSize} != UNLIMITED_CACHE)) {
    while (scalar (@{$self->{cacheQ}}) > $self->{maxCacheSize}) {
      my $delItem = shift(@{$self->{cacheQ}});
      delete $self->{simCache}->{$delItem};
      delete $self->{traceCache}->{$delItem};
    }
  }
}


1;

__END__