使用perl中的regex从字符串中提取子字符串？

Question

尝试提取匹配string中pattern的子串.例如,我有类似下面的文本

[ Pierre/NNP Vinken/NNP ]
,/, 
[ 61/CD years/NNS ]
old/JJ ,/, will/MD join/VB 
[ the/DT board/NN ]
as/IN 
[ a/DT nonexecutive/JJ director/NN Nov./NNP 29/CD ]
./. 
[ Mr./NNP Vinken/NNP ]
is/VBZ 
[ chairman/NN ]
of/IN 

我想在斜杠(/)和斜杠之后提取任何东西,但不知何故,我的正则表达式提取第一个子字符串并忽略该行中的其余子字符串.

我的输出如下所示:

tag:Pierre/NNP Vinken - word:Pierre/NNP Vinken/NNP ->1
tag:, - word:,/, ->1
tag:61/CD years - word:61/CD years/NNS ->1
tag:old/JJ ,/, will/MD join - word:old/JJ ,/, will/MD join/VB ->1
tag:the/DT board - word:the/DT board/NN ->1
tag:as - word:as/IN ->1
tag:a/DT nonexecutive/JJ director/NN Nov./NNP 29 - word:a/DT nonexecutive/JJ director/NN Nov./NNP 29/CD ->1
tag:. - word:./. ->1
tag:Mr./NNP Vinken - word:Mr./NNP Vinken/NNP ->1
tag:is - word:is/VBZ ->1
tag:chairman - word:chairman/NN ->1
tag:of - word:of/IN ->1

但我真正想要的是下面这样的东西

tag:NNP  - word:Pierre ->1
tag:NNP  - word:Vinken ->1
tag:,    - word:,      ->1
tag:CD   - word:61     ->1
.
.
etc.

我使用的代码:

    while (my $line = <$fh>) {
        chomp $line;
        #remove square brackets
        $line=~s/[\[\]]//;

        while($line =~m/((\s*(.*))\/((.*)\s+))/gi)
        {
            $word=$1;
            $tag=$2;
            #remove whitespace from left and right of string
            $word=~ s/^\s+|\s+$//g;
            $tag=~ s/^\s+|\s+$//g;
            $tags{$tag}++;
            $tagHash{$tag}{$word}++;
        }

    }
foreach my $str (sort keys %tagHash)
{
    foreach my $s (keys %{$tagHash{$str}} )
    {
        print "tags:$str - word: $s-> $tagHash{$str}{$s}\n";
    }
}

任何想法为什么我的正则表达式不应该表现出来

编辑:

在我正在解析的文本文件中也有野性字符和标点符号,这意味着文件将具有如下内容:''/''"/",/,./.？/？!/!...等等

所以我想要捕获所有这些东西,不仅仅是字母和数字字符.

Answer 1

整个模式周围最外面的一组括号被捕获到 中$1，这显然不是预期的。而且，贪婪.*\/意味着把一切都拖到最后 /。同样地，.*\s+只留下最后一个空格。

一种方法是使用否定字符类

my ($word, $tag) = m{ ([^/\s]+) / ([^/\s]+) }x;

该模式[^/\s]+匹配一​​串由一个或多个连续字符组成的字符串，每个字符都不是/或 空格。所以你会在前后得到一个“词/” 。如果你在斜杠后采取“无论什么按照文本所述

然后你的方法可以是

while (my $line = <$fh>) 
{
    while ( $line =~ m{ ([^/\s]+) / ([^/\s]+) }gx )
    {
        $tagHash{$2}{$1}++;
    }
}

其他计数似乎无关，所以我将其省略以专注于这个问题。

然而，这里有一个很大的缺失。

此方法无法检测行何时与预期格式不同。例如

字 1/标签 1 字 2/标签 2/ 标签 3/字 4/标签 4

悄悄地产生错误的结果。有些违规行为会被跳过，但也有很多不好的案例。

捕获此问题的一种方法是预处理该行，检查所有斜杠之间至少有两个单词，并且第一个斜杠之前和最后一个斜杠之后至少有一个单词。这意味着每行都会被处理两次，而且也会变得更加混乱。例如

while (my $line = <$fh>) 
{
    my @parts = split '/', $line;
    if (not shift @parts or not pop @parts or grep { 2 > split } @parts) {
        warn "Unexpected format: $line";
        next;
    }

    $tagHash{$2}{$1}++  while $line =~ m{ ([^/\s]+) / ([^/\s]+) }gx;
}

此检查会更改@parts数组，因此如果稍后需要该数组，则最好使用

if (!$parts[0] or !$parts[-1] or grep { 2 > split } @parts[1..@parts-2])  { ...

其中也可以使用List::Util中的grep短路代替any

另一种方法是改变方法，仔细解析该行，而不是盲目地跳过正则表达式匹配。由于第一个和最后一个可能只有一个单词，这可能很难用正则表达式来完成。仅拆分并使用数组可能更清晰、更实用。

很难想象一种格式总是与数据匹配，所以我建议考虑其中的一些。