4

考虑递归子程序append_until_exhausted。递归发生在主体的中间。我想把它放在最后进行进一步处理，也就是说一个简单的尾调用（没有任何优化，在 Perl 中通常涉及 a goto）。除了子例程和两个辅助子例程的签名之外，您可以更改任何内容。

涉及数字的算法看起来很愚蠢，因为它们是我真实代码的浓缩/混淆，但是子程序调用的代码执行路径/结构没有改变。

use 5.032;
use strictures;
use experimental qw(signatures);

# Returns mostly one value, sometimes multiple,
# and an occasional end condition which will cause
# the recursion to end because then the for loop will
# iterate over an empty list.
# This sub is also called from elsewhere,
# do not change, do not inline.
sub some_complicated_computation($foo) { # → ArrayRef[$foo]
    return [] if $foo > 45;
    return $foo % 5
        ? [$foo + 1]
        : [$foo + 2, $foo + 3];
}

# do not inline
sub make_key($foo) { # → Str
    chr(64 + $foo / 5)
}

sub append_until_exhausted($foo, $appendix) { # → HashRef[ArrayRef[$foo]]
    my $computed = some_complicated_computation($foo);
    for my $new_foo ($computed->@*) {
        {
            push $appendix->{make_key $new_foo}->@*, $new_foo;
        }
        __SUB__->($new_foo, $appendix);
    }
    return $appendix;
}

my $new_appendix = append_until_exhausted(
    7, # start value for foo
    { dummy => [], dummy2 => [], dummy3 => [], }
);

这里的目标是让我理解这个原理，以便我可以在类似的情况和类似的语言中应用它。如果您建议一些 {Sub::*, B::*, XS} 魔法，这将无济于事。

4

2 回答 2

3

由于您的递归调用在循环中，因此您不能使函数尾递归。好吧，当some_expensive_computation返回 0 或 1 个元素时，你可以，但只要它返回两个，就结束了。

我建议改用堆栈。基本上，将您的子更改append_until_exhausted为：

sub append_until_exhausted_stack($init_foo, $appendix) { # → HashRef[ArrayRef[$foo]]
    my @stack = ($init_foo);
    while (@stack) {
        my $foo = pop @stack;
        my $computed = some_complicated_computation($foo);
        for my $new_foo (@$computed) {
            push @{$appendix->{make_key $new_foo}}, $new_foo;
        }
        push @stack, @$computed;
    }
    return $appendix;
}

小警告：它不会按照与原始功能相同的顺序执行工作。如果这对您很重要，请查看 Ikegami 的回答。

我很快对它进行了基准测试，它似乎比递归实现快了不到 10%，所以没有那么多。基准代码如下：

sub append_until_exhausted($foo, $appendix) { # → HashRef[ArrayRef[$foo]]
    my $computed = some_complicated_computation($foo);
    for my $new_foo (@$computed) {
        {
            push @{$appendix->{make_key $new_foo}}, $new_foo;
        }
        __SUB__->($new_foo, $appendix);
    }
    return $appendix;
}


sub append_until_exhausted_stack($init_foo, $appendix) { # → HashRef[ArrayRef[$foo]]
    my @stack = ($init_foo);
    while (@stack) {
        my $foo = pop @stack;
        my $computed = some_complicated_computation($foo);
        for my $new_foo (@$computed) {
            push @{$appendix->{make_key $new_foo}}, $new_foo;
        }
        push @stack, @$computed;
    }
    return $appendix;
}

use Benchmark qw(:all);

cmpthese(2000, {
         'Recursive' => sub {
             append_until_exhausted(7, { dummy => [], dummy2 => [], dummy3 => [] })},
         'Stack'   => sub {
             append_until_exhausted_stack(7, { dummy => [], dummy2 => [], dummy3 => [] })},
         });

这会产生以下结果：

            Rate Recursive     Stack
Recursive 1384/s        --       -8%
Stack     1505/s        9%        --

我已经尝试通过添加特殊情况来对其进行一些优化，以避免将某些内容推入堆栈并立即将其删除，但它几乎不会影响性能（例如，执行$foo = $computed->[0]; redowhen @$computed == 1）。不过，可能值得尝试使用您的实际代码。

于 2020-11-13T11:20:24.997 回答
3

让我们从一个简单的例子开始。

sub fact($n) {
   return 1 if $n == 0;
   return $n * fact($n-1);
}

要进行尾递归，您需要将执行尾操作所需的信息与调用一起传递。

