The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/local/bin/perl

# pairs-noroot.t version 0.07
# (Updated 1/15/2004 -- Jason)

# Copyright (C) 2004

# Jason Michelizzi, University of Minnesota Duluth
# mich0212 at d.umn.edu

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

# Before 'make install' is performed this script should be runnable with
# 'make test'.  After 'make install' it should work as 'perl pairs-noroot.t'

# A script to run queries on a large file of words and compare the results
# with a set of relatedness values stored in "keys."  The list of pairs
# of words was generated by the randomPairs.pl program that can be obtained
# from http://www.d.umn.edu/~tpederse/wordnet.html

# This script supports two options:
# 1) the --key option can be used to generate a key, in which case no actual
#    tests are run.
# 2) the --keydir option can be used to specify where the key is or should be
#    stored.  The default value is t/keys.

use strict;
use warnings;

use Getopt::Long;

our ($opt_key, $opt_keydir);

GetOptions ("key", "keydir=s");

my @measures;
my $num_tests;

BEGIN {
  @measures = qw/jcn lch lin path res wup/;
  $num_tests = 14 + (7 + 109) * scalar @measures;
}

use Test::More tests => $num_tests;

BEGIN {use_ok 'WordNet::QueryData'}
#BEGIN {use_ok 'WordNet::Similarity::hso'}
BEGIN {use_ok 'WordNet::Similarity::jcn'}
BEGIN {use_ok 'WordNet::Similarity::lch'}
#BEGIN {use_ok 'WordNet::Similarity::lesk'}
BEGIN {use_ok 'WordNet::Similarity::lin'}
BEGIN {use_ok 'WordNet::Similarity::path'}
# There's really no point in testing random like this
#BEGIN {use_ok 'WordNet::Similarity::random'}
BEGIN {use_ok 'WordNet::Similarity::res'}
#BEGIN {use_ok 'WordNet::Similarity::vector'}
BEGIN {use_ok 'WordNet::Similarity::wup'}
BEGIN {use_ok 'File::Spec'}

my $precision = 4;

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

my $infile = File::Spec->catfile ('t', 'pairs.txt');

ok (-e $infile);
ok (-r $infile);

ok (open FH, $infile) or diag "Could not open $infile: $!";
my @lines = <FH>;

ok (close FH);

my @pairs = map {my ($w1, $w2) = split; [$w1, $w2]} @lines;

# the temporary config file
my $config = "pairs_nr.cfg";

# if the key option is given, we want to generate a "key" for the tests.
# A key is essentially just a list of relatedness values.  If the key
# option is not given, then we use the key to test if the relatedness
# values we are generating correspond to the key's values.
unless ($opt_key) {
  # not generating a key--actually running tests
  foreach my $measure (@measures) {
    # make a temporary config file
    ok (open CFH, ">$config") or diag "Could not open $config: $!";
    print CFH "WordNet::Similarity::$measure\n";
    print CFH "rootNode::0\n";
    ok (close CFH);

    my $keyfile;
    if ($opt_keydir) {
      $keyfile = File::Spec->catfile ($opt_keydir, "${measure}pairs_nr.key");
    }
    else {
      $keyfile = File::Spec->catfile ('t', 'keys', "${measure}pairs_nr.key");
    }

    ok (open KEY, $keyfile) or diag "Could not open $keyfile: $!";

    my @keys = map {chomp; $_} <KEY>;

    is (scalar @keys, scalar @pairs);

    ok (close KEY);

    my $module = "WordNet::Similarity::$measure"->new ($wn, $config);
    ok ($module);
    my ($err, $errstr) = $module->getError ();
    is ($err, 0) or diag "$errstr";

    for (0..$#pairs) {
      my ($word1, $word2) = ($pairs[$_]->[0], $pairs[$_]->[1]);
      my $score = $module->getRelatedness ($word1, $word2);

      # format the score so that we can compare it to the value from file
      $score = defined $score ? sprintf ("%.*f", $precision, $score) : 'undef';

      is ($score, $keys[$_]) or diag "Wrong relatedness using $measure for $word1 $word2";
      $module->getError();
    }
  }
}
else {
  foreach my $measure (@measures) {
    # generating keys

    # make a temporary config file
    ok (open CFH, ">$config") or diag "Could not open $config: $!";
    print CFH "WordNet::Similarity::$measure\n";
    print CFH "rootNode::0\n";
    ok (close CFH);

    my $keyfile;
    if ($opt_keydir) {
      $keyfile = File::Spec->catfile ($opt_keydir, "${measure}pairs_nr.key");
    }
    else {
      $keyfile = File::Spec->catfile ('t', 'keys', "${measure}pairs_nr.key");
    }

    ok (open KEY, ">$keyfile") or diag "Could not open $keyfile: $!";

    my $module = "WordNet::Similarity::$measure"->new ($wn, $config);
    ok ($module);
    my ($err, $errstr) = $module->getError ();
    is ($err, 0) or diag "$errstr\n";

    for (0..$#pairs) {
      my $score = $module->getRelatedness ($pairs[$_]->[0], $pairs[$_]->[1]);
      if (defined $score) {
	printf KEY "%.*f\n", $precision, $score;
      }
      else {
	print KEY "undef\n";
      }

      $module->getError();  # clears the error level
    }
    ok (close KEY);
  }

  # hack to prevent annoying warning: when we generate keys, we skip a lot
  # of tests.  This magic avoids an irritating warning that says something
  # to the effect of "looks like you planned X tests but only ran Y."
 SKIP: {
    my $num_skipped = $num_tests - 14 - 6 * scalar (@measures);
    skip ("Generating key, no need to run test", $num_skipped);
  }
}

END {ok unlink $config}