使用Perl自动化形态标记

时间:2011-08-29 11:30:51

标签: regex perl

假设我有一个带有形态标签的文本,以及一个没有标签的类似文本。两种文本以行间方式合并,一行低于另一行。因此(为了清楚起见,增加了回车):

  

(艺术)日(N)开始(V)井(Adv),刮风(Adj)和(C)潮湿(Adj),   这里(Adv)在(P)伦敦(PN),

     

伦敦这一天风很大,很潮湿,

     

但是(P)我们(Pr)做(AuxV)没有(Adv)介意(V),因为(P)我们(Pr)有(AuxV)   计划(V)到(P)呆在室内(V)

     

但没问题,伙计!无论如何我们原本打算留在家里!

第二行(即未标记的文本)前面总是以空格和制表符开头。

此外,可以安全地忽略标点符号和区分大小写。此外,可能会出现第一行中的某些单词未被标记的情况。

所以,从这种伪代码中,鉴于我对Perl的了解有限,我决定构建一系列正则表达式来提取第1行的标记(总是在括号中)并将它们插入到第2行,只要字样相同。

我目前的代码如下:

use strict;
use warnings;

while ( <DATA> )
{
s/(^\w+)(\(\w+\))?(.+\r)(\s\t)(\1)/$1$2$3$4$5$2/g; #Tag 1st word on line 2 (if it's the same one as the 1st on line 1).
s/(^\w+)(\(\w+\))?\s(\w+)(\(\w+\))?(.+\r)(\s\t)(\1\2)\s(\3)/$1$2 $3$4$5$6$7 $8$4/g; #Tag 2nd word on line 2 (if it's the same one as the 2nd on line 1).
# And so on...

print;
}


__DATA__
The(Art) day(N) started(V) well(Adv), windy(Adj) and(C) humid(Adj), here(Adv) in(P) London(PN),
    The day was windy and quite humid here in London, 
but(P) we(Pr) did(AuxV) not(Adv) mind(V), because(P) we(Pr) had(AuxV) planned(V) to(P) stay(V) indoors(Adv) 
   but no problem at all, mate! We had planned to stay at home anyway! 

显然,我想要的输出看起来如下:

  

(艺术)日(N)开始(V)井(Adv),刮风(Adj)和(C)潮湿(Adj),   (P)伦敦(PN),(Adv),        (艺术)日(N)有风且非常潮湿(Adj)这里(Adv)(P)   伦敦(PN),

     

但是(P)我们(Pr)做(AV)没有(Adv)介意(V),因为(P)我们(Pr)有(AuxV)   计划(V)到(P)呆在室内(V)

     

但是(P)没问题,伙计!我们(Pr)有(AuxV)计划(V)到(P)   无论如何留在家里(V)!


我的问题有两个:

a)上面的脚本(目前我试图用第一个和第二个单词替换)不起作用,虽然我认为正则表达式没问题(我已经在BBEdit中测试它们作为搜索/替换)。

b)我完全不确定这是解决手头任务的正确方法(即添加一系列越来越长且更复杂的正则表达式)。

有人可以告诉我应该怎么做才能让它发挥作用,或者,让我看一个更好的方法来优化任务?我都是耳朵!

非常感谢你。

5 个答案:

答案 0 :(得分:3)

这样的东西?

#!/usr/bin/perl

use strict;
use warnings;

my %tag;

while (<DATA>)
{
    if (m/\((Adj|Art|AuxV|C|N|PN|V)\)/) # it's an example
    {
        # Loop over tagged words; memorize tag for each
        while (m/(\w+)\((\w+)\)/g)
        {
            # If there were already some tags, add to existing
            $tag{$1} = (defined $tag{$1} ? "$tag{$1}|" : "") . $2;
        }
        print;
        next;
    }
    # else
    # Loop over all words; tag the ones we have a tag for
    s/(\w+)/defined $tag{$1} ? "$1($tag{$1})" : $1 /eg;
    print;

    # Flush tags for next iteration
    %tag = ();
}

请注意在未标记的行之前支持多个示例行;以及对单词的多个标签的支持。

答案 1 :(得分:1)

阅读第一行,构建一个哈希,用相应的标签映射单词。 逐字读取第二行,从散列中插入匹配的标记。

正则表达式可以简单:

line =~ / ([A-z]+)\(([A-z]+)\)/

答案 2 :(得分:0)

while ( <DATA> )
{
    if (m/\(/) {
        while (m/(\w+)(\(\w+\))/g) {
            $hash{$1}=$2;
        }
    }
    elsif (m/^\s+/) {
        push(@empty,$_)
    }
}

foreach (@empty) {
    s/[.,]/ /g;
    for (split(/\W/)) {
        printf("%s%s ", $_, $hash{$_});
    }
    print "\n";
}

输出:

The(Art) day(N) was windy(Adj) and(C) quite humid(Adj) here(Adv) in(P) London(PN)  
but(P) no problem at all  mate! We had(AuxV) planned(V) to(P) stay(V) at home anyway! 

答案 3 :(得分:0)

我会做类似的事情:

#!/usr/local/bin/perl 
use strict;
use warnings;

my %tags;
while (my $line = <DATA> ) {
    chomp $line;
    if($line =~ /^\S/) {
        while ($line =~ /(\w+)\((\w+)\)/g) {
            $tags{$1} = $2;
        }
    } else {
        my $res = '';
        for (split/(\W)/,$line) {
            $res .= $_ . (exists($tags{$_}) ? '('.$tags{$_}.')' : '');
        }
        print $res,"\n";
    }
}


__DATA__
The(Art) day(N) started(V) well(Adv), windy(Adj) and(C) humid(Adj), here(Adv) in(P) London(PN),
    The day was windy and quite humid here in London, 
but(P) we(Pr) did(AuxV) not(Adv) mind(V), because(P) we(Pr) had(AuxV) planned(V) to(P) stay(V) indoors(Adv) 
   but no problem at all, mate! We had planned to stay at home anyway! 

<强>输出:

注意它会保留标点符号。

    The(Art) day(N) was windy(Adj) and(C) quite humid(Adj) here(Adv) in(P) London(PN), 
   but(P) no problem at all, mate! We had(AuxV) planned(V) to(P) stay(V) at home anyway! 

答案 4 :(得分:0)

嗯,这是另一次尝试。我不使用空格和制表符作为分隔符,而是测试奇数和偶数行。这也会保留标点符号。

#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;

my %words;

my $c = 0;
while (my $line = <DATA>) {
    my @w = split(/\s+/, $line);
    foreach my $w (@w) {
        if (!($c % 2)) {
            $words{lc $1} = $2 if $w =~ /(\w+)\((\w+)\)/;
        } else {
            my $w2 = $w;
            $w2 =~ s/\W//g;
            if (exists $words{$w2}) {
                print $w, "($words{$w2}) ";
            } else {
                print "$w ";
            }
        }
    }
    $c++;
    print "\n";
}