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

Recursive generator - manual zip vs operator

这是来自 Charles C Pinter 'A Book of Abstract Algebra' 的练习 5.F.2:

Let G be the group {e, a, b, b^2, b^3, ab, ab^2, ab^3} whose generators satisfy a^2 = e, b^4 = e, ba = ab^3. Write the table of G. (G is called the dihedral group 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;

结果 table 如下所示:

让我们关注 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 有 zipZ 运算符。

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

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 版本生成的问题是它挂起...

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

除了这个核心问题,欢迎分享探索和展示 Perl 6 的练习的替代解决方案。


作为另一个例子,这是来自同一本书的练习 5.F.3:

Let G be the group {e, a, b, b^2, b^3, ab, ab^2, ab^3} whose generators satisfy a^4 = e, a^2 = b^2, ba = ab^3. Write the table of G. (G is called the quaternion group.)

上面的程序显示 table:


顺便说一句,这个程序是从C#版本转换而来的。下面是 generate 使用 LINQ 和 ZipMany courtesy of 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#程序:link.

使用 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 的紧凑重写,它进行双向替换,仍然没有显式压缩:

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 }
}

为什么您使用 zip 不起作用

您的代码假定 [Z] ("reducing with the zip operator") 可用于获取列表列表的 transpose

不幸的是,这个在一般情况下不起作用
它 'usually' 有效,但在一个边缘情况下会中断:即,当列表列表恰好是 one 列表的列表时。观察:

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 的转置 return 处理得很好。第四个示例(0 个子列表)也做了正确的事情。
但是第三个例子(1 个子列表)并没有像人们期望的那样打印 a b c,即在那种情况下它没有 return @a 的转置,而是(它似乎) @a[0].

的转置

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

  • reduce 元运算符 [ ] 通过调用带有一个参数(所述元素)的运算符来处理具有单个元素的输入列表。
    如果您想知道,中缀运算符可以通过调用其函数对象仅使用一个参数来调用:&infix:<Z>( <a b c>, ).
  • zip 运算符 Z 和函数 zip(与其他接受嵌套列表的内置函数一样)遵循所谓的 "single-argument rule" – 即它的签名使用 single-argument slurpy parameter. This means that when it is called with a single argument, it will descend into it and consider its elements the actual arguments to use. (See also Slurpy conventions.)
    所以 zip(<a b c>,) 被视为 zip("a", "b", "c").

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

如何使用 zip

您可以检查 @arrs 的元素数量,以及 "exactly 1 sub-list" 的特殊情况:

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

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

[] 是一个“zen slice” - 它 return 列表未更改,但没有父数组包裹它的项目容器。这是必需的,因为for 循环会将包装在项目容器中的所有内容视为单个项目,并且只进行一次迭代。

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

如何把代码写得更优雅不用zip

参考.

这是 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。让我们也将 flatzip-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, $_) });
}

单独测试键和值似乎有点傻;您的字符串并不是真正的正则表达式,因此代码中的任何地方都不需要 //

sub generate($s, @eqs) {
    my @results = do for @eqs.kv -> $i, $equation {
        take $s.subst($equation, @eqs[ $i +^ 1 ]) if $s.index: $equation
    }

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

显然,对于此版本的 generate,您必须重写 table 才能使用 @eqs 而不是 %eqs