递归生成器 - 手动zip与运算符

Question

这是来自Charles C Pinter的"摘要代数之书"的练习5.F.2:

我们G是该组{e, a, b, b^2, b^3, ab, ab^2, ab^3},其发电机满足a^2 = e,b^4 = e,ba = ab^3.写下表G.(G称为二面体组D4.)

这是一个小的Perl 6程序,它提供了一个解决方案:

sub generate(%eqs, $s)
{
    my @results = ();

    for %eqs.kv -> $key, $val {
        if $s ~~ /$key/ { @results.push($s.subst(/$key/, $val)); }
        if $s ~~ /$val/ { @results.push($s.subst(/$val/, $key)); }
    }

    for @results -> $result { take $result; }

    my @arrs = @results.map({ gather generate(%eqs, $_) });

    my $i = 0;

    while (1)
    {
        for @arrs -> @arr { take @arr[$i]; }

        $i++;
    }
}

sub table(@G, %eqs)
{
    printf "     |";   for @G -> $y { printf "%-5s|", $y; }; say '';

    printf "-----|";   for @G -> $y { printf "-----|";    }; say '';

    for @G -> $x {

        printf "%-5s|", $x;

        for @G -> $y {
            my $result = (gather generate(%eqs, "$x$y")).first(* (elem) @G);

            printf "%-5s|", $result;
        }
    say ''
    }    
}

# ----------------------------------------------------------------------

# Pinter 5.F.2

my @G = <e a b bb bbb ab abb abbb>;

my %eqs = <aa e   bbbb e   ba abbb>; %eqs<e> = '';

table @G, %eqs;

这是结果表的样子:

让我们关注以下特定线generate:

my @arrs = @results.map({ gather generate(%eqs, $_) });

my $i = 0;

while (1)
{
    for @arrs -> @arr { take @arr[$i]; }

    $i++;
}

generate对每个项目进行递归调用@results.然后我们在结果序列上有效地执行手动"zip".但是,Perl 6 zip和Z运营商有关.

而不是以上几行,我想做这样的事情:

for ([Z] @results.map({ gather generate(%eqs, $_) })).flat -> $elt { take $elt; }

所以这里是完整的generate使用Z:

sub generate(%eqs, $s)
{
    my @results = ();

    for %eqs.kv -> $key, $val {
        if $s ~~ /$key/ { @results.push($s.subst(/$key/, $val)); }
        if $s ~~ /$val/ { @results.push($s.subst(/$val/, $key)); }
    }

    for @results -> $result { take $result; }

    for ([Z] @results.map({ gather generate(%eqs, $_) })).flat -> $elt { take $elt; }
}

Z生成版本的问题是它挂起......

所以,我的问题是,有没有办法generate用Z？

除了这个核心问题,请随意分享探索和展示Perl 6的练习的替代解决方案.

---

另一个例子,这里是同一本书的练习5.F.3:

设G组{e, a, b, b^2, b^3, ab, ab^2, ab^3},其发电机满足a^4 = e,a^2 = b^2,ba = ab^3.写下表G.(G称为四元数组.)

以上显示表格的程序:

---

顺便说一下,这个程序是从C#中的版本转换而来的.以下是generate使用LINQ和ZipMany版本的Eric Lippert的看法.

    static IEnumerable<string> generate(Dictionary<string,string> eqs, string s)
    {
        var results = new List<string>();

        foreach (var elt in eqs)
        {
            if (new Regex(elt.Key).IsMatch(s))
                results.Add(new Regex(elt.Key).Replace(s, elt.Value, 1));

            if (new Regex(elt.Value).IsMatch(s))
                results.Add(new Regex(elt.Value).Replace(s, elt.Key, 1));
        }

        foreach (var result in results) yield return result;

        foreach (var elt in ZipMany(results.Select(elt => generate(eqs, elt)), elts => elts).SelectMany(elts => elts))
            yield return elt;
    }

整个C#程序:链接.

Answer 1

为什么你的使用zip不起作用

您的代码假定[Z]("使用zip运算符减少")可用于获取列表列表的转置.

不幸的是,这在一般情况下不起作用.
它"通常"有效,但在一个边缘情况下中断:即,当列表列表是一个列表时恰好是一个列表.注意:

my @a = <a b c>, <1 2 3>, <X Y Z>; put [Z~] @a;  # a1X b2Y c3Z
my @a = <a b c>, <1 2 3>;          put [Z~] @a;  # a1 b2 c3
my @a = <a b c>,;                  put [Z~] @a;  # abc
my @a;                             put [Z~] @a;  # 

在前两个示例(3个和2个子列表)中,您可以看到转置@a已经很好.第四个例子(0个子列表)也是正确的.
但是第三个例子(1个子列表)并没有a b c像人们预期的那样打印,即它没有返回@a那种情况下的转置,而是(似乎)它的转置@a[0].

遗憾的是,这不是一个Rakudo错误(在这种情况下它可以简单地修复),但两个Perl 6设计决策的不可预见的交互,即:

• 在减少元运营商[ ]通过调用它应用到一个参数(该元件)的运营商处理与单个元素的输入列表.
  如果您想知道,通过调用其函数对象,只能使用一个参数调用中缀运算符: &infix:<Z>( <a b c>, ).
• 该拉链操作Z和功能zip(如接受嵌套列出了其他的内置插件),遵循所谓的"单参数的规则" -即其签名采用的是单参数slurpy参数.这意味着当使用单个参数调用它时,它将进入它并将其元素视为要使用的实际参数.(参见Slurpy惯例.)
  因此zip(<a b c>,)被视为zip("a", "b", "c").

这两个功能在许多其他情况下提供了一些很好的便利,但在这种情况下,他们的交互令人遗憾地构成陷阱.

如何使它工作 zip

您可以检查元素的数量@arrs,以及特殊情况下的"正好1个子列表"情况:

my @arrs = @results.map({ gather generate(%eqs, $_) });

if @arrs.elems == 1 {
    .take for @arrs[0][];
}
else {
    .take for flat [Z] @arrs
}

这[]是一个" zen slice " - 它返回列表不变,但是没有父Array包含它的item容器.这是必需的,因为for循环会将包装在item容器中的任何内容视为单个项目并且只进行一次迭代.

当然,这个if-else解决方案不是很优雅,这可能会否定你尝试首先使用的理由zip.

如何更优雅编写代码,而不 zip

请参阅Christoph的答案.

Answer 2

它可能有一个Z,但对于我可怜的小脑,拉链递归生成的懒惰列表太多了.

相反,我做了一些其他的简化:

sub generate($s, %eqs) {
    take $s;

    # the given equations normalize the string, ie there's no need to apply
    # the inverse relation
    for %eqs.kv -> $k, $v {
        # make copy of $s so we can use s/// instead of .subst
        my $t = $s;
        generate $t, %eqs
            if $t ~~ s/$k/$v/;
    }
}

sub table(@G, %eqs) {
    # compute the set only once instead of implicitly on each call to (elem)
    my $G = set @G;

    # some code golfing
    put ['', |@G]>>.fmt('%-5s|').join;
    put '-----|' x @G + 1;

    for @G -> $x {
        printf '%-5s|', $x;

        for @G -> $y {
            printf '%-5s|', (gather generate("$x$y", %eqs)).first(* (elem) $G);
        }

        put '';
    }    
}

my @G = <e a b bb bbb ab abb abbb>;

# use double brackets so we can have empty strings
my %eqs = <<aa e   bbbb e   ba abbb   e ''>>;

table @G, %eqs;

这是一个紧凑的重写generate,它进行双向替换,仍然没有显式的zip:

sub generate($s, %eqs) {
    my @results = do for |%eqs.pairs, |%eqs.antipairs -> (:$key, :$value) {
        take $s.subst($key, $value) if $s ~~ /$key/;
    }

    my @seqs = @results.map: { gather generate($_, %eqs) }
    for 0..* -> $i { take .[$i] for @seqs }
}

Answer 3

这是一个generate使用smls演示的方法的版本:

sub generate(%eqs, $s)
{
    my @results = ();

    for %eqs.kv -> $key, $val {
        if $s ~~ /$key/ { @results.push($s.subst(/$key/, $val)); }
        if $s ~~ /$val/ { @results.push($s.subst(/$val/, $key)); }
    }

    for @results -> $result { take $result; }

    my @arrs = @results.map({ gather generate(%eqs, $_) });

    if @arrs.elems == 1 { .take for @arrs[0][]; }
    else { .take for flat [Z] @arrs; }
}

我测试了它,它适用于练习2和3.

正如smls在他的回答中提到的那样,zip当给定的数组数组只包含一个数组时,没有做到我们所期望的.所以,让我们做一个版本,zip它确实有一个或多个阵列的工作:

sub zip-many (@arrs)
{
    if @arrs.elems == 1 { .take for @arrs[0][];     }
    else                { .take for flat [Z] @arrs; }
}

现在,generate就以下方面而言zip-many:

sub generate(%eqs, $s)
{
    my @results = ();

    for %eqs.kv -> $key, $val {
        if $s ~~ /$key/ { @results.push($s.subst(/$key/, $val)); }
        if $s ~~ /$val/ { @results.push($s.subst(/$val/, $key)); }
    }

    for @results -> $result { take $result; }

    zip-many @results.map({ gather generate(%eqs, $_) });
}

看起来很不错.

谢谢smls!

smls在下面的评论中建议zip-many不要调用take,留下来generate.让我们动也flat从zip-many到generate.

瘦身zip-many:

sub zip-many (@arrs) { @arrs == 1 ?? @arrs[0][] !! [Z] @arrs }

和它generate一起去:

sub generate(%eqs, $s)
{
    my @results;

    for %eqs.kv -> $key, $val {
        if $s ~~ /$key/ { @results.push($s.subst(/$key/, $val)); }
        if $s ~~ /$val/ { @results.push($s.subst(/$val/, $key)); }
    }

    .take for @results;

    .take for flat zip-many @results.map({ gather generate(%eqs, $_) });
}