Perl：使用尾調用優化以遞歸方式查找數組的總和

Question

我正在嘗試制作尾部優化的遞歸函數。

sub sum {
    my ($first, @rest) = @_;

    return @rest
        ? $first + sum(@rest)
        : $first;
}

say sum(1 .. 100);

它適用於100個元素，但是對於帶有Out of memory消息的100_000個元素，它會失敗。

如何改進代碼以使遞歸與更多元素一起工作？

編輯

尾調用以上功能的優化版：

use feature qw( current_sub );

sub sum_tco {
    my $loop = sub {
        my ($sum, $first, @rest) = @_;
        $sum += $first;

        return @rest
            ? __SUB__->($sum, @rest)
            : $sum;
    };

    return $loop->(@_);
}

Perl 5似乎不支持TCO。

如何在Perl中進行TCO（如果可能）？

Answer 1

Perl不執行尾調用優化是正確的。

如果你有一個尾調，你可以自己優化它。 但話雖如此，你沒有尾調。 遞歸調用之后是添加。

所以讓我們從更改sub開始只有尾調用。 這是通過傳遞執行最后一次操作所需的信息來完成的。

sub _sum {
   my ($acc, $first, @rest) = @_;
   $acc += $first;
   return @rest ? _sum( $acc, @rest ) : $acc;
}

sub sum {
   my (@rest) = @_;
   return undef if !@rest;
   return _sum( 0, @rest );
}

現在我們可以執行尾調用優化。

1. 將遞歸子例程的主體放在無限循環中。
2. 用do { @_ = ...; next; }替換recurse(...) do { @_ = ...; next; } do { @_ = ...; next; } do { @_ = ...; next; } 。

首先是助手。

sub _sum {
   while (1) {
      my ($acc, $first, @rest) = @_;
      $acc += $first;
      if (@rest) {
         @_ = ( $acc, @rest );
      } else {
         return $acc;
      }
   }
}

sub sum {
   my (@rest) = @_;
   return undef if !@rest;
   return _sum( 0, @rest );
}

然后在主要子。

sub sum {
   my (@rest) = @_;
   return undef if !@rest;

   @_ = ( 0, @rest );
   while (1) {
      my ($acc, $first, @rest) = @_;
      $acc += $first;
      if (@rest) {
         @_ = ( $acc, @rest );
      } else {
         return $acc;
      }
   }
}

完成。

...有點兒。 我們現在可以做很多其他的清理和優化。

讓我們從改善流程開始。

sub sum {
   my (@rest) = @_;
   return undef if !@rest;

   @_ = ( 0, @rest );
   while (1) {
      my ($acc, $first, @rest) = @_;
      $acc += $first;
      return $acc if !@rest;

      @_ = ( $acc, @rest );
   }
}

無需在每次循環中創建新的$acc 。

sub sum {
   my (@rest) = @_;
   return undef if !@rest;

   my $acc = 0;
   while (1) {
      my ($first, @rest) = @_;
      $acc += $first;
      return $acc if !@rest;

      @_ = @rest;
   }
}

沒有必要再使用@_了。

sub sum {
   my (@rest) = @_;
   return undef if !@rest;

   my $acc = 0;
   while (1) {
      (my $first, @rest) = @rest;
      $acc += $first;
      return $acc if !@rest;
   }
}

讓我們替換昂貴的列表分配。

sub sum {
   my (@rest) = @_;
   return undef if !@rest;

   my $acc = 0;
   while (1) {
      my $first = shift(@rest);
      $acc += $first;
      return $acc if !@rest;
   }
}

讓我們簡化循環。

sub sum {
   my (@rest) = @_;
   return undef if !@rest;

   my $acc = 0;
   while (@rest) {
      my $first = shift(@rest);
      $acc += $first;
   }

   return $acc;
}

讓我們用更便宜的foreach循環替換while循環。

sub sum {
   my (@rest) = @_;
   return undef if !@rest;

   my $acc = 0;
   for my $first (@rest) {
      $acc += $first;
   }

   return $acc;
}

$first和@rest不再是合適的變量名。 我們將在這個過程中擺脫一個無用的@_副本。

sub sum {
   return undef if !@_;

   my $acc = 0;
   $acc += $_ for @_;
   return $acc;
}

如果我們將$acc初始化$acc undef ，則不再需要初始檢查。

