扩展 [可选]、分组和 |或文本中的运算符

Question

我正在尝试扩展包含 [ ] 的句子以指示可选项，( ) 指示分组，以及 | 指示 or 运算符并枚举所有可能性。例如：

“嘿[那里]你[hood]。”应该返回四个句子：

Hey there you hood.
Hey there you.
Hey you hood.
Hey you.

最终目标如下：

输入：“（他|她）狗[非常|”非常]困惑。”

Output: His dog was very confused.
        His dog was extremely confused.
        His dog was confused.
        Her dog was very confused.
        Her dog was extremely confused.
        Her dog was confused.

我正在使用正则表达式匹配和递归来做到这一点。我在以下短语下搜索了 CPAN 和 SO：

扩展文本
扩展句子
扩展条件
扩展选项
扩大分组

但没有运气。

谢谢。

---

我编辑了这个问题，主要是为了更好地反映其演变，并删除了随着问题的演变而过时的大部分内容。上面的问题是下面大多数答案试图解决的问题。

我目前的状态如下：

在与上述问题搏斗一天后，我有两个非常接近我想要的解决方案。一张是我自己的，第二张是下面的 PLT。然而，我决定尝试一种完全不同的方法。

使用正则表达式并手动解析这些句子似乎是一种非常丑陋的做事方式。因此，我决定为我的“语言”编写语法，并使用解析器生成器为我解析它。

这给了我一个额外的抽象层，并避免了 Damian Conway 在 Perl 最佳实践中描述的以下场景：[关于正则表达式]

稍微剪切和粘贴并修改，哦，现在它根本不起作用，所以让我们修改一下，看看是否可以-那-帮助-不-它-没有-但是-我们现在承诺-所以-也许-如果-我们-改变-那-位-而不-嗯-那是-克洛Ser-但仍然不太对-也许-如果-我做了第三次重复-非贪婪-而不是-哎呀-现在-它-回到-根本不匹配--也许我应该将其发布到 PerlMonks.org 并看看他们是否知道出了什么问题

如果这些表达式的语法发生变化并且我稍后需要支持其他结构，它也会变得更加容易。

---

最后更新：

我使用开源工具包解决了我的问题。这将转录我的输入的 JSGF 版本并生成有限状态传感器。从那里您可以逐步完成 FST 以生成所有可能的结果。

Answer 1

好的，另一个对答案的完整修订。这将按预期工作。 :) 现在它还扩展了嵌套括号。换行符仍然是分隔符，但我添加了一种方法，可以在需要时将其快速更改为更复杂的内容。

基本上，我首先用括号 + 管道替换括号，因为 [word ] 和 (|word ) 是等效的。

然后，我提取了所有封装括号，例如 (you |myfriend) 和 (you |my (|friend)friend)。然后，我将嵌套括号扩展为常规括号，例如 (you |my (|friend )friend ) 被替换为 (you |myfriend |myfriend)。

完成后，可以使用原始子例程处理这些单词。

仍有待在更复杂的扩展上进行测试，但在我的测试过程中它运行良好。

这是修改后的代码：

use strict;
use warnings;

sub addwords {
    my ($aref, @words) = @_;
    my @total;
    for my $start (@$aref) {
        for my $add (@words) {
            push @total, $start . $add;
        }
    }
    return @total;
}

sub expand_words {
    my $str = shift;
    my @sentences = ('');
    for my $word (word_split($str)) {
        if ($word =~ /^([(])([^)]+)[)]$/) {
            my @options = split /\|/, $2;
            push @options, '' if ($1 eq '[');
            @sentences = addwords(\@sentences, @options);
        } else {
            @sentences = addwords(\@sentences, $word);
        }
    }
    return @sentences;
}

sub fix_parens {
    my $str = shift;
    $str =~ s/\[/(|/g;
    $str =~ s/\]/)/g;
    return $str;
}

sub fix_nested {
    my @array = @_;
    my @return;
    for (my $i=0; $i <= $#array; ) {
        my $inc = 1;
        my ($co, $cc);
        do {
            $co = () = $array[$i] =~ /\(/g;
            $cc = () = $array[$i] =~ /\)/g;
            if ( $co > $cc ) {
                $array[$i] .= $array[$i + $inc++];
            }
        } while ( $co > $cc );
        push @return, expand_nest($array[$i]);
        $i += $inc;
    }
    return @return;
}

