《高阶Perl》——3.7　键的生成

3.7　键的生成

先前的记忆器至少有一个严重的问题。它需要把函数的参数转变成一个散列键，它的做法是使用join：

my $key = join ',', @_;

这对只带一个参数的函数有效，也对参数不含逗号的函数有效，包括所有的参数是数字的函数。但是如果函数的参数可能包含逗号，它可能失效，因为以下两个调用却计算出了相同的键：

func("x,", "y");
func("x", ",y");

第一次调用，返回的值将以键"x,,y"存放在缓存里。当第二次调用时，没有运行真实的函数。而第一次调用的缓存的值将返回。但是函数本可能想要返回一个不同的值的，记忆术的代码混淆了这两个参数列表，导致一次错误的缓存命中。

由于这只会对那些参数包含逗号的函数失效，这可能不是考虑要点。即使函数的参数包含逗号，也有可能有些它们绝不会包含的字符。Perl的特殊变量$;有时用在这里。它通常包含字符#28，即控制-反斜杠字符。如果键生成器使用join $;, @_，它只会在函数的参数包含控制-反斜杠时失效，一般可以确定这点将不会发生。但是经常有一个函数所带的参数会包含任何字符，这些不完整的特技不会可靠地工作。

这个可以被修正，因为总是有一种可靠的方法把任何数据结构，如这样一个参数列表，转换成一个字符串，那么不同的结构变成不同的字符串。

一个策略是使用模块Storable或FreezeThaw把参数列表转换成一个字符串。一个更有效率的策略是使用转义序列：

my @args = @_;
s/([\\,])/\\$1/g for @args;
my $key = join ",", @args;

这里在原始参数的每个逗号或反斜杠前面都插入一个反斜杠，然后用不带反斜杠的逗号连接在一起。先前看到的问题调用也不再是问题了，因为两个参数列表转换成不同的键了：一个是'x,,y'，另一个是'x,,y'。（一个练习：为什么在每个反斜杠前面也要像在逗号前面一样放置一个反斜杠呢？）

然而，正确性是用昂贵的性能代价换来的。转义字符代码比简单的join慢得多，大约慢十倍，即使对一个简单的参数列表如(1,2)，且它在每次调用函数时都必然会执行的。平常，我们嘲笑那些想用正确性交换速度的人，因为不管找到错误答案的速度多快都没有意义。但这是一个不平常的情况。因为记忆术的唯一目的就是加速一个函数，使开销尽可能小。

采取折中。memoize的默认行为将是快速的，但并不是在所有情况下都正确的。给memoize的用户一个应急出口修正。如果用户不喜欢默认的键生成方法，他们可以提供一个替代者，memoize将使用这个。

改变是简单的：

### Code Library: memoize-norm1
sub memoize {
  my ($func, $keygen) = @_;
  my %cache;
  my $stub = sub {
    my $key = $keygen ? $keygen->(@_) : join ',', @_;
    $cache{$key} = $func->(@_) unless exists $cache{$key};
    return $cache{$key};
  };
  return $stub;
}

被memoize返回的存根会检查原始函数带记忆时是否提供了$keygen函数。如果提供了，它就用这个keygen函数构造散列键；如果没有提供，它就用默认的方法。额外的测试相当便宜，但如果想对$keygen执行一次测试，在函数带记忆的时候，而不是每次调用带记忆的函数都来一次，那么就可以消除这额外的测试：

### Code Library: memoize-norm2
sub memoize {
  my ($func, $keygen) = @_;
  my %cache;
  my $stub = $keygen ?
    sub { my $key = $keygen->(@_);
          $cache{$key} = $func->(@_) unless exists $cache{$key};
          return $cache{$key};
        }
  :
    sub { my $key = join ',', @_;
          $cache{$key} = $func->(@_) unless exists $cache{$key};
          return $cache{$key};
        }
  ;
  return $stub;
}

可以有一个更棒的戏法。在memoize的这些版本中，$keygen是一个匿名函数，不得不在带记忆的函数每次调用时执行。不幸的是，Perl在函数调用上有相对大的开销，且由于memoize的目的是加快速度，如果能做到，则希望避免这个开销。

Perl的eval特性出现了。不再指定$keygen作为指向一个键生成函数的引用，传递一个字符串以包含生成键的代码，并把这代码直接合并入存根，而不是作为一个存根必须调用的子函数。

要使用这个版本的memoize，声明如下：

$memoized = memoize(\&fib, q{my @args = @_;
                             s/([\\,])/\\$1/g for @args;
                             join ',', @args;
                            });

