Permalink
Fetching contributors…
Cannot retrieve contributors at this time
executable file 111 lines (98 sloc) 2.99 KB
#!/usr/bin/perl -w
# Copyright (C) 2002-2003 Nadav Har'El and Dan Kenigsberg
#
# Packs a sorted, binarized wordlist into, into one dictionary with
# or'ed prefix hints, a description file, and a stem file.
# Usage: cat sorted_bin |
# pack-desc.pl -p prefixesout -d descout -s stemsout > wordsout
#
use Carp;
use Getopt::Std;
my %opts;
# -p - output prefix file.
# -d - output description file.
# -s - output stems file.
# -l - output dictionary sizes that are relevant to linginfo
if(!getopts('p:d:s:l:', \%opts)){
exit(1);
}
my $out_prefixes=$opts{p};
my $out_desc=$opts{d};
my $out_stems=$opts{s};
my $out_lingsizes=$opts{l};
my ($lastword,$lastspecifiers, $flatlen);
my ($stems,$dmasks,$specifiers,$c,%pointers);
my @words;
$c=0;
while(<>){
# I want to print this message only *after* the script started reading
# its input - but only once.
print STDERR "reading input sorted flat file...\n"
if !defined($lastword);
chomp;
next unless m/^(.*)\t(.*)\t(.*)\t(.*)$/;
my ($word,$specifier,$dmask,$stem) = ($1,$2,$3,$4);
# found a new word. output the packed one.
if($lastword && $lastword ne $word) {
$pointers{$lastword} = $c;
$stems =~ s/:$//o;
push @words, "$lastword\t$lastspecifiers\t$dmasks\t$stems";
# $flatlen += $#lastword+2+($#dmasks+1)/2*5+2;
$stems="";$dmasks="";$specifiers=0;$c++;
# it takes ages. let's notify the package builder.
print STDERR "#" if !($c%1000) ;
}
$stems .= "$stem:";
$dmasks .= $dmask;
$specifiers |= $specifier;
$lastword = $word;
$lastspecifiers = $specifiers;
}
# reached EOF. output the final word. TODO: don't do this ugly copy-paste of
# code. call a proper function!
$pointers{$lastword} = $c;
$stems =~ s/:$//o;
push @words, "$lastword\t$lastspecifiers\t$dmasks\t$stems";
$stems="";$dmasks="";$specifiers=0;$c++;
print STDERR "\nwriting output files...";
if ($out_prefixes) {
open(PREFIXES,">$out_prefixes")
or croak "Couldn't write -p parameter '$out_prefixes'";
}
if ($out_desc) {
open(DESCS,">$out_desc")
or croak "Couldn't write -d parameter '$out_desc'";
}
if ($out_stems) {
open(STEMS,">$out_stems")
or croak "Couldn't write -s parameter '$out_stems'";
}
foreach (@words) {
m/^(.*)\t(.*)\t(.*)\t(.*)$/o;
my ($word,$specifier,$dcodes,$stems) =($1,$2,$3,$4);
print $word,"\n";
print PREFIXES chr($specifier) if $out_prefixes;
print DESCS $dcodes,"\n" if $out_desc;
$flatlen += length($word)+1;
if ($out_stems) {
foreach (split(':',$stems)) {
my $i = $pointers{$_};
my $c1 = $i%94;
my $c2 = ($i-$c1)/94%94;
my $c3 = ($i-$c1-$c2)/94/94;
print STEMS chr(33+$c1).chr(33+$c2).chr(33+$c3);
$flatlen += 5;
}
print STEMS "\n";
$flatlen += 2;
}
}
close PREFIXES if $out_prefixes;
close DESCS if $out_desc;
close STEMS if $out_stems;
print STDERR "creating $out_lingsizes...\n";
open(DESC_SIZES,">$out_lingsizes") or die "cannot write $out_lingsizes\n";
#print DESC_SIZES "#define FLATSIZE ".$flatlen."\n";
#print DESC_SIZES "#define LOOKUPLEN ".($#words+1)."\n";
print DESC_SIZES $flatlen." ".($#words+1)."\n";
close DESC_SIZES;