254 lines
6.0 KiB
Plaintext
254 lines
6.0 KiB
Plaintext
|
#!/usr/bin/perl -w
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use Encode;
|
||
|
|
|
||
|
|
binmode(STDIN, ":utf8");
|
||
|
|
binmode(STDOUT, ":utf8");
|
||
|
|
binmode(STDERR, ":utf8");
|
||
|
|
|
||
|
|
|
||
|
|
my $dir = "txt";
|
||
|
|
my $outdir = "aligned";
|
||
|
|
my $preprocessor = "tools/split-sentences.perl -q";
|
||
|
|
|
||
|
|
my ($l1,$l2) = @ARGV;
|
||
|
|
die unless -e "$dir/$l1";
|
||
|
|
die unless -e "$dir/$l2";
|
||
|
|
|
||
|
|
`mkdir -p $outdir/$l1-$l2/$l1`;
|
||
|
|
`mkdir -p $outdir/$l1-$l2/$l2`;
|
||
|
|
|
||
|
|
my ($dayfile,$s1); # globals for reporting reasons
|
||
|
|
open(LS,"ls $dir/$l1|");
|
||
|
|
while($dayfile = <LS>) {
|
||
|
|
chop($dayfile);
|
||
|
|
if (! -e "$dir/$l2/$dayfile") {
|
||
|
|
print "$dayfile only for $l1, not $l2, skipping\n";
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
&align();
|
||
|
|
}
|
||
|
|
|
||
|
|
sub align {
|
||
|
|
my @TXT1native= `$preprocessor -l $l1 < $dir/$l1/$dayfile`;
|
||
|
|
my @TXT2native = `$preprocessor -l $l2 < $dir/$l2/$dayfile`;
|
||
|
|
my @TXT1;
|
||
|
|
my @TXT2;
|
||
|
|
|
||
|
|
|
||
|
|
#change perl encoding
|
||
|
|
foreach my $line (@TXT1native) {
|
||
|
|
push(@TXT1,decode_utf8($line));
|
||
|
|
}
|
||
|
|
foreach my $line (@TXT2native) {
|
||
|
|
push(@TXT2,decode_utf8($line));
|
||
|
|
}
|
||
|
|
|
||
|
|
open(OUT1, ">$outdir/$l1-$l2/$l1/$dayfile");
|
||
|
|
open(OUT2, ">$outdir/$l1-$l2/$l2/$dayfile");
|
||
|
|
|
||
|
|
binmode(OUT1, ":utf8");
|
||
|
|
binmode(OUT2, ":utf8");
|
||
|
|
|
||
|
|
|
||
|
|
for(my $i2=0,my $i1=0; $i1<scalar(@TXT1) && $i2<scalar(@TXT2);) {
|
||
|
|
|
||
|
|
# match chapter start
|
||
|
|
if ($TXT1[$i1] =~ /^<CHAPTER ID=\"?(\d+)\"?/) {
|
||
|
|
my $c1 = $1;
|
||
|
|
#print "CHAPTER $1\n";
|
||
|
|
if ($TXT2[$i2] =~ /^<CHAPTER ID=\"?(\d+)\"?/) {
|
||
|
|
my $c2 = $1;
|
||
|
|
if ($c1 == $c2) {
|
||
|
|
print OUT1 $TXT1[$i1++];
|
||
|
|
print OUT2 $TXT2[$i2++];
|
||
|
|
}
|
||
|
|
elsif ($c1 < $c2) {
|
||
|
|
$i1 = &skip(\@TXT1,$i1+1,'^<CHAPTER ID=\"?\d+\"?');
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
$i2 = &skip(\@TXT2,$i2+1,'^<CHAPTER ID=\"?\d+\"?');
|
||
|
|
}
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
$i2 = &skip(\@TXT2,$i2,'^<CHAPTER ID=\"?\d+\"?');
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# match speaker start
|
||
|
|
elsif ($TXT1[$i1] =~ /^<SPEAKER ID=\"?(\d+)\"?/) {
|
||
|
|
$s1 = $1;
|
||
|
|
#print "SPEAKER $1\n";
|
||
|
|
if ($TXT2[$i2] =~ /^<SPEAKER ID=\"?(\d+)\"?/) {
|
||
|
|
my $s2 = $1;
|
||
|
|
if ($s1 == $s2) {
|
||
|
|
print OUT1 $TXT1[$i1++];
|
||
|
|
print OUT2 $TXT2[$i2++];
|
||
|
|
}
|
||
|
|
elsif ($s1 < $s2) {
|
||
|
|
$i1 = &skip(\@TXT1,$i1+1,'^<SPEAKER ID=\"?\d+\"?');
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
$i2 = &skip(\@TXT2,$i2+1,'^<SPEAKER ID=\"?\d+\"?');
|
||
|
|
}
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
$i2 = &skip(\@TXT2,$i2,'^<SPEAKER ID=\"?\d+\"?');
|
||
|
|
}
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
#print "processing... $i1,$i2\n";
|
||
|
|
my @P1 = &extract_paragraph(\@TXT1,\$i1);
|
||
|
|
my @P2 = &extract_paragraph(\@TXT2,\$i2);
|
||
|
|
if (scalar(@P1) != scalar(@P2)) {
|
||
|
|
print "$dayfile (speaker $s1) different number of paragraphs ".scalar(@P1)." != ".scalar(@P2)."\n";
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
for(my $p=0;$p<scalar(@P1);$p++) {
|
||
|
|
&sentence_align(\@{$P1[$p]},\@{$P2[$p]});
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
close(LS);
|
||
|
|
|
||
|
|
sub skip {
|
||
|
|
my ($TXT,$i,$pattern) = @_;
|
||
|
|
my $i_old = $i;
|
||
|
|
while($i < scalar(@{$TXT})
|
||
|
|
&& $$TXT[$i] !~ /$pattern/) {
|
||
|
|
$i++;
|
||
|
|
}
|
||
|
|
print "$dayfile skipped lines $i_old-$i to reach '$pattern'\n";
|
||
|
|
return $i;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub extract_paragraph {
|
||
|
|
my ($TXT,$i) = @_;
|
||
|
|
my @P = ();
|
||
|
|
my $p=0;
|
||
|
|
for(;$$i<scalar(@{$TXT})
|
||
|
|
&& ${$TXT}[$$i] !~ /^<SPEAKER ID=\"?\d+\"?/
|
||
|
|
&& ${$TXT}[$$i] !~ /^<CHAPTER ID=\"?\d+\"?/;$$i++) {
|
||
|
|
if (${$TXT}[$$i] =~ /^<P>/) {
|
||
|
|
$p++ if $P[$p];
|
||
|
|
# each XML tag has its own paragraph
|
||
|
|
push @{$P[$p]}, ${$TXT}[$$i];
|
||
|
|
$p++;
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
push @{$P[$p]}, ${$TXT}[$$i];
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return @P;
|
||
|
|
}
|
||
|
|
|
||
|
|
# this is a vanilla implementation of church and gale
|
||
|
|
sub sentence_align {
|
||
|
|
my ($P1,$P2) = @_;
|
||
|
|
chop(@{$P1});
|
||
|
|
chop(@{$P2});
|
||
|
|
|
||
|
|
# parameters
|
||
|
|
my %PRIOR;
|
||
|
|
$PRIOR{1}{1} = 0.89;
|
||
|
|
$PRIOR{1}{0} = 0.01/2;
|
||
|
|
$PRIOR{0}{1} = 0.01/2;
|
||
|
|
$PRIOR{2}{1} = 0.089/2;
|
||
|
|
$PRIOR{1}{2} = 0.089/2;
|
||
|
|
# $PRIOR{2}{2} = 0.011;
|
||
|
|
|
||
|
|
# compute length (in characters)
|
||
|
|
my (@LEN1,@LEN2);
|
||
|
|
$LEN1[0] = 0;
|
||
|
|
for(my $i=0;$i<scalar(@{$P1});$i++) {
|
||
|
|
my $line = $$P1[$i];
|
||
|
|
$line =~ s/[\s\r\n]+//g;
|
||
|
|
# print "1: $line\n";
|
||
|
|
$LEN1[$i+1] = $LEN1[$i] + length($line);
|
||
|
|
}
|
||
|
|
$LEN2[0] = 0;
|
||
|
|
for(my $i=0;$i<scalar(@{$P2});$i++) {
|
||
|
|
my $line = $$P2[$i];
|
||
|
|
$line =~ s/[\s\r\n]+//g;
|
||
|
|
# print "2: $line\n";
|
||
|
|
$LEN2[$i+1] = $LEN2[$i] + length($line);
|
||
|
|
}
|
||
|
|
|
||
|
|
# dynamic programming
|
||
|
|
my (@COST,@BACK);
|
||
|
|
$COST[0][0] = 0;
|
||
|
|
for(my $i1=0;$i1<=scalar(@{$P1});$i1++) {
|
||
|
|
for(my $i2=0;$i2<=scalar(@{$P2});$i2++) {
|
||
|
|
next if $i1 + $i2 == 0;
|
||
|
|
$COST[$i1][$i2] = 1e10;
|
||
|
|
foreach my $d1 (keys %PRIOR) {
|
||
|
|
next if $d1>$i1;
|
||
|
|
foreach my $d2 (keys %{$PRIOR{$d1}}) {
|
||
|
|
next if $d2>$i2;
|
||
|
|
my $cost = $COST[$i1-$d1][$i2-$d2] - log($PRIOR{$d1}{$d2}) +
|
||
|
|
&match($LEN1[$i1]-$LEN1[$i1-$d1], $LEN2[$i2]-$LEN2[$i2-$d2]);
|
||
|
|
# print "($i1->".($i1-$d1).",$i2->".($i2-$d2).") [".($LEN1[$i1]-$LEN1[$i1-$d1]).",".($LEN2[$i2]-$LEN2[$i2-$d2])."] = $COST[$i1-$d1][$i2-$d2] - ".log($PRIOR{$d1}{$d2})." + ".&match($LEN1[$i1]-$LEN1[$i1-$d1], $LEN2[$i2]-$LEN2[$i2-$d2])." = $cost\n";
|
||
|
|
if ($cost < $COST[$i1][$i2]) {
|
||
|
|
$COST[$i1][$i2] = $cost;
|
||
|
|
@{$BACK[$i1][$i2]} = ($i1-$d1,$i2-$d2);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
# print $COST[$i1][$i2]."($i1-$BACK[$i1][$i2][0],$i2-$BACK[$i1][$i2][1]) ";
|
||
|
|
}
|
||
|
|
# print "\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
# back tracking
|
||
|
|
my (%NEXT);
|
||
|
|
my $i1 = scalar(@{$P1});
|
||
|
|
my $i2 = scalar(@{$P2});
|
||
|
|
while($i1>0 || $i2>0) {
|
||
|
|
# print "back $i1 $i2\n";
|
||
|
|
@{$NEXT{$BACK[$i1][$i2][0]}{$BACK[$i1][$i2][1]}} = ($i1,$i2);
|
||
|
|
($i1,$i2) = ($BACK[$i1][$i2][0],$BACK[$i1][$i2][1]);
|
||
|
|
}
|
||
|
|
while($i1<scalar(@{$P1}) || $i2<scalar(@{$P2})) {
|
||
|
|
# print "fwd $i1 $i2\n";
|
||
|
|
for(my $i=$i1;$i<$NEXT{$i1}{$i2}[0];$i++) {
|
||
|
|
print OUT1 " " unless $i == $i1;
|
||
|
|
print OUT1 $$P1[$i];
|
||
|
|
}
|
||
|
|
print OUT1 "\n";
|
||
|
|
for(my $i=$i2;$i<$NEXT{$i1}{$i2}[1];$i++) {
|
||
|
|
print OUT2 " " unless $i == $i2;
|
||
|
|
print OUT2 $$P2[$i];
|
||
|
|
}
|
||
|
|
print OUT2 "\n";
|
||
|
|
($i1,$i2) = @{$NEXT{$i1}{$i2}};
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub match {
|
||
|
|
my ($len1,$len2) = @_;
|
||
|
|
my $c = 1;
|
||
|
|
my $s2 = 6.8;
|
||
|
|
|
||
|
|
if ($len1==0 && $len2==0) { return 0; }
|
||
|
|
my $mean = ($len1 + $len2/$c) / 2;
|
||
|
|
my $z = ($c * $len1 - $len2)/sqrt($s2 * $mean);
|
||
|
|
if ($z < 0) { $z = -$z; }
|
||
|
|
my $pd = 2 * (1 - &pnorm($z));
|
||
|
|
if ($pd>0) { return -log($pd); }
|
||
|
|
return 25;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub pnorm {
|
||
|
|
my ($z) = @_;
|
||
|
|
my $t = 1/(1 + 0.2316419 * $z);
|
||
|
|
return 1 - 0.3989423 * exp(-$z * $z / 2) *
|
||
|
|
((((1.330274429 * $t
|
||
|
|
- 1.821255978) * $t
|
||
|
|
+ 1.781477937) * $t
|
||
|
|
- 0.356563782) * $t
|
||
|
|
+ 0.319381530) * $t;
|
||
|
|
}
|