sub expand_nest {
    my $str = shift;
    my $co = () = $str =~ /\(/g;
    return $str unless ($co > 1);
    while ($str =~ /([^|(]+\([^)]+\)[^|)]+)/) {
        my $match = $1;
        my @match = expand_words($match);
        my $line = join '|', @match;
        $match =~ s/([()|])/"\\" . $1/ge;
        $str =~ s/$match/$line/ or die $!;
    }
    return $str;
}

sub word_split {
    my $str = shift;
    my $delimeter = "\n";
    $str = fix_parens($str);
    $str =~ s/([[(])/$delimeter$1/g;
    $str =~ s/([])])/$1$delimeter/g;
    my @tot = split /$delimeter/, $str;
    @tot = fix_nested(@tot);
    return @tot;
}
my $str = "Hey [there ](you|my [friendly ]friend) where's my [red|blue]berry?";
my @sentences = expand_words($str);
print "$_\n" for (@sentences);
print scalar @sentences . " sentences\n";

将产生输出：

Hey you where's my berry?
Hey you where's my redberry?
Hey you where's my blueberry?
Hey my friend where's my berry?
Hey my friend where's my redberry?
Hey my friend where's my blueberry?
Hey my friendly friend where's my berry?
Hey my friendly friend where's my redberry?
Hey my friendly friend where's my blueberry?
Hey there you where's my berry?
Hey there you where's my redberry?
Hey there you where's my blueberry?
Hey there my friend where's my berry?
Hey there my friend where's my redberry?
Hey there my friend where's my blueberry?
Hey there my friendly friend where's my berry?
Hey there my friendly friend where's my redberry?
Hey there my friendly friend where's my blueberry?
18 sentences

Answer 2

Data::Generate。我在搜索组合时发现了这一点，这是您对单词集所做的数学术语。

Answer 3

如果您由于语法和正则表达式语法之间的冲突而克服了一些丑陋的正则表达式，那么这里有一个相当简单的解决方案。它允许使用 [] 和 () 语法，实际上它们非常相似， [foo] 与 (foo| ) 相同。

其基础是用标记 #0、#1、#2... 替换每个交替，同时将它们存储在数组中。然后替换最后一个标记，生成几个短语，然后替换每个短语中的倒数第二个标记......直到所有标记都被替换。 高阶 Perl 的细心读者无疑会找到一种更优雅的方法来做到这一点。

#!/usr/bin/perl

use strict;
use warnings;

while( my $phrase=<DATA>)
  { my $original= $phrase;
    $phrase=~s{\[([^\]]*)\]}{($1| )}g;           # replace [c|d] by (c|d| )
    my $alts=[]; my $i=0;
    while( $phrase=~ s{\(([^)]*)\)}{#$i})        # replace (a|b) ... (c|d| )  by #0 ... #1
      { push @$alts, [ split /\|/, $1 ]; $i++;   # store [ ['a', 'b'], [ 'c', 'd', ' '] ]
      }

    my $expanded=[$phrase];                       # seed the expanded list with the phrase

    while( @$alts) { expand( $alts, $expanded); } # expand each alternation, until none left

    print "$original    - ", join( "    - ", @$expanded), "\n\n";

  }

exit;

# expand the last #i of the phrase in all the phrases in $expanded
sub expand
  { my( $alts, $expanded)=@_;
    my @these_alts= @{pop(@$alts)};   # the last alternations 
    my $i= @$alts;                    # the corresponding index in the phrases

    @$expanded= map { my $ph= $_;               
                     map { my $ph_e= $ph;       
                           $ph_e=~ s{#$i}{$_};  # replace the marker #i by one option
                           $ph_e=~ s{ +}{ };    # fix double spaces
                           $ph_e;
                         } @these_alts          # for all options
                   } @$expanded                 # for all phrases stored so far
  }


__DATA__
(His|Her) dog was [very|extremely