如何重构 for 循环中发生的递归以使其成为尾调用?
How do I refactor a recursion occurring in a for loop to make it a tail call?
考虑递归子例程append_until_exhausted
。递归发生在主体的中间。我想把它放在最后进行进一步处理,也就是说一个简单的尾调用(没有任何优化,在 Perl 中通常涉及 goto
)。除了子例程的签名和两个辅助子例程之外,您可以更改任何内容。
涉及数字的算法看起来很愚蠢,因为是我的真实代码condensation/obfuscation,但是子程序调用的代码执行path/structure没有变化。
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} 魔术,这也无济于事。
由于您的递归调用是在一个循环内进行的,因此您不能使您的函数尾递归。好吧,当some_expensive_computation
returns 0个或1个元素时,你可以,但是一旦returns两个,就结束了。
我建议改用堆栈。基本上,将您的 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% --
我尝试通过添加特殊情况对其进行一些优化,以避免将某些东西压入堆栈并立即将其删除,但它几乎不会影响性能(例如,在 [=16= 时执行 $foo = $computed->[0]; redo
]).不过可能值得尝试使用您的实际代码。
让我们从一个简单的例子开始。
sub fact($n) {
return 1 if $n == 0;
return $n * fact($n-1);
}
要制作一些东西tail-recursive,您需要在调用时传递执行尾部操作所需的信息。
sub _fact($n, $acc) {
return $acc if $n == 0;
return _fact($n-1, $n * $acc);
}
sub fact($n) {
return _fact($n, 1);
}
这个特殊的解决方案依赖于乘法是可交换的这一事实。 (我们用 1*4*3*2
替换了 1*2*3*4
。)所以我们仍然需要一个通用的方法。
一种通用的方法是将尾巴作为回调传递。这意味着
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 });
}
这就是 Promises 的基本工作方式。
# 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 不执行 tail-call 消除,函数调用相当慢。你最好使用数组作为堆栈。
这将按照与原始顺序相同的顺序执行工作:
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;
}
考虑递归子例程append_until_exhausted
。递归发生在主体的中间。我想把它放在最后进行进一步处理,也就是说一个简单的尾调用(没有任何优化,在 Perl 中通常涉及 goto
)。除了子例程的签名和两个辅助子例程之外,您可以更改任何内容。
涉及数字的算法看起来很愚蠢,因为是我的真实代码condensation/obfuscation,但是子程序调用的代码执行path/structure没有变化。
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} 魔术,这也无济于事。
由于您的递归调用是在一个循环内进行的,因此您不能使您的函数尾递归。好吧,当some_expensive_computation
returns 0个或1个元素时,你可以,但是一旦returns两个,就结束了。
我建议改用堆栈。基本上,将您的 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% --
我尝试通过添加特殊情况对其进行一些优化,以避免将某些东西压入堆栈并立即将其删除,但它几乎不会影响性能(例如,在 [=16= 时执行 $foo = $computed->[0]; redo
]).不过可能值得尝试使用您的实际代码。
让我们从一个简单的例子开始。
sub fact($n) {
return 1 if $n == 0;
return $n * fact($n-1);
}
要制作一些东西tail-recursive,您需要在调用时传递执行尾部操作所需的信息。
sub _fact($n, $acc) {
return $acc if $n == 0;
return _fact($n-1, $n * $acc);
}
sub fact($n) {
return _fact($n, 1);
}
这个特殊的解决方案依赖于乘法是可交换的这一事实。 (我们用 1*4*3*2
替换了 1*2*3*4
。)所以我们仍然需要一个通用的方法。
一种通用的方法是将尾巴作为回调传递。这意味着
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 });
}
这就是 Promises 的基本工作方式。
# 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 不执行 tail-call 消除,函数调用相当慢。你最好使用数组作为堆栈。
这将按照与原始顺序相同的顺序执行工作:
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;
}