#!/usr/bin/perl

=head1 NAME

WordQuery.pm - provides a high-level and user-friendly interface for determining relationships between tokens in WordNet

=head1 SYNOPSIS
 
WordQuery.pm provides a high-level and user-friendly interface for querying items in WordNet.  It is built on top of WordNet::QueryData which provides lower level access to WordNet.  WordQuery accepts fully (term#pos#number), partially (term#pos), or unqualified terms (term) and automatically compares all possible senses of each word in a query.  WordQuery tests for synonym, antonym, and hypernym relationships.  See Usage for more information.


=head1 USAGE

Usage: WordQuery.pm

WordQuery.pm should be initialized to increase query speed.  Following initialization several functions may be called.  The functionality is highlighted below.  For all functions input words may be fully qualified (<term>#<pos>#<number>), partially (<term>#<pos>), or unqualified (<term>).  All possible senses are found and used in comparisons.  This allows for functions to be used with raw text, part of speech (POS) tagged text, or disambiguated text.  If a term is not in WordNet, false is returned


----  Initialization:
    WordQuery should first be initialized to increase query speed
    use WordQuery;
    my $wq = WordQuery->new();  #initialize WordQuery


----  isSynonym
    Description:
         Determines if two words are synonyms
    Usage:
         [1,2,3] = #wq->isAntonym($wordA, $wordB);
    Input: 
         $wordA, $wordB = the two words to compare
    Optional Input: 
         $directOnly = 1 if only direct synonyms should be checked
    Returns: 
         0 if not a synonym
         1 if a direct synonym
         2 is an indirect synonym
    Example:
         my $wq = WordQuery->new();  #initialize WordQuery
         my $result = $wq->isSynonym('warm', 'sweltering');     #returns true
         $result = $wq->isSynonym('warm', 'sweltering', 1);     #returns false
         $result = $wq->isSynonym('sweltering', 'hot', 1);      #returns true
         $result = $wq->isSynonym('sweltering#a', 'hot#a#1');   #returns true


----  isAntonym
    Description:
         Determines if two things are antonyms
    Usage:
         [1,2,3] = $wq->isAntonym($wordA, $wordB);
    Input: 
        $wordA, $wordB  = the two words to compare
    Optional input: 
        $directOnly = 1 if only direct synonyms should be checked
    Returns: 
        0 if not a antonym
        1 if a direct antonym
        2 is an indirect antonym
    Examples:
          my $wq = WordQuery->new();  #initialize WordQuery
          my $result = $wq->isAntonym('hot', 'frozen');     #returns true
          $result = $wq->isAntonym('hot#a#1', 'frozen#a');  #returns true
          $result = $wq->isAntonym('warm', 'frozen', 1);    #returns false
          $result = $wq->isAntonym('hot', 'frozen', 1);     #returns true


-----  isA
     Description:
          Takes a noun and determines if at some point in the WordNet 
          hierarchy it is categorized as the hypernym
     Usage:
          [1,0] = $wq->isA($word, $category);
     Input: 
         $word = the word to check an isA relationship of.  The string is not  
             required to be a noun, however only noun senses will be checked
         $category = the fully specified WordNet category (hypernym)
     Returns:
          1 if $word isA $category, 0 otherwise
     Examples:
          my $wq = WordQuery->new();  #initialize WordQuery
          my $result = $wq->isA('train', 'transport#n#1');  #returns true
          $result = $wq->isA('train#n', 'transport#n#1');   #returns true
          $result = $wq->isA('train#n#1', 'transport#n#1'); #returns true
          $result = $wq->isA('train#v', 'transport#n#1');   #returns false



----  isHypernym:
     Description:
          Determines if the two words are hypernyms.  If the word sense is not 
          fully specified all possible senses will be checked. 
          Note, this checks all senses of a word but not indirect or 
          direct synonyms
     Usage:
          [1,0] = $wq->isHypernym($word1, $word2);
     Input:
          $wordA, $wordB = the two words to check for hypernymy. 
          (e.g. $wordA isA $wordB)
     Returns:
          1 if the words are hypernyms of one another, 0 otherwise
     Examples:
          my $wq = WordQuery->new();  #initialize WordQuery
          my $result = $wq->isHypernym('train', 'transport');    #returns true
          $result = $wq->isHypernym('train#v', 'transport');     #returns false
          $result = $wq->isHypernym('train#v#1', 'transport#n'); #returns false
          $result = $wq->isHypernym('train#v', 'transport#n#1'); #returns false   


----  inWordNet:
     Description:
         Determines if any sense of the  word is in WordNet
     Usage:
         [1,0] = $wq->inWordNet($word);
     Input:
         $word = the word to test if it is in WordNet
     Returns:
         1 if the any sense of the word is in WordNet, 0 otherwise
     Examples:
          my $wq = WordQuery->new();  #initialize WordQuery
          my $result = $wq->inWordNet('hot');    #returns true 
          $result = $wq->inWordNet('hot#a');     #returns true 
          $result = $wq->inWordNet('hot#a#1');   #returns true 
          $result = $wq->inWordNet('hot#v');     #returns false
          $result = $wq->inWordNet('braff');     #returns false

=head1 INPUT

See usage for input of specific functions

=head1 Optional Arguments:

See Usage for optional arguments of specific functions

=head2 --<option>

See Usage for options of specific functions

=head2 --version

version 1.0

=head2 --help

See Usage help with specific functions

=head1 OUTPUT

See Usage for the output of specific functions

=head1 SYSTEM REQUIREMENTS

=over

=item * Perl (version 5.8.5 or better) - http://www.perl.org

=item * WordNet (version 3.0) - https://wordnet.princeton.edu/

=item * WordNet::QueryData (version 1.410 or better) - http://search.cpan.org/~jrennie/WordNet-QueryData/

=back

=head1 CONTACT US

    If you have trouble installing and excecuting WordQuery.pm 
    please contact us at: 

    henryst at vcu dot edu

=head1 Author

 Sam Henry, Virginia Commonwealth University

=head1 COPYRIGHT

Copyright (c) 2015

 Sam Henry, Virginia Commonwealth University
 henryst  at vcu dot 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.          
  
=cut

##########################################################################

                        #   CODE STARTS HERE
                        #   Public Functions

##########################################################################

package WordQuery;
use base "Exporter";
#@EXPORT = qw(new, isA, isHypernym, isSynonym, isAntonym, inWordNet);
@EXPORT = qw(new);
use WordNet::QueryData 1.410;

my $wn;

#Creates a new wordQuery by initializing WordNet::QueryData and other instance variables
sub new
{
    my $class = shift;
    $wn = WordNet::QueryData->new();
    return bless { }, $class;
}


=comment
     Description:
          Takes a noun and determines if at some point in the WordNet 
          hierarchy it is categorized as the hypernym
     Usage:
          [1,0] = $wq->isA($word, $category);
     Input: 
         $word = the word to check an isA relationship of.  The string is not  
             required to be a noun, however only noun senses will be checked
         $category = the fully specified WordNet category (hypernym)
     Returns:
          1 if $word isA $category, 0 otherwise
     Examples:
          my $wq = WordQuery->new();  #initialize WordQuery
          my $result = $wq->isA('train', 'transport#n#1');   #returns true
          $result = $wq->isA('train#n', 'transport#n#1');    #returns true
          $result = $wq->isA('train#n#1', 'transport#n#1');  #returns true
          $result = $wq->isA('train#v', 'transport#n#1');    #returns false
=cut
sub isA()
{
    #grab the input
    my $self = shift;
    my $word = shift;
    my $category = shift;

    #return false for empty words and categories
    if ($word eq "" || $category eq "") {
	return 0;
    }

    #make sure the work is not all white space
    if ($word !~ /\S+/) {
	return 0;
    }

    #check all senses of the word
    my @senses = $self->getSenses($word);
    foreach my $sense(@senses) {
	#make sure the sense is a noun
	if ($sense =~ m/\w*#n/) {
	    my @hypernyms = $wn->querySense($sense, "hypes");

	    #check the direct hypernyms (and their synset words) to see if 
	    #   they are hypernyms
	    foreach my $hypernym(@hypernyms) {
		my @synset = $wn->querySense($hypernym, "syns");
		foreach my $categoryWord(@synset) {
		    if ($categoryWord eq $category) {
			return 1;
		    }
		    elsif($categoryWord eq "entity#n#1") {
			return 0;
		    }
		}
	    }

	    #check the hypernyms of the hypernym
	    foreach my $hypernym(@hypernyms) {
		if ($self->isA($hypernym, $category)) {
		    return 1;
		}
	    }
	}
    }

    #failed tests
    return 0;
}



=comment
     Description:
          Takes a noun and determines if at some point in the WordNet hierarchy 
          it is categorized as the hypernym
     Usage:
          [1,0] = $wq->isA($word, $category);
     Input: 
         $word = the word to check an isA relationship of.  The string is not  
             required to be a noun, however only noun senses will be checked
         $category = the fully specified WordNet category (hypernym)
     Returns:
          1 if $word isA $category, 0 otherwise
     Examples:
          my $wq = WordQuery->new();  #initialize WordQuery
          my $result = $wq->isA('train', 'transport#n#1');   #returns true
          $result = $wq->isA('train#n', 'transport#n#1');    #returns true
          $result = $wq->isA('train#n#1', 'transport#n#1');  #returns true
          $result = $wq->isA('train#v', 'transport#n#1');    #returns false 
      Description:
          Determines if the two words are hypernyms.  If the word sense is 
          not fully specified all possible senses will be checked. 
          Note, this checks all senses of a word but not indirect or direct 
          synonyms
     Usage:
          [1,0] = $wq->isHypernym($word1, $word2);
     Input:
          $wordA, $wordB = the two words to check for hypernymy. 
          (e.g. $wordA isA $wordB)
     Returns:
          1 if the words are hypernyms of one another, 0 otherwise
     Examples:
          my $wq = WordQuery->new();  #initialize WordQuery
          my $result = $wq->isHypernym('train', 'transport');    #returns true
          $result = $wq->isHypernym('train#v', 'transport');     #returns false
          $result = $wq->isHypernym('train#v#1', 'transport#n'); #returns false
          $result = $wq->isHypernym('train#v', 'transport#n#1'); #returns false   
=cut
sub isHypernym
{
    #grab input and senses
    my $self = shift;
    my $wordA = shift;
    my $wordB = shift;

    #get the senses of the word
    my @sensesA = $self->getSenses($wordA);
    my @sensesB = $self->getSenses($wordB);

    #compare each sense to each other
    foreach my $senseA(@sensesA) {
	foreach my $senseB(@sensesB) {
	    if ($self->isA($senseA, $senseB)) {
		return 1;
	    }
	}
    }

    #all tests failed, return false
    return 0;
}



=comment
    Description:
         Determines if two words are synonyms
    Usage:
         [1,2,3] = #wq->isAntonym($wordA, $wordB);
    Input: 
         $wordA, $wordB = the two words to compare
    Optional Input: 
         $directOnly = 1 if only direct synonyms should be checked
    Returns: 
         0 if not a synonym
         1 if a direct synonym
         2 is an indirect synonym
    Example:
         my $wq = WordQuery->new();  #initialize WordQuery
         my $result = $wq->isSynonym('warm', 'sweltering');    #returns true
         $result = $wq->isSynonym('warm', 'sweltering', 1);    #returns false
         $result = $wq->isSynonym('sweltering', 'hot', 1);     #returns true
         $result = $wq->isSynonym('sweltering#a', 'hot#a#1');  #returns true
=cut
sub isSynonym
{
    #grab input
    my $self = shift;
    my $wordA = shift;
    my $wordB = shift;
    my $directOnly = shift;

    #quick test to see if the words are the same
    if ($wordA eq $wordB) {
	return 1;
    }

    #get senses of the words
    my @sensesA = $self->getSenses($wordA);
    my @sensesB = $self->getSenses($wordB);

    #determine if the words are direct synonyms
    #build a list of direct A synonyms
    my @simA = ();
    foreach my $senseA(@sensesA) {
	push (@simA, $self->getDirectSynonyms($senseA));
    }
    @simA = $self->removeDuplicates(@simA);

    #build a list of direct B synonyms
    my @simB = ();
    foreach my $senseB(@sensesB) {
	push (@simB, $self->getDirectSynonyms($senseB));
    }
    @simB = $self->removeDuplicates(@simB);

    #see if the lists overlap
    foreach my $senseA(@simA) {
	foreach my $senseB(@simB) {
	    if ($senseA eq $senseB) { 
		return 1;  #A and B overlap and are therefore direct synonyms
	    }
	}
    }

    #all direct synonyms have been checked
    if (not $directOnly) {
        #get all words similar to A
	foreach my $senseA(@sensesA) { 
	    #get all similar words for this sense
	    push(@simA, $self->getIndirectSynonyms($senseA));
	}
	@simA = $self->removeDuplicates(@simA);

       #get all words similar to B
	foreach my $senseB(@sensesB) { 
	    #get all similar words for this sense
	    push(@simB, $self->getIndirectSynonyms($senseB));
	}
	@simB = $self->removeDuplicates(@simB);

        #see if simA and simB overlap
	foreach my $senseA(@simA) {
	    foreach my $senseB(@simB) {
		if ($senseA eq $senseB) {
		    return 2; #A+B overlap and are therefore indirect synonyms
		}
	    }
	}
    }

    #all tests complete, words are not similar
    return 0;
}


=comment
    Description:
         Determines if two things are antonyms
    Usage:
         [1,2,3] = $wq->isAntonym($wordA, $wordB);
    Input: 
        $wordA, $wordB  = the two words to compare
    Optional input: 
        $directOnly = 1 if only direct synonyms should be checked
    Returns: 
        0 if not a antonym
        1 if a direct antonym
        2 is an indirect antonym
    Examples:
          my $wq = WordQuery->new();  #initialize WordQuery
          my result = $wq->isAntonym('hot', 'frozen');     #returns true
          $result = $wq->isAntonym('hota#1', 'frozen#a');  #returns true
          $result = $wq->isAntonym('warm', 'frozen', 1);   #returns false
          $result = $wq->isAntonym('hot', 'frozen', 1);    #returns true
=cut
sub isAntonym
{
    #grab input
    my $self = shift;
    my $wordA = shift;
    my $wordB = shift;
    my $directOnly = shift;

    #quick test to see if the words are the same
    if ($wordA eq $wordB) {
	return 0;
    }

    #get senses of the words
    my @sensesA = $self->getSenses($wordA);
    my @sensesB = $self->getSenses($wordB);

    #determine if the words are direct antonyms
    #build a list of direct A antonyms
    my @antA = ();
    foreach my $senseA(@sensesA) {
	push (@antA, $self->getDirectAntonyms($senseA));
    }
    @antA = $self->removeDuplicates(@antA);

    #build a list of direct B synonyms
    my @synB = ();
    foreach my $senseB(@sensesB) {
	push (@synB, $self->getDirectSynonyms($senseB));
    }
    @synB = $self->removeDuplicates(@synB);

    #see if the lists overlap
    foreach my $senseA(@antA) {
	foreach my $senseB(@synB) {
	    if ($senseA eq $senseB) {
		return 1;   #A and B overlap and are therefore direct antonyms
	    }
	}
    }

    #all direct antonyms have been checked
    if (not $directOnly) {
        #get all indirect antonyms of A
	foreach my $senseA(@sensesA) { 
	    #get all dissimilar words for this sense
	    push(@antA, $self->getIndirectAntonyms($senseA));
	}
	@antA = $self->removeDuplicates(@antA);

        #get all words similar to B
	foreach my $senseB(@sensesB) { 
	    #get all dissimilar words for this sense
	    push(@synB, $self->getIndirectSynonyms($senseB));
	}
	@synB = $self->removeDuplicates(@synB);

        #see if simA and simB overlap
	foreach my $senseA(@antA) {
	    foreach my $senseB(@synB) {
		if ($senseA eq $senseB) {
		    return 2; #A+B overlap and are therefore indirect antonyms
		}
	    }
	}
    }

    #all tests complete, words are not similar
    return 0;
}


=comment
----  inWordNet:
     Description:
         Determines if any sense of the  word is in WordNet
     Usage:
         [1,0] = $wq->inWordNet($word);
     Input:
         $word = the word to test if it is in WordNet
     Returns:
         1 if the any sense of the word is in WordNet, 0 otherwise
     Examples:
          my $wq = WordQuery->new();  #initialize WordQuery
          my $result = $wq->inWordNet('hot');    #returns true 
          $result = $wq->inWordNet('hot#a');     #returns true 
          $result = $wq->inWordNet('hot#a#1');   #returns true 
          $result = $wq->inWordNet('hot#v');     #returns false
          $result = $wq->inWordNet('braff');     #returns false
=cut
sub inWordNet
{
    #grab input
    my $self = shift;
    my $word = shift;
    
    #if there are more than 0 senses in WordNet it is in WordNet
    if (scalar ($self->getSenses($word)) > 0) {
	return 1;
    }
    return 0;
}


##########################################################################

                        #   Private Functions

##########################################################################


#Gets a list of direct synonyms.  
#   The input must be a fully specified wordnet sense
#   Input - the fully specified wordnet sense of the word  
#   Returns - an array of direct synonyms
sub getDirectSynonyms
{
    #grab the input
    my $self = shift;
    my $word = shift;
    
    #requires a fully specified wordnet sense
    if (not($word =~ m/\w+#[nvar]#\d+/)) {
	return;  
    }
    
    #create the list of direct synonyms
    my @synonyms = ();
    push(@synonyms, $wn->querySense($word, "syns"));  #get synset words
    if ($word =~ m/\w+#a/) {  #if the word is an adjective get its similar word(s) (e.g. fiery->hot)
	push(@synonyms,  $wn->querySense($word, "sim"));
    }
    
    #return the list of direct synonyms
    return @synonyms;
}


#Gets a list of direct antonyms.  
#   The input must be a fully specified wordnet sense
#   Input - the fully specified wordnet sense of the word  
#   Returns - an array of direct antonyms
sub getDirectAntonyms
{
    #grab the input
    my $self = shift;
    my $word = shift;
    
    #requires a fully specified wordnet sense
    if (not($word =~ m/\w+#[nvar]#\d+/)) {
	return;  
    }

    #get a list of synonyms
    my @synonyms = $self->getDirectSynonyms($word);
    
    #get antonyms of each synonym and remove duplicates
    my @antonyms = ();
    foreach my $synonym(@synonyms) {
	push(@antonyms, $wn->queryWord($synonym, "ants"));
    }
    @antonyms = $self->removeDuplicates(@antonyms);

    #return the list of antonyms
    return@antonyms;
 }


#Gets a list of indirect antonyms.  
#   The input must be a fully specified wordnet sense
#   Input - the fully specified wordnet sense of the word  
#   Returns - an array of indirect antonyms
 sub getIndirectAntonyms
 {
     my $self  = shift;
     my $word = shift;

     #requires a fully specified wordnet sense
     if (not($word =~ m/\w+#[nvar]#\d+/)) {
	 return;  
     }

    #get a list of synonyms
    my @synonyms = $self->getIndirectSynonyms($word);

    #get antonyms of each synonym and remove duplicates
    my @antonyms = ();
    foreach my $synonym(@synonyms) {
	push(@antonyms, $wn->queryWord($synonym, "ants"));
    }
    @antonyms = $self->removeDuplicates(@antonyms);
  
     #antontyms can point back to synonyms so remove any synonyms of
     #  the original word from the antonym list
     my @finalAntonyms = ();
     foreach my $antonym(@antonyms) {
	 if ($self->isSynonym($word, $antonym) == 0) {
	     push (@finalAntonyms, $antonym);
	 }   
     }

    #return the list of antonyms
    return @finalAntonyms;
 }


#Gets a list of indirect synonyms
#The input must be a fully specified wordnet sense
#   Input - the fully specified wordnet sense of the word  
#   Returns - an array of indirect synonyms
sub getIndirectSynonyms() {

    #grab input
    my $self = shift;
    my $word = shift;

    my @relatedWords = ();
    #requires a fully specified wordnet sense
    if (not($word =~ m/\w+#[nvar]#\d+/)) {
	return;
    }

    #grab any similar words (adjectives only)
    if ($word =~ m/\w+#a/) {
	push(@relatedWords,  $wn->querySense($word, "sim"));
    }

    #grab any hypernyms (including instances)
    my @hypernyms =  $wn->querySense($word, "hypes");
    push(@relatedWords, @hypernyms);

    #grab any hyponyms (including instances)
    push(@relatedWords, $wn->querySense($word, "hypos"));

    #grab any words this word pertains to (pertainyms)
    my @pertainyms = $wn->queryWord($word, "pert");
    push(@relatedWords, @pertainyms);

    #grab any member meronyms
    push(@relatedWords, $wn->querySense($word, "mmem"));

    #grab any member holoyms
    push(@relatedWords, $wn->querySense($word, "hmem"));

    #grab any see also terms
    push(@relatedWords, $wn->querySense($word, "also"));

    #return the list of related words
    return  $self->removeDuplicates(@relatedWords);
}


#Removes duplicate strings in an array
#   Input - the list of strings
#   Returns - the input with duplicates removed
sub removeDuplicates
{
    my $self = shift;
    my @inputWords = @_; 

    #remove duplicate words from the list of related words
    my @outputWords = ();
    foreach my $inputWord(@inputWords) {
	my $add = 1;
	
	foreach my $outputWord(@outputWords) {
	    if ($inputWord eq $outputWord) {
		$add = 0;
		last;
	    }
	}

	#add the word if it isn't a duplicate
	if ($add) {
	    push(@outputWords, $inputWord);
	}
    }
  
    return @outputWords;
}


#Gets all the possible WordNet senses and valid forms of a word (so walked->walk, walking, etc...)
#   it also gets all pertainyms of a word (which helps to get the true meaning of a very specific word (e.g. fiery pertains to hot))
#   Input - the token to get senses of.  The token can be partially, fully, or not specified (as in word, word#n, or word#n#1)
#   Returns - a list of all possible senses of a word
sub getSenses
{
    #grab input
    my $self = shift;
    my $word = shift;
    my @senses = ();
    my @validForms = ();

    #make sure it isn't an empty word (causes QueryWord to freeze)
    my @token = split ("#", $word);
    my $tSize = scalar @token;
    if (scalar @token > 0) {
	if ($token[0] eq "") {
	    return @validForms;
	}
    }
    if (scalar @token == 0) {
	return @validForms;
    }

    #check if word is alread in sense form
    if ($word =~ m/\w+#[nvar]#\d+/) {
	#word is already in the final sense format (www#p#d)
	push (@validForms, $word);
    }
    else {
	#find all valid forms (e.g. walked is walk#v, waling#v is walk#v)
        @validForms = $wn->validForms($word);
    }

    #cycle through each form of the word and find all possible senses
    foreach $word(@validForms) {
	if ($word =~ m/.+#[nvar]#\d+/) {
	    #word is already in the final sense format (www#p#d)
	    push (@senses, $word);
	}
	elsif ($word =~ m/.+#[nvar]/) {
	    #word has a pos tag already, find all senses
	    push (@senses, $wn->queryWord($word));
	}
	elsif ($word =~ m/.+/) {
	    #word is just text, find all pos types and pos senses
	    my @posWords = $wn->queryWord($word); #get all pos variations

	    foreach my $posWord(@posWords) {
		my @posSenses = $wn->queryWord($posWord); #get all senses of this pos variation
		foreach my $sense(@posSenses) {
		    push(@senses, $sense);  #save the results
		}
	    }
	}
	else {
	    #what was passed in has no word characters, return empty
	    return;
	}
    } 


    #create a return list of final senses
    my @finalSenses = ();
    foreach my $sense(@senses) {
	push(@finalSenses, $sense);
    }

    #add any pertainyms and senses of pertainyms
    foreach my $sense(@senses) {
	my @pertainyms =  $wn->queryWord($sense, "pert");
	foreach my $pertainym(@pertainyms) {
	    push(@finalSenses,  $self->getSenses($pertainym));
	}
    }
     
    return  $self->removeDuplicates(@finalSenses);
}

1;