gp_norm_lm.pl
3.29 KB
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
#!/usr/bin/env perl
use warnings; #sed replacement for -w perl parameter
# Copyright 2012 Arnab Ghoshal
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# THIS CODE IS PROVIDED *AS IS* BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
# KIND, EITHER EXPRESS OR IMPLIED, INCLUDING WITHOUT LIMITATION ANY IMPLIED
# WARRANTIES OR CONDITIONS OF TITLE, FITNESS FOR A PARTICULAR PURPOSE,
# MERCHANTABLITY OR NON-INFRINGEMENT.
# See the Apache 2 License for the specific language governing permissions and
# limitations under the License.
# This script normalizes the GlobalPhone language models that have been supplied
# with the corpus (at least at Edinbugh). It expects an ARPA-format (unzipped) LM as input.
my $usage = "Usage: gp_format_lm.pl [-a] -i lm > formatted\
Normalizes language models (in ARPA format) for GlobalPhone.\
Options:\
-a\tTreat acronyms differently (puts - between individual letters)\n";
use strict;
use Getopt::Long;
die "$usage" unless(@ARGV >= 1);
my ($acro, $in_lm, @ngram_counts);
GetOptions ("a" => \$acro, # put - between letters of acronyms
"i=s" => \$in_lm); # Input language model
open(G, "<$in_lm") or die "Cannot open language model file '$in_lm': $!";
while (<G>) { last if /^\\data\\/; } # Skip till header
print;
# Read counts for various n-gram orders
while (<G>) {
print;
next if /^$/;
last if /^\\1-grams\:/;
m/^ngram (\d+)\s*\=\s*(\d+)$/ or die "Bad line: $_";
$ngram_counts[$1] = $2; # Not 0-indexed!
}
my $nproc;
for my $i (1..$#ngram_counts-1) { # For all except highest n-gram order
$nproc = 0; # Number of n-grams actually found.
while (<G>) {
if ($_ =~ /^$/) { print; next; }
if ($_ =~ /^\\(\d+)\-grams\:/) {
die "Expecting $ngram_counts[$i] $i-grams; found $nproc!"
unless ($nproc == $ngram_counts[$i]);
print; last;
}
my @fields = split;
die "Bad line: $_" if ($#fields<$i || $#fields>$i+1);
for my $f (1..$i) {
&NormalizeWord($fields[$f]);
}
print join(" ", @fields), "\n";
$nproc += 1;
}
}
$nproc = 0;
my $i = $#ngram_counts;
while (<G>) { # Now, process the entries for the highest n-gram order
if ($_ =~ /^$/) { print; next; }
if ($_ =~ /^\\end\\/) {
die "Expecting $ngram_counts[$i] ${i}-grams; found $nproc!"
unless ($nproc == $ngram_counts[$i]);
print; last;
}
my @fields = split;
die "Bad line: $_" if ($#fields != $i);
for my $f (1..$i) {
&NormalizeWord($fields[$f]);
}
print join(" ", @fields), "\n";
$nproc += 1;
}
sub NormalizeWord {
my $word = $_[0];
$word =~ s/\(.*\)//g; # Pron variants should have same orthography
# Distinguish acronyms before capitalizing everything, since they have
# different pronunciations. This may not be important.
if (defined($acro)) {
if ($word =~ /^[A-Z-]+(\-.*)*$/) {
my @subwords = split('-', $word);
$word = "";
for my $i (0..$#subwords) {
if($subwords[$i] =~ /^[A-Z]{2,}$/) {
$subwords[$i] = join('-', split(//, $subwords[$i]));
}
}
$word = join('-', @subwords);
}
}
$word =~ tr/a-z/A-Z/; # Now, capitalize every word.
$word =~ s:<S>:<s>:g;
$word =~ s:</S>:</s>:g;
$_[0] = $word;
}