WordNet::Similarity::GlossFinder - module to implement gloss finding methods

  use WordNet::QueryData;
  my $wn = WordNet::QueryData->new;
  defined $wn or die "Construction of WordNet::QueryData failed";

  use WordNet::Similarity::GlossFinder;
  my $obj = WordNet::Similarity::GlossFinder->new ($wn);
  my ($err, $errString) = $obj->getError ();
  $err and die $errString;

  my $wps1 = 'england#n#1';
  my $wps2 = 'winston_churchill#n#1';

  # get the glosses of these two synsets, since we are not using a 
  # configuation file to specify relations, we will only get the 
  # immediate glosses of the two wps entries. The default weight and
  # relation appear in $weight and $relation - these can be modified
  # via a configuration file. 

  my ($wps1gloss, $wps2gloss, $weight, $relation ) = $obj -> getSuperGlosses ($wps1, $wps2);
  print "$wps1gloss->[0]\n";
  print "$wps2gloss->[0]\n";
  print "$weight->[0]\n";
  print "$relation->[0]\n";

 Ted Pedersen, University of Minnesota Duluth
 tpederse at d.umn.edu

 Siddharth Patwardhan, University of Utah, Salt Lake City
 sidd at cs.utah.edu

    The Free Software Foundation, Inc.,
    59 Temple Place - Suite 330,
    Boston, MA  02111-1307, USA.

# WordNet::Similarity::GlossFinder version 2.04
# (Last updated $Id: GlossFinder.pm,v 1.13 2008/03/27 06:21:17 sidz1979 Exp $)
#
# Module containing gloss-finding code for the various measures of semantic
# relatedness (lesk, vector).
#
# 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
#
# 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::GlossFinder;

use strict;
use warnings;
use WordNet::Similarity;
use File::Spec;
use WordNet::get_wn_info;

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

our $VERSION = '2.04';

WordNet::Similarity::addConfigOption("relation", 0, "p", undef);
WordNet::Similarity::addConfigOption("stop", 0, "p", undef);
WordNet::Similarity::addConfigOption("stem", 0, "i", 0);

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

sub traceOptions
{
    my $self = shift;
    $self->{traceString} .= "relation file :: ".((defined $self->{relation}) ? ($self->{relation}) : "")."\n";
    $self->{traceString} .= "stopwords file :: ".((defined $self->{stop}) ? ($self->{stop}) : "")."\n";
    $self->{traceString} .= "stem :: ".((defined $self->{stem}) ? ($self->{stem}) : "")."\n";
    $self->SUPER::traceOptions();
}

sub configure
{
    my $self = shift;
    my $class = ref $self || $self;
    my %stopHash;
    my $gwi;

    # Call the configure method in parent (WordNet::Similarity)
    $self->SUPER::configure(@_);
    $self->{maxCache} = 5000;
    
    # Initialize the stop list.
    $self->{stopHash} = {};
    my $wn = $self->{wn};
    
    # Use default relation file if specified by module...
    $self->{relation} = $self->{relationDefault}
    if(!($self->{relation}) && defined $self->{relationDefault} && $self->{relationDefault} ne ""); 

    # Load the stop list.
    if(defined $self->{stop})
    {
	my $line;
        my $stopFile = $self->{stop};

	if(open(STOP, $stopFile))
	{
	    while($line = <STOP>)
	    {
		$line =~ s/[\r\f\n]//g;
		$line =~ s/^\s+//;
		$line =~ s/\s+$//;
		$line =~ s/\s+/_/g;
                $stopHash{$line} = 1;
		$self->{stopHash}->{$line} = 1;
	    }
	    close(STOP);
	}
	else
	{
	    $self->{errorString} .= "\nWarning ($class->configure()) - ";
	    $self->{errorString} .= "Unable to open $stopFile.";
	    $self->{error} = 1 if($self->{error} < 1);
	}
    }

    # so now we are ready to initialize the get_wn_info package with
    # the wordnet object, 0/1 depending on if stemming is required and
    # the stop hash
    if($self->{stem})
    {
	$gwi = WordNet::get_wn_info->new($wn, 1, %stopHash);
	$self->{gwi} = $gwi;
    }
    else
    {
	$gwi = WordNet::get_wn_info->new($wn, 0, %stopHash);
	$self->{gwi} = $gwi;
    }

    # Load the relations
    $self->_loadRelationFile();

    # Initialize traces for relations...
    $self->{relationTraces} = [];
    my $i = 0;
    while(defined $self->{functions}->[$i])
    {
	my $functionsString = "";
        my $weight = $self->{weights}->[$i];
	
	# see if any traces reqd. if so, create the functions string
	# however don't send it to the trace string immediately - will
	# print it only if there are any overlaps for this rel pair
        $functionsString = "Functions: ";
        my $j = 0;
        while(defined $self->{functions}->[$i]->[0]->[$j])
        {
            $functionsString .= ($self->{functions}->[$i]->[0]->[$j])." ";
            $j++;
        }

        $functionsString .= "- ";
        $j = 0;
        while(defined $self->{functions}->[$i]->[1]->[$j])
        {
            $functionsString .= ($self->{functions}->[$i]->[1]->[$j])." ";
            $j++;
        }
        push(@{$self->{relationTraces}}, $functionsString);
        $i++;
    }
}

