使用 Perl Regex 解析语法树答案

【问题标题】：Parsing a Syntax Tree with Perl Regex使用 Perl Regex 解析语法树
【发布时间】：2010-12-23 13:03:38
【问题描述】：

也许正则表达式不是解析这个的最佳方法，如果不是，请告诉我。不管怎样，这里有一些语法树的例子：

(S (CC and))  
(SBARTMP (IN once) (NP otherstuff))   
(S (S (NP blah (VP blah)) (CC then) (NP blah (VP blah (PP blah))) ))

无论如何，我要做的是将连接词拉出（然后，一次等）及其相应的头（CC，IN，CC），我已经知道每个语法树，因此它可以充当一个锚点，我还需要检索它的父级（第一个是 S，第二个是 SBARTMP，第三个是 S）和它的兄弟姐妹，如果有的话（在第一个没有，在第二个左边的兄弟姐妹中，以及左侧和右侧的第三个兄弟）。不包括高于父级的任何内容

my $pos = "(\\\w|-)*";  
my $sibling = qr{\s*(\\((?:(?>[^()]+)|(?1))*\\))\s*};  
my $connective = "once";  
my $re = qr{(\(\w*\s*$sibling*\s*\\(IN\s$connective\\)\s*$sibling*\s*\))};

此代码适用于：

my $test1 = "(X (SBAR-TMP (IN once) (S sdf) (S sdf)))";  
my $test2 = "(X (SBAR-TMP (IN once))";  
my $test3 = "(X (SBAR-TMP (IN once) (X as))";  
my $test4 = "(X (SBAR-TMP (X adsf) (IN once))";

它会丢弃顶部的 X 并保留其他所有内容，但是，一旦兄弟姐妹中嵌入了东西，它就会不匹配，因为正则表达式没有深入。

my $test = "(X (SBAR-TMP (IN once) (MORE stuff (MORE stuff))))";

我不知道如何解释这一点。我对 Perl 的扩展模式有点陌生，刚开始学习它。为了澄清一下正则表达式的作用：它在两个括号和大写字母/-组合中查找连接词，查找以两个括号结尾的相同格式的完整父级，然后应查找任意数量的兄弟姐妹所有括号都配对。

【问题讨论】：

编写的解析器比我想记得的要多，我可以提供以下观察结果：您可以一次解析一个字符，也可以解析不正确。乍一看，正则表达式似乎是一种廉价的解析方式，但要让正则表达式解析器正确可靠几乎总是比艰难的方式做更多的工作。
你不能用正则表达式来操作这样的东西。即使由于一些奇怪的扩展在理论上是可能的，但处理这个问题的唯一明智的方法是在内存中重新构建实际的树，然后遍历它。
好吧，我就是这么想的，但我想确认一下。无论如何，这似乎是一个很好的起点stackoverflow.com/questions/3693323/… 还有其他建议吗？
几个小时前我们刚刚有一个解析示例：stackoverflow.com/questions/4517721/…

标签： regex perl syntax nlp

【解决方案1】：

要仅获得离锚连接词最近的“父级”，您可以将其作为具有 FAIL 的递归父级执行或直接执行。（由于某种原因，我无法编辑我的其他帖子，一定是 cookie 被删除了）。

use strict;
use warnings;

my $connective = qr/ \((?:IN|CC)\s(?:once|and|then)\)/x;
my $sibling = qr/
  \s*
  ( 
     (?! $connective )
     \(
        (?:
            (?> (?: [^()]+ ) )
          | (?-1)
        )*
     \)
  )
  \s*
 /x;

my $regex1 = qr/
      \( ( [\w-]+ \s* $sibling* \s* $connective \s* $sibling* ) \) #1
 /x;

my $regex2 = qr/
   ( #1
     \( \s*
        (  #2
           [\w-]+ \s*
           (?>   $sibling* \s* $connective (?(R)(*FAIL)) \s* $sibling*
               | (?1)
           )
        )
        \s*
     \)
   )
 /x;