memoize将把这一点代码插入带记忆的函数的模板里的合适位置（这称为内联（inlining））并使用eval把结果编译成一个真实的函数：

### Code Library: memoize-norm3
sub memoize {
  my ($func, $keygen) = @_;
  $keygen ||= q{join ',', @_};

  my %cache;
  my $newcode = q{
    sub { my $key = do { KEYGEN };
          $cache{$key} = $func->(@_) unless exists $cache{$key};
          return $cache{$key};
        }
  };
  $newcode =~ s/KEYGEN/$keygen/g;
  return eval $newcode;
}

这里使用Perl的q{...}操作符，除了单引号在q{...}里不再是特殊字符了，其他和'...'一样。q{...}结构在第一个匹配的}字符处结束。如果这里没有使用q{...}，第三行会相当晦涩难懂：

  $keygen ||= 'join \',\', @_';

用s///操作符内联$keygen的值，而不是简单地把它插入一个双引号字符串。这有一点效率损失，但是这只需要对每个带记忆的函数执行一次，所以这大概没关系。用s///技巧的好处是，$newcode变量很容易阅读；如果使用了字符串内插，它就会是如下这样的：

  my $newcode = "
    sub { my \$key = do { $keygen };
          \$cache{\$key} = \$func->(\@_) unless exists \$cache{\$key};
          return \$cache{\$key};
        }
  ";

代码里挤满了反斜杠。维护程序员阅读时可能不会注意到$keygen也被插值了，即便所有别的东西都带反斜杠了。使用s///技巧，KEYGEN显得清楚了。

对这个例子，缓存管理的开销比memoize内联的版本低大约37%。

很容易把这个版本稍微调整成和之前的一样仍然接受一个函数引用：

### Code Library: memoize-norm4
sub memoize {
  my ($func, $keygen) = @_;
  my $keyfunc;
  if ($keygen eq '') {
    $keygen = q{join ',', @_}
  } elsif (UNIVERSAL::isa($keygen, 'CODE')) {
    $keyfunc = $keygen;
    $keygen = q{$keyfunc->(@_)};
  }
  my %cache;
  my $newcode = q{
    sub { my $key = do { KEYGEN };
          $cache{$key} = $func->(@_) unless exists $cache{$key};
          return $cache{$key};
        }
  };
  $newcode =~ s/KEYGEN/$keygen/g;
  return eval $newcode;
}

这里，如果没有提供键生成器，则照常内联join ',', @_ 。如果$keygen是一个函数引用，则不能简单地内联它，因为它会变成像CODE(0x436c1d)的无用的东西。而是把函数引用保存在$keyfunc变量里，并内联一些将通过$keyfunc调用函数的代码。

这行代码UNIVERSAL::isa($keygen, 'CODE')需要解释一下。若要测试$keygen是否是一个代码引用。明显的做法如下：

if (ref($keygen) eq 'CODE') { ... }

不幸的是，Perl的ref函数失效了，因为它混淆了它的参数的两个不同的属性。如果$keygen是一个bless过的代码引用，上面的测试将会失败，因为ref将返回$keygen被bless的类名。使用UNIVERSAL::isa就避免了这个问题。也有可能，尽管可能性不大，那个测试会对一个非代码引用产生真；这会发生在如果有人愚蠢到把非代码引用bless进CODE类的情况下。

3.7.1　用户提供的键生成器的更多应用

有了这些键生成的功能，memoize函数的用户就有了一个应急出口，如果join方法没有尝试使带记忆的函数正确工作。他们可以以一个基于Storable的键生成器代替，或转义字符方法或合适的无论什么东西。

用户提供的键生成器解决了当两个不同的参数列表被弄成相同的键时出现的问题。它也解决了相反的问题，即当两个等价的参数列表被弄成不同的键时出现的问题。

考虑一个函数的参数是一个散列，可能包含键A、B和C中的任何一个或全部或一个都有没有，每个键关联一个数值。此外，假设如果B被省去，那B的默认值是17，A的默认值是32：

sub example {
  my %args = @_;
  $args{A} = 32 unless defined $args{A};
  $args{B} = 17 unless defined $args{B};
  # ...
}

那么以下调用都是等价的：

example(C => 99);
example(C => 99, A => 32);
example(A => 32, C => 99);
example(B => 17, C => 99);
example(C => 99, B => 17);
example(A => 32, C => 99, B => 17);
example(B => 17, A => 32, C => 99);
(etc.)