sub getSuperGlosses
{
    my $self = shift;
    my $wps1 = shift;
    my $wps2 = shift;
    my $class = ref $self || $self;
    my $rArray = [];
    my $gwi = $self->{gwi};

    # NOTE: Thanks to Wybo Wiersma for providing the following (faster)
    #       super-gloss code.

    # check if the supergloss of the left word is in the cache.
    # If it is not, add it.
    if(!defined($self->{cache}->[0]->{$wps1}))
    {
        push(@{$self->{cachelist}->[0]}, $wps1);

        # Remove the oldest cache-entry if there's no more room
        if(scalar(@{$self->{cachelist}->[0]}) > $self->{maxCache})
        {
            my $todel = shift(@{$self->{cachelist}->[0]});
            delete ($self->{cache}->[0]->{$todel});
        }
        
        $self->{cache}->[0]->{$wps1} = $self->_getSuperGlosses($wps1, $gwi, 0);
    }
    
    # check if the supergloss of the right word is in the cache.
    # If it is not, add it.
    if(!defined($self->{cache}->[1]->{$wps2}))
    {
        push(@{$self->{cachelist}->[1]}, $wps2);

        # Remove the oldest cache-entry if there's no more room
        if(scalar(@{$self->{cachelist}->[1]}) > $self->{maxCache})
        {
            my $todel = shift(@{$self->{cachelist}->[1]});
            delete ($self->{cache}->[1]->{$todel});
        }
        
        $self->{cache}->[1]->{$wps2} = $self->_getSuperGlosses($wps2, $gwi, 1);
    }
    
    return ($self->{cache}->[0]->{$wps1}, $self->{cache}->[1]->{$wps2}, $self->{weights}, $self->{relationTraces});
}

sub _getSuperGlosses()
{
    my $self = shift;
    my ($wps, $gwi, $zron) = @_;
    my @stringArray;

    # and now go thru the functions array, get the strings
    my $i = 0;
    while(defined $self->{functions}->[$i])
    {
	# now get the string for the first set of synsets
        my %seth = ();
        $seth{$wps} = 1;
	my @arguments = \%seth;
	
	# apply the functions to the arguments, passing the output of
	# the inner functions to the inputs of the outer ones
	my $j = 0;
	while(defined $self->{functions}->[$i]->[$zron]->[$j])
	{
	    my $fn = $self->{functions}->[$i]->[$zron]->[$j];
	    @arguments = $gwi->$fn(@arguments);
	    $j++;
	}
	
	# finally we should have one cute little string!
        push(@stringArray, $arguments[0]);
	$i++;
    }

    return \@stringArray;
}