sub _fact($n, $acc) {
   return $acc if $n == 0;
   return _fact($n-1, $n * $acc);
}

sub fact($n) {
   return _fact($n, 1);
}

这个特殊的解决方案依赖于乘法是可交换的这一事实。（我们替换1*2*3*4为1*4*3*2.）所以我们仍然需要一个通用的方法。

通用方法将涉及将尾部作为回调传递。这意味着

if (TERMINAL_COND())
   return TERMINAL_VALUE();
} else {
   return TAIL(recursive(HEAD()))
}

变成

# Extra argument $tail
if (TERMINAL_COND()) {
   return $tail->(TERMINAL_VALUE());   # Tail call
} else {
   return recursive(HEAD(), sub {      # Tail call
      return $tail->(TAIL($_[0]);      # Tail call
   });
}

这给了我们以下信息：

sub _fact($n, $tail) {
   return $tail->(1) if $n == 0;
   return _fact($n-1, sub($fact) {
      return $tail->( $fact * $n );
   });
}

sub fact($n) {
   return _fact($n, sub($fact) { $fact });
}

这基本上就是 Promise 的工作方式。

# Promise is a fictional class akin
# to the JS one with the same name.

sub fact_p($n) {
   return Promise->new(1) if $n == 0;
   return fact_p($n-1)->then(sub($fact) {
      return $fact * $n;
   });
}

fact_p($n)->done(sub($fact) {
   say $fact;
});

你所拥有的要复杂得多，因为你有多个递归调用。但是我们仍然可以应用相同的技术。

# Loop body
sub __append_until_exhausted($appendix, $computed, $i, $tail) {
   if ($i == $computed->@*) {
      return $tail->();  # TC
   } else {
      my $new_foo = $computed->[$i];
      push $appendix->{make_key $new_foo}->@*, $new_foo;
      return _append_until_exhausted($appendix, $new_foo, sub {  # TC
         return __append_until_exhausted($appendix, $computed, $i+1, $tail);  # TC
      });
   }
}

# Function body
sub _append_until_exhausted($appendix, $foo, $tail) {
   my $computed = some_complicated_computation($foo);
   return __append_until_exhausted($appendix, $computed, 0, $tail);  # TC
}

# Public interface
sub append_until_exhausted($appendix, $foo) {
   return _append_until_exhausted($appendix, $foo, sub {  # TC
      return $appendix;
   });
}

我们可以避免以下所有额外的副本$appendix：

sub append_until_exhausted($appendix, $foo) {
   local *helper2 = sub($computed, $i, $tail) {
      if ($i == $computed->@*) {
         return $tail->();  # TC
      } else {
         my $new_foo = $computed->[$i];
         push $appendix->{make_key $new_foo}->@*, $new_foo;
         return helper1($new_foo, sub {  # TC
            return helper2($computed, $i+1, $tail);  # TC
         });
      }
   };

   local *helper1 = sub($foo, $tail) {
      my $computed = some_complicated_computation($foo);
      return helper2($computed, 0, $tail);  # TC
   };

   return helper1($foo, sub {  # TC
      return $appendix;
   });
}

Perl 不执行尾调用消除，并且函数调用相当慢。最好将数组用作堆栈。

这将按照与原始顺序相同的顺序执行工作：

sub append_until_exhausted($foo, $appendix) {
   my @todo = [ $foo, undef, 0 ];
   while (@todo) {
      my $todo = $todo[-1];
      \my ( $foo, $computed, $i ) = \( @$todo );
      $computed //= some_complicated_computation($foo);
      if ($i == $computed->@*) {
         pop(@todo);
         next;
      }

      my $new_foo = $computed->[$i++];
      push $appendix->{make_key $new_foo}->@*, $new_foo;
      push @todo, [ $new_foo, undef, 0 ];
   }

   return $appendix;
}

如果您不介意乱序进行复杂的计算（同时仍保留结果），则上述简化为以下内容：

sub append_until_exhausted($foo, $appendix) {
   my @todo = some_complicated_computation($foo);
   while (@todo) {
      my $computed = $todo[-1];
      if (!$computed->@*) {
         pop(@todo);
         next;
      }

      my $new_foo = shift(@$computed);
      push $appendix->{make_key $new_foo}->@*, $new_foo;
      push @todo, some_complicated_computation($new_foo);
   }

   return $appendix;
}
于 2020-11-13T20:07:32.883 回答