键的构造的join方法对这些调用产生不同的键（"C,99"对"A,32,C,99"对"C,99,A,32"等）。因此缓存管理将错过避免调用真实的example()函数的机会。调用一次example(A =>32,C =>99)必然和调用一次example(C =>99, A =>32)的结果一样，但是缓存管理不知道这个，因为参数列表看上去不一样。如果能安排等价的参数列表能转换成相同的散列键，那么缓存管理将对example(C =>99, A =>32)返回之前已经计算过的example(A =>32, C =>99)相同的结果，而不再冗余调用example()。这将增加缓存命中率，公式hfK中的h，该公式表现了记忆术带来的加速。下面的键生成器掌握了诀窍：

sub {
  my %h = @_;
  $h{A} = 32 unless defined $h{A};
  $h{B} = 17 unless defined $h{B};
  join ",", @h{'A','B','C'};
}

八个等价的调用（如example(c =>99,A =>22)就是其中之一）从这个函数得到同一个键"32,17,99"。预付的代价是：这个键生成器比简单的join生成器慢十倍，所以公式hfK里的K就更大。这个代价能否弥补回来，依赖于真实函数调用的开销f多大，也依赖于缓存命中率h的提升幅度。通常，基准比较测试是没有替代物的。

3.7.2　内联的参数归一化的缓存管理

这里有一个有趣的技巧，可以与内联的键生成代码。考虑下面的函数例子的一个变体：

sub example {
  my ($a, $b, $c) = @_;
  $a = 32 unless defined $a;
  $b = 17 unless defined $b;
  # more calculation here ...
}

一个合适的键生成器如下：

  my ($a, $b, $c) = @_;
  $a = 32 unless defined $a;
  $b = 17 unless defined $b;
  join ',', $a, $b, $c;

有点让人不快的是不得不重复设置参数默认值的代码，同样令人不快的是不得不运行两次。如果改变键生成如下代码，就能把参数检查从实例函数中移除：

$_[0] = 32 unless defined $_[0];
$_[1] = 17 unless defined $_[1];
join ',', @_;

当这个被内联入memoize函数时，结果如下：

sub { my $key = do { $_[0] = 32 unless defined $_[0];
                     $_[1] = 17 unless defined $_[1];
                     join ',', @_;
                   };
      $cache{$key} = $func->(@_) unless exists $cache{$key};
      return $cache{$key};
    }

注意这里会发生什么。键和以前一样生成，但有个边界效应：@_被改变了。如果有一个缓存脱靶，带记忆的函数就会以改变了的@_调用$func。由于@_已经被改变了包含默认的值，可以从原始函数省略设置默认值的代码：

sub example {
  my ($a, $b, $c) = @_;
## defaults set by key generation code
##  $a = 32 unless defined $a;
##  $b = 17 unless defined $b;
  # more calculation here ...
}

当然，一旦这样修改了example函数，就不能关闭记忆术了，因为本质的功能已经被移入键生成器了。

这项技术的另一个危险之处是改变@_会有个特殊效应返回调用的函数里。@_的元素被化名成回到主调者的相应的参数，在带记忆的函数里对@_元素的赋值可以改变在带记忆的函数外部的变量。这里有一个简单的例子：

sub set_to_57 {
  $_[0] = 57;
}

my $x = 119;
set_to_57($x);

它会把$x设成57，就像赋值$x = 57一样，即使赋值是在$x的作用域外执行的，$x不应受影响。在键生成器代码里的赋值有类似的功能。

Perl的这个特性有时是有用的，但多数情况下麻烦多于用处，通常应避免它。可以不直接操作@_，而是当函数被调用时，就把它的内容复制给一连串词法变量：

sub safe_function {
  my ($n) = @_;
  $n = 57; # does *not* set $x to 57
}

my $x = 119;
safe_function($x);

通过组合这些技术，可以得到一版键生成代码，它除去了真实函数中设置默认值的代码的需求，而且仍然是安全的：

memoize(\&example, q{
  my ($a, $b, $c) = @_;
  $a = 32 unless defined $a;
  $b = 17 unless defined $b;
  @_ = ($a, $b, $c);           # line 5
  join ',', @_;
});

@_的元素是回到主调函数的参数的别名，但是@_本身不是。第5行对@_的赋值不会覆盖主调者的值，它完全丢弃了别名并以新的值替代@_的内容。这个技巧只在键生成代码被内联入带记忆的函数时才有效；如果键生成代码是以子例程被调用，那么@_的改变在子例程返回后没有效果。

3.7.3　带有引用参数的函数

定制的键生成器的特性解决了另一个问题。考虑如下函数：

sub is_in {
  my ($needle, $haystack) = @_;
  for my $item (@$haystack) {
    return 1 if $item == $needle;
  }
  return;
}