my $sample = qq/
 (X (SBAR-TMP (IN once) (S sdf) (S sdf)))
 (X (SBAR-TMP (IN once))
 (X (SBAR-TMP (IN once) (X as))
 (X (SBAR-TMP (X adsf) (IN once))
 (X (SBAR-TMP (IN once) (MORE stuff (MORE stuff))))
 (S (CC and))  
 (SBARTMP (IN once) (NP otherstuff))   
 (S (S (NP blah (VP blah)) (CC then) (NP blah (VP blah (PP blah))) ))
/;

while ($sample =~ /$regex1/xg) {
    print "Found:   $1\n";
}
print '-' x 20, "\n";

while ($sample =~ /$regex2/xg) {
    print "Found:   $2\n";
}

__END__

【讨论】：

谢谢，效果很好，不过我想我可能会尝试使用 Lisp，因为我将来可能需要做更多的解析。

【解决方案2】：

你为什么放弃这个，你几乎拥有它。试试这个：

use strict;
use warnings;

 my $connective = qr/(?: \((?:IN|CC)\s(?:once|and|then)\) )/x;
 my $sibling = qr/
  \s*
  ( 
     (?!$connect)
     \(
        (?:
            (?> (?: [^()]+ ) )
          | (?-1)
        )*
     \)
  )
  \s*
 /x;

 my $regex = qr/
   ( #1
     \(
        \s* [\w-]+ \s*
        (?>   $sibling* \s* $connective \s* $sibling*
            | (?1)
        )
      \s*
     \)
   )
 /x;


my @tests = (
  '(X (SBAR-TMP (IN once) (S sdf) (S sdf)))',  
  '(X (SBAR-TMP (IN once))',
  '(X (SBAR-TMP (IN once) (X as))',
  '(X (SBAR-TMP (X adsf) (IN once))',
);

for my $sample (@tests)
{
    while ($sample =~ /$regex/xg) {
         print "Found:   $1\n";
    }
}

my $another =<<EOS;
(S (CC and))  
(SBARTMP (IN once) (NP otherstuff))   
(S
  (S
    (NP blah
      (VP blah)
    )
    (CC then)
    (NP blah
      (VP blah
        (PP blah)
      )
    )
  )
)
EOS

print "\n---------\n";
    while ($another =~ /$regex/xg) {
         print "\nFound:\n$1\n";
    }

结束

【讨论】：

看起来不错，我认为在我的 $sibling 中 $connect 应该是 $connective。对于第一个示例，它找到 (X )，它不应该找到。今天晚些时候，我会坐下来更清楚地阅读正则表达式。
所以你只想要最里面的父母。只需在 $connection 和最后一个 $siblings 之间添加一个条件，如下所示： (?> $sibling* \s* $connective (?(R)(FAIL)) \s $sibling* 在这种情况下，您可能不需要外部递归，但如果您改变主意，请保留它。如果它将为我格式化，将尝试在答案 2 中添加适当的完整代码。

【解决方案3】：

这应该也可以

use strict;
use warnings;

my $connective = qr/(?: \((?:IN|CC)\s(?:once|and|then)\) )/x;
my $sibling = qr/
  (?: \s*
  ( 
     (?!$connective)
     \(
        (?:
            (?> (?: [^()]+ ) )
          | (?-1)
        )*
     \)
  )
  \s* )
 /x;

my $regex = qr/
   ( #1
     \( \s*
        (  #2
           [\w-]+ \s*
           (?>   $sibling* \s* $connective (?(R)(*FAIL)) \s* $sibling*
               | (?1)
           )
        )
        \s*
     \)
   )
 /x;


my @tests = (
  '(X (SBAR-TMP (IN once) (S sdf) (S sdf)))',  
  '(X (SBAR-TMP (IN once))',
  '(X (SBAR-TMP (IN once) (X as))',
  '(X (SBAR-TMP (X adsf) (IN once))',
  '(X (SBAR-TMP (IN once) (MORE stuff (MORE stuff))))',    
);

for my $sample (@tests)
{
    while ($sample =~ /$regex/xg) {
        print "Found:   $2\n";
    }
}

my $another = "
(S (CC and))  
(SBARTMP (IN once) (NP otherstuff))   
(S (S (NP blah (VP blah)) (CC then) (NP blah (VP blah (PP blah))) ))
";

print "\n---------\n";
while ($another =~ /$regex/xg) {
    print "\nFound:\n$2\n";
}

__END__

【讨论】：