summaryrefslogtreecommitdiffstats
path: root/tools/thesaurus/extract.pl
blob: b5cfe5d6422507dbe9a6c3b42a820b7b36a675c9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
#!/usr/bin/perl -w
# $Id: extract.pl 490579 2005-12-22 12:32:17Z scripty $
# This file is part of the TDE project
# Copyright (C) 2001 Daniel Naber <daniel.naber@t-online.de>

# 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., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

# Extract information from WordNet data files - only useful for development.
# cat together all of WordNet's data.* files and call this script. As a second
# argument you can use a word frequency list as "Alphabetical frequency list of 
# the whole corpus (lemmatized)" on http://ucrel.lancs.ac.uk/bncfreq/flists.html
# This will remove all words whcih are not in the list, i.e. words that are rare.
# 
# Output of this script is:
# ;syn1;syn2;...;#;hyper1;hyper2;...;

# TODO:
# -"close" and "closely" are synonym which can irritate people!?
# -document this + clean up a bit

use strict;

sub prg()
{

    my $prefix = "";
    # TODO?: prefix (n,v,a or r) per line won't work as each word
    # can have a different prefix (it's rare but it happens)
    
	my $filename = $ARGV[0];
	my $filename_stat = $ARGV[1];
	if( ! $filename ) {
		print "Usage: $0 <wordnet_file> [occurence_statistics_file]\n";
		exit;
	}

	# read word frequency statistics to later filter out uncommon words:
	# format:
	#        abuse   Verb    %       12      97      0.92
	#        @       @       abuse   2       82      0.91
	# lines with "@" are non-lemmatized word forms
	
	my %stats;		# (lemmatized_term,occurences_in_1_million_words)
	if( $filename_stat ) {
		open(IN, "<$filename_stat") || die "Cannot open '$filename_stat': $!";
		while(<IN>) {
			my $line = $_;
			my @ar = split(/\t/, $line);
			if( $ar[1] eq '@' ) {
    			#print STDERR "$ar[3] -- $ar[4]\n";
    			$stats{lc($ar[1])} = $ar[4];
			} else {
    			#print "$ar[1] -- $ar[4]\n";
    			$stats{lc($ar[1])} = $ar[4];
            }
		}
		close(IN);
	}
	
	# build hashtable of synsets:
	open(IN, "<$filename") || die "Cannot open '$filename': $!";
	my %data;
	while(<IN>) {
		my $line = $_;
		next if( $line =~ m/^  / );	# copyright notice
		my @parts = split(/\s+/, $line);
		my $sysnset = "";
        my $occurences = hex($parts[3]);
		if( $occurences > 10 ) {
			#print STDERR "** $occurences synonyms ($line)\n";
		}
		for(my $i = 0; $i < 2*$occurences; $i += 2) {
			my $syn = $parts[4+$i];
			if( ! $syn ) {
				next;
			}
			$sysnset .= $syn.";";
		}
		$data{$parts[0]} = $sysnset;
	}
	close(IN);

print <<__EOF;
  1 This software and database is being provided to you, the LICENSEE,
  2 Princeton University under the following license. By obtaining, using
  2 and/or copying this software and database, you agree that you have read,
  3 understood, and will comply with these terms and conditions.:
  4
  5 Permission to use, copy, modify and distribute this software and database
  6 and its documentation for any purpose and without fee or royalty is hereby
  7 granted, provided that you agree to comply with the following copyright
  8 notice and statements, including the disclaimer, and that the same appear
  9 on ALL copies of the software, database and documentation, including
  10 modifications that youmake for internal use or for distribution.
  11
  12 WordNet 3.0 Copyright 2006 by Princeton University. All rights reserved.
  13
  14 THIS SOFTWARE AND DATABASE IS PROVIDED "AS IS" AND PRINCETON UNIVERSITY
  15 MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED. BY WAY OF
  16 EXAMPLE, BUT NOT LIMITATION, PRINCETON UNIVERSITY MAKES NO REPRESENTATIONS
  17 OR WARRANTIES OF MERCHANT- ABILITY OR FITNESS FOR ANY PARTICULAR PURPOSE
  18 OR THAT THE USE OF THE LICENSED SOFTWARE, DATABASE OR DOCUMENTATION WILL
  19 NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, TRADEMARKS OR OTHER RIGHTS.
  20
  21 The name of Princeton University or Princeton may not be used in advertising
  22 or publicity pertaining to distribution of the software and/or database.
  23 Title to copyright in this software, database and any associated documentation
  24 shall at all times remain with Princeton University and LICENSEE agrees to
  25 preserve same.
__EOF
	# for each synset, find its hypernyms:
	open(IN, "<$filename") || die "Cannot open '$filename': $!";
	while(<IN>) {
		my $line = $_;
		next if( $line =~ m/^  / );	# copyright notice
		my @parts = split(/\s+/, $line);
		my $pos = 0;
        my $occurences = hex($parts[3]);
        #print STDERR "# $parts[4] $occurences\n";
		my $line_result = ""; 
		my $occurs = 0;     # how often does it occur in texts according to the statistics?
		for(my $i = 0; $i < 2*$occurences; $i += 2) {
			my $syn = $parts[4+$i];
			if( ! $syn ) {
				next;
			}
			$line_result .= $syn.";";
			#print "##".$syn."\n";
			#print "$syn occurs: ".$stats{$syn}."\n";
			if( $filename_stat && $stats{lc($syn)} ) {
				$occurs += $stats{lc($syn)};
			}
		}
        $line_result =~ s/_/ /g;
		if( $filename_stat ) {
			if( $occurs > 0 ) {		# occurences of all synonyms together
				$line_result = "$prefix;$line_result";
			} else {
				next;
			}
		} else {
			$line_result = "$prefix;$line_result";
        }
		my $ct = 0;
		my $hyper = "";
		#print "**$line:\n";
        # walk through the hypernyms (resp "similar" for adjectives):
		while( $line =~ m!(\@|\&) (.*?) (.*?) (.*?)!ig ) {
			#print "@ $1 $2\n";
			if( $data{$2} ) {
                #print "OK\n";
				$hyper .= $data{$2};
				$ct++;
			}
		}
        #print "syns: $occurences, hypers: $ct\n";
		if($ct > 0) {
            $hyper =~ s/_/ /g;
   			$line_result .= "#;$hyper\n";
		} else {
   			$line_result .= "#\n";
		}
        if( $occurences > 1 || $ct > 0 ) {
            $line_result =~ s/\((a|p|ip)\)//igs;  # attributive or prenomial use isn't so interesting
			print "$line_result";
        }
	}
	close(IN);
}

prg();