sub sum {
   my $acc;
   $acc += $_ for @_;
   return $acc;
}

田田！

Answer 2

這是使用我在評論中提到的goto功能的TCO版本：

#!/usr/bin/env perl
use warnings;
use strict;
use feature qw/say/;

sub sum {
    return undef if @_ == 0;
    return $_[0] if @_ == 1;
    splice @_, 0, 2, $_[0] + $_[1];
    goto ∑
}

say sum(1..100);
say sum(1..100_000);

從文檔 ：

goto和NAME表單與其他形式的goto完全不同。 事實上，它根本不是正常意義上的結果，並且沒有與其他結果相關的恥辱感。 相反，它退出當前子例程（丟失由本地設置的任何更改）並立即使用@_的當前值調用命名子例程

我不建議實際使用它，因為它真的，非常慢，相比其他任何東西，但它可以做到。

Answer 3

這是一種使用通用run - recur接口的技術。 這實際上是一個蹦床 -

sub recur (*@values) {
  :{ 'recur' => &recur, 'values' => @values }
}

sub run (&f) {
  my $r = &f();
  while $r.isa(Hash) && $r{'recur'} === &recur {
    $r = &f(|$r{'values'});
  }
  return $r;
}

要使用它，我們傳遞一個子程序來run循環參數及其初始值 -

sub sum ($n = 0) {
  run (sub ($m = $n, $r = 0) {
    if $m == 0 {
      return $r;
    }
    else {
      recur($m - 1, $r + $m);
    }
  })
}

注意我們使用recur和更新的參數，而不是直接調用sum 。 這是輸出 -

say sum(100_000);
# 100_000 + 99_999 + 99_997 + ... + 3 + 2 + 1 =
# => 5000050000

# cpu time: 10.61 sec

在這里，它正在研究范圍。 我們使用循環變量來跟蹤范圍索引， $i和返回值$r -

sub sum (@range) {
  run (sub ($i = 0, $r = 0) {
    if $i >= @range {
      return $r;
    }
    else {
      recur($i + 1, $r + @range[$i]);
    }
  })
}

say sum(5..10);
# 5 + 6 + 7 + 8 + 9 + 10 =
# => 45

say sum(0..0);
# => 0

say sum(1..100_000);
# => 5000050000

# cpu time: 14.37 sec

此處介紹的其他技術要求您大幅更改程序以避免堆棧溢出。 獨特的run - recur接口允許您遞歸地思考問題並允許它在恆定的空間中運行。

---

這是與Perl 5兼容的版本。令我驚訝的是，這個程序快了近50倍。 也許減速是由於較新的語法糖的執行不力？ 這是任何人的猜測......

use strict;
use warnings;

sub recur {
  { recur => \&recur, values => \@_ }
}

sub run {
  my ($f, @init) = @_;
  my $r = &{$f}(@init);
  while (ref $r eq ref {} && $r->{'recur'} == \&recur) {
    $r = &{$f}(@{$r->{'values'}});
  }
  return $r;
}

sub sum {
  my ($n) = @_;
  run (sub {
    my ($m, $r) = @_;
    if ($m == 0) {
      return $r;
    }
    else {
      recur($m - 1, $r + $m);
    }
  }, $n, 0);
}

print sum(100_000);
# => 5000050000

# cpu: 0.25 sec
# mem: 3 Mb

並且采用范圍輸入的sum變量 -

sub sum {
  my (@range) = @_;
  run (sub {
    my ($i, $r) = @_;
    if ($i >= @range) {
      return $r;
    }
    else {
      recur($i + 1, $r + $range[$i]);
    }
  }, 0, 0);
}

print sum(1..100_000);
# => 5000050000

# cpu: 0.27 sec
# mem: 12 Mb

Answer 4

在這篇文章的啟發下，一個文件調用自身的參數數量減少： 一個簡單的perl遞歸示例 。

當然，這遠非實際的解決方案。

#!/usr/bin/perl
use strict;
use warnings;
use feature qw(say);

# Init the args at the first call
if (!@ARGV) {exec join(' ', $^X, $0, 1 .. 100_000)}

# Show progress
if (@ARGV % 100 == 0) {say scalar @ARGV}

my ($sum, $first, @rest) = @ARGV;
$sum += $first;

@rest
    ? exec join(' ', $^X, $0, $sum, @rest)
    : say $sum;