subset_lm.pl
2.87 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
#!/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 builds a lower-order LM.
my $usage = "Usage: subset_lm.pl -i input[.gz] -n order -o output[.gz]
Builds a lower-oder LM from the input (can read & write gzipped files).\n";
use strict;
use Getopt::Long;
my ($in_lm, $order, $out_lm, @ngram_counts);
GetOptions ("i=s" => \$in_lm, # Input language model file
"n=i" => \$order, # Max n-gram order of the output
"o=s" => \$out_lm); # Output language model file
die "$usage" unless (defined($in_lm) && defined($order) && defined($out_lm));
die "Output order must be positive." unless ($order > 0);
my $cmd = ($in_lm =~ /\.gz$/)? "gzip -dc $in_lm |" : "<$in_lm";
open(IN, "$cmd") or die "Cannot read from language model file '$in_lm': $!";
$cmd = ($out_lm =~ /\.gz$/)? "| gzip -c > $out_lm" : ">$out_lm";
open(OUT, "$cmd") or die "Cannot write to language model file '$out_lm': $!";
while (<IN>) { last if /^\\data\\/; } # Skip till header
# Read counts for various n-gram orders
while (<IN>) {
next if /^$/;
last if /^\\1-grams\:/;
m/^ngram (\d+)\s*\=\s*(\d+)$/ or die "Bad line: $_";
$ngram_counts[$1] = $2; # Not 0-indexed!
}
# Handle degenerate case.
if ($#ngram_counts <= $order) {
warn "Input LM order ($#ngram_counts) <= required LM order ($order): input and output will be identical.";
seek(IN, 0, 0);
while (<IN>) { print OUT; } # Don't have to worry about gz
close IN; close OUT;
exit 0;
} else { # Print the header (with lower n-gram order)
print OUT "\\data\\\n";
for my $i (1..$order) {
print OUT "ngram $i=$ngram_counts[$i]\n";
}
print OUT "\n";
}
my $nproc;
for my $i (1..$order) {
$nproc = 0; # Number of n-grams actually found.
print OUT "\n\\${i}-grams:\n";
while (<IN>) {
next if ($_ =~ /^$/);
if ($_ =~ /^\\(\d+)\-grams\:/) {
die "Expecting $ngram_counts[$i] $i-grams; found $nproc!"
unless ($nproc == $ngram_counts[$i]);
last;
}
my @fields = split;
die "Bad line: $_" if ($#fields<$i || $#fields>$i+1);
# For the highest order of n-gram, remove back-off weight, if present.
pop(@fields) if ($i==$order && $#fields==$i+1);
print OUT join(" ", @fields), "\n";
$nproc += 1;
}
}
print OUT "\\end\\\n";
close IN;
close OUT;