函数接受$needle，即一个数字，以及$haystack，即一列数字，当且仅当$haystack包含$needle时返回真。一个典型的调用如下：

if (is_in($my_id, \@employee_ids)) { ... }

如果想要尝试使is_in带记忆，但是一个可能的问题是参数$haystack是一个引用。当它被join函数处理时，它变成一个像ARRAY(0x436c1d)的字符串。如果后来以指向一个别的具有相同内容的数组的参数$haystack调用is_in()，散列键将会不一样，这可能不是所需要的；相反，如果@employee_ids的内容改变了，散列键仍然是相同的，这肯定不是想要的。键生成器依照数组的同一性产生键，然而is_in()函数不关心数组的同一性，它只关心内容。这种情况下一个更合适的键生成函数是：

sub { join ",", $_[0], @{$_[1]} }

同样的，这实际上是否能带来性能优势依赖许多很难预见的情形。当性能很重要时，根本在于掌握真实的数据。长期的实践显示即便专家也时常猜错哪个快哪个慢。

3.7.4　划分

第1章的find_share函数提供了一个合适的函数的例子：记忆术修正了慢的递归，也需要一个定制的键生成器：

sub find_share {
  my ($target, $treasures) = @_;
  return [] if $target == 0;
  return    if $target < 0 || @$treasures == 0;
  my ($first, @rest) = @$treasures;
  my $solution = find_share($target-$first, \@rest);
  return [$first, @$solution] if $solution;
  return         find_share($target       , \@rest);
}

就像你将回忆起的，这个函数接受一个宝物数组和一个目标值，并尝试选出一组宝物的价值总和正好是目标值。如果有这么一组，它就返回一个只含这些宝物的数组；如果没有，它就返回undef。

第1章的这个函数有个和fib函数一样的问题：它会很慢，因为它一遍又一遍地重复同样的工作。当尝试从1 2 3 4 5 6 7 8 9 10中选出总和是53的宝物，find_share两次到达同样的位置：它发现1+2+3+6=12，并执行find_share(41, [7,8,9,10])，最终返回未定义值。后来，它又发现1+2+4+5=12，并第二次执行find_share(41, [7,8,9,10])。显然，这是一个尝试缓存的好机会。

即使这个简单的例子，记忆术也产生了大约68%的速度提升。对于更大的例子，如find_share(200, [1..20])，速度的提升更大，大约82%。在有些例子里，记忆术能区分实用的和不实用的算法。不带记忆的find_share(210, [1..20])比带记忆的版本耗时长几千倍。（我使用了键生成函数 sub {join "-", @{$_[1]}, $_[0]}。）

3.7.5　为非纯函数定制的键生成

定制的键生成也能用来处理这类函数，后者依赖它们参数以外的信息。
考虑一个长时间运行的网络服务程序，它的工作是卖东西，如披萨或武器级钚。一份披萨或一罐钚的价格包括运费，后者与相应的钟点和星期有关。晚上和周末发货比较贵，因为发货工人更少，且没人乐意在早上3点工作。这个服务程序可能包含一个如下这样的函数：

### Code Library: delivery-charge
sub delivery_charge {
  my ($quantity_ordered) = @_;
  my ($hour, $day_of_week) = (localtime)[2,6];
  # perform complex computation involving $weight, $gross_cost,
  #      $hour, $day_of_week, and $quantity_ordered
  # ...
  return $delivery_charge;
}

因为这个函数是复杂的，所以想要使其带记忆。默认的键生成器，join(',', @_)，在这里是不适合的，因为这将失去运费的时间依赖性。但是用这样的一个定制的键生成函数，可以简单解决问题：

sub delivery_charge_key {
  join ',', @_, (localtime)[2,6];
}

delivery_charge不是一个纯函数，但在这个例子里无关紧要。唯一的真正的问题是，是否有足够的缓存命中率赢得性能。可以预见函数在第一周会有许多缓存脱靶，直到一周过去，然后开始看到更多的缓存命中。在这个例子里，缓存的效能可能就依赖程序运行的寿命了。类似地，可能在想下面的键生成函数会更好：

sub delivery_charge_key {
  my ($hour, $day_of_week) = (localtime)[2,6];
  my $weekend = $day_of_week == 0 || $day_of_week == 6;
  join ',', @_, $hour, $weekend;
}

这个函数运行时间更长，但是可能得到更多的缓存命中率，因为它认识到周一缓存的值可以被再次用在周二和周三。同样的，哪个更好将取决于程序行为里的微妙因素。