sub _loadRelationFile
{
    my $self = shift;
    my $class = ref $self || $self;
    my $gwi = $self->{gwi};

    if($self->{relation})
    {
	my $header;
	my $relation;

	if(open (RELATIONS, $self->{relation}))
        {
	    $header = <RELATIONS>;
	    $header =~ s/[\r\f\n]//g;
	    $header =~ s/\s+//g;
	    if(defined $header && $header =~ /RelationFile/)
            {
		my $index = 0;
		$self->{functions} = ();
		$self->{weights} = ();
		while($relation = <RELATIONS>) 
                {
		    $relation =~ s/[\r\f\n]//g;
		    
		    # now for each line in the file, extract the
		    # nested functions if any, check if they are defined,
		    # if it makes sense to nest them, and then finally put
		    # them into the @functions triple dimensioned array!
		    
		    # remove leading/trailing spaces from the relation
		    $relation =~ s/^\s*(\S*?)\s*$/$1/;

                    next if($relation =~ /^$/);
		    
		    # now extract the weight if any. if no weight, assume 1
		    if($relation =~ /(\S+)\s+(\S+)/)
		    {
			$relation = $1;
			$self->{weights}->[$index] = $2;
		    }
		    else
		    {
			$self->{weights}->[$index] = 1;
		    }

		    # check if we have a "proper" relation, that is a relation in
		    # there are two blocks of functions!
		    if($relation !~ /(.*)-(.*)/)
                    {
			$self->{errorString} .= "\nError (${class}::_loadRelationFile()) - ";
			$self->{errorString} .= "Bad file format ($self->{relation}).";
			$self->{error} = 2;
			close RELATIONS;
			return;		
		    }
		    
		    # get the two parts of the relation pair
		    my @twoParts;
		    my $l;
		    $twoParts[0] = $1;
		    $twoParts[1] = $2;
		    
		    # process the two parts and put into functions array
		    for($l = 0; $l < 2; $l++)
		    {
			#no strict 'subs';
			
			$twoParts[$l] =~ s/[\s\)]//g;
			my @functionArray = split(/\(/, $twoParts[$l]);
			
			my $j = 0;
			my $fn = $functionArray[$#functionArray];
			unless($gwi->can($fn))
                        {
			    $self->{errorString} .= "\nError (${class}::_loadRelationFile()) - ";
			    $self->{errorString} .= "Undefined function ($functionArray[$#functionArray]) in relations file.";
			    $self->{error} = 2;
			    close RELATIONS;
			    return;
			}
			
			$self->{functions}->[$index]->[$l]->[$j++] = $functionArray[$#functionArray];
			my $input;
			my $output;
			my $dummy;
			my $k;
			
			for ($k = $#functionArray-1; $k >= 0; $k--)
			{
			    my $fn2 = $functionArray[$k];
			    my $fn3 = $functionArray[$k+1];
			    if(!($gwi->can($fn2)))
			    {
				$self->{errorString} .= "\nError (${class}::_loadRelationFile()) - ";
				$self->{errorString} .= "Undefined function ($functionArray[$k]) in relations file.";
				$self->{error} = 2;
				close(RELATIONS);
				return;
			    }
			    
			    ($input, $dummy) = $gwi->$fn2($dummy, 1);
			    ($dummy, $output) = $gwi->$fn3($dummy, 1);
			    
                            if($input != $output)
                            {
                                $self->{errorString} .= "\nError (${class}::_loadRelationFile()) - ";
                                $self->{errorString} .= "Invalid function combination - $functionArray[$k]($functionArray[$k+1]).";
                                $self->{error} = 2;
                                close(RELATIONS);
                                return;
                            }
			    
			    $self->{functions}->[$index]->[$l]->[$j++] = $functionArray[$k];
			}
			
			# if the output of the outermost function is synset array (1)
			# wrap a glos around it
			my $xfn = $functionArray[0];
			($dummy, $output) = $gwi->$xfn($dummy, 1);
			if($output == 1)
			{
			    $self->{functions}->[$index]->[$l]->[$j++] = "glos";
			}
		    }
		    
		    $index++;
		}
	    }
	    else
	    {
		$self->{errorString} .= "\nError (${class}::_loadRelationFile()) - ";
		$self->{errorString} .= "Bad file format ($self->{relation}).";
		$self->{error} = 2;
		close(RELATIONS);
		return;		
	    }
	    close(RELATIONS);
	}
	else
	{
	    $self->{errorString} .= "\nError (${class}::_loadRelationFile()) - ";
	    $self->{errorString} .= "Unable to open $self->{relation}.";
	    $self->{error} = 2;
	    return;
	}
    }
    else
    {
	$self->{weights}->[0] = 1;
	$self->{functions}->[0]->[0]->[0] = "glosexample";
	$self->{functions}->[0]->[1]->[0] = "glosexample";
	return;
    }
}

1;

__END__