Ted 将带您进一步了解如何使用 Perl 遗传算法。他将继续研究他在其有关遗传算法的第一篇专栏文章中未完成的主题：使用列表，该列表寻找某一个体的 DNA 中的一组字典单词。
遗传算法是一种比较有趣的算法。遗传算法模仿达尔文的自然选择，其中“适应性”选择进行生存、繁殖以及由此而来的适应性变异的个体。我在 前一篇专栏文章中介绍了有关的背景知识，而且还演示了两个 Perl 实现，一个实现产生字节而另一个实现产生单词。
在本文中，我将介绍有关 Perl 遗传算法更高级的内容。在阅读本文之前，您或许需要回过头阅读前一篇文章；遗传算法有定义良好的步骤，本文中有些代码利用了前一篇文章中的代码而没有说明细节。
在您开始之前，您应当在系统上安装了 Perl 5.6.0 或更新版本。本文的示例也许可以在 Perl 的较早版本和常见 UNIX 平台以外的平台（如 Windows）上运行，但它们没有在这些环境中进行过测试，要使代码能在这些环境中正常运行可能需要额外的工作。
再度研究单词
前一篇文章演示了一个示例，该示例在个体的 DNA 中寻找一小组字典单词，然后根据个体的 DNA 有多少字典单词（越长越好）对个体分级。
这里，我们就从这个字典示例开始，对它加以修改，如 清单 1（请下载 commands.pl中的完整源代码）所示。现在，每个单词（DNA 中的单词由空格分开）是一条增加或减少个体适应性的指令。如果您制定的规则使得适应性很难获取，则您的初始种群就没有增长的希望。如果您的规则过于宽松，则个体适应性不会随着时间的推移而稳定地增加，使得遗传算法毫无用处。
在用完全随机的无意义数据启动后，个体能很快地适应这些新的规则并利用它们取得较高的分数，这并不令人惊奇。让人惊奇的是规则以出乎意料的方式被利用。例如，当我制定了一个规则，规定数字指令对该数字设置适应性时，DNA 会删除所有其它指令而只支持这个数字指令。当我减少无效指令的适应性以避免 DNA 全部成为数字型时，个体只是将数字指令移到 DNA 的末尾，数字指令在那里不会受到无效指令的影响。
清单 1. commands.pl fitness() 函数 # calculate the fitness of the DNA
sub fitness
{
my $dna = shift @_;
my @words = split ' ', dna_to_words($dna);
my $fitness = 0; # start with 0 fitness
my $max_entry_length = 20; # longest word we accept
# note that the 'words' here are command words or numbers
foreach my $word (@words) # execute all the words as "instructions"
{
if ($word eq 'M') # 'multiply' instruction
{
$fitness *= 2;
}
elsif ($word =~ /^A\D*(\d+)/) # 'amplify' instruction
{
$fitness *= $1
}
elsif ($word =~ /(\d+)/) # if the instruction is a number
{
$fitness += length($1); # increase the fitness depending on the run of digits
}
else
{
$fitness *= 0.80; # the punishment for a 'bad' instruction
}
}
return $fitness;
} # end of fitness()
当谈到 DNA 和个体时，我把它们当成有生命的一样。在某种意义上，它们的确如此。我永远不会忘记，当我给它们施加强迫性规则时，它们“反应冷淡”，而当规则允许它们以我不曾预计到的方式急剧增加其适应性时，它们是多么的“生气勃勃”。请试着在 fitness() 函数中引入一些新规则，然后亲眼看一看个体是如何进化从而生存的。
更大的难题
在完成了前一节的命令结构后，我问自己接下来要做什么。我可以改进算法，添加诸如表现型（phenotype）或更灵活的规则之类的小功能部件，或者可以进一步改进 fitness() 函数。
在 参考资料一节中，有指向 MyBeasties 的链接，这是用于遗传算法应用程序的高级 Perl 模块。我不指望依靠那个模块用于实现遗传算法的全面技术，来改进我的项目，但在我们目前已构建的框架内，我可以生成几个不需要更高级的遗传算法技术的有趣示例。
我实现了一系列指令（从 A 点移到 B 点）作为下一个适应性测试。每个个体从 A 点开始，并且其适应性为 1，然后个体可以根据它与 B 点的接近程度来增加它的适应性。命令“U”、“D”、“L”或“R”分别代表上移、下移、左移或右移。命令“B”则代表后退。命令后的数字指出该命令将运行多少次。
在移动过程中，个体必须遵循某个路径。个体离开该路径时会被给予一个适应性，该适应性与个体在路径上走过的距离成比例。请参阅 清单 2；在 motion.pl中有完整的代码。个体有规律地以 110 字节 DNA 在路径上走 9 步；作为必然的结果，更长的 DNA 意味着允许个体在路径上走得更远。没有数字参数，个体实际上似乎做得更好一些，可能是因为在指令较简单时，变异不太可能损坏 DNA 吧。人类 DNA 只有 4 种基本组成部分（通常写作 G、A、T 和 C），因此这不是一种牵强附会的理论。
请注意实现命令的方式，使用一个灵活的动作堆栈和一个“后退”命令，该命令是用和其余指令（作为 %instructions 散列的成员）一致的方式来调用的。此外， Math::Complex 模块的使用使得模拟二维运动成了小事一桩。添加更多的指令也变得很容易。（您能实现一个“重复上一条指令”的函数吗？）对于遵循路径的指令，还要注意适应性的急剧增加。
清单 2. motion.pl fitness() 函数 # calculate the fitness of the DNA
sub fitness
{
my $dna = shift @_;
my @words = split ' ', dna_to_words($dna);
my $fitness = 2; # start with a small fitness
my $location = Math::Complex->make(0,0); # starting coordinates
# "ideal" coordinates
my $goal = Math::Complex->make(10,10);
# the path to the goal the DNA instructions must follow
my @path = split ' ', 'U U U R R R U U U R R R U U U R R R U R';
my $path_followed = 1;
# keep track of motion stack (array)
my @motion_stack;
# set up motion instructions
my $instructions = {
U => Math::Complex->make( 0, 1),
D => Math::Complex->make( 0,-1),
L => Math::Complex->make(-1, 0),
R => Math::Complex->make( 1, 0),
B => # move back
sub {
my $location = shift @_;
my $motion_stack = shift @_;
my $instructions = shift @_;
my $old_motion = pop @$motion_stack;
$location += $instructions->{$old_motion} if defined $old_motion;
return $location;
},
};
# note that the 'words' here are command words or numbers
foreach my $word (@words) # execute all the words as "instructions"
{
# only handle legitimate instructions (they can be embedded in bigger words)
my ($motion, $mag) = $word =~ m/([A-Z])(\d*)/;
if ($motion && exists $instructions->{$motion})
{
$mag = 1 unless $mag; # always run at least once
my $instruction = $instructions->{$motion};
foreach (1..$mag)
{
if (ref $instruction eq 'Math::Complex')
{
$location += $instruction; # use the motion vector
push @motion_stack, $motion;
}
elsif (ref $instruction eq 'CODE')
{
$location = $instruction->($location, \@motion_stack, $instructions);
# use the subroutine
}
}
}
}
# now see if the individual followed the necessary path
# (if he didn't, he "fell off the cliff")
foreach my $path_instruction (@path)
{
my $instruction = shift @motion_stack;
# get the actually executed instruction
if (defined $instruction && $instruction eq $path_instruction)
{
# increase fitness, this individual followed the proper path
$fitness *= 2;
$path_followed = 1; # the individual has not strayed
}
else
{
# increase fitness a little, so the individual is rewarded for
# having followed the path this far
$fitness++;
$path_followed = 0; # the individual has strayed, though
last;
}
}
if ($location == $goal && $path_followed)
{
# no point continuing, the individual found the target
die "Individual [@words] reached the target!"; }
return $fitness;
} # end of fitness()
回到单词
在前一篇文章中，我们使用 DNA 作为词源，并且根据单词的长度，对那些在我们的字典内的单词，“奖赏”个体的适应性。 清单 3（在 words2.pl 中有完整的代码）采用了前一篇文章中的原始思想，但通过 String::Approx 模块（您可能必须要安装它）进行近似匹配。这一思想不但“奖赏”精确匹配，也“奖赏”近似匹配（如百分比）。采用按比例增减的方法是最好的，但那会极大地增加算法的复杂性。
对原始代码的重写被证明是非常值得的，它有规律地在 40 代内产生三个字母的单词。近似匹配确保了相应地“奖赏”有成功可能的 DNA 模式。不仅根据匹配，还根据在 DNA 中产生更长单词的单词的长度，来进行“奖赏”。
fitness() 函数与最初示例中的相似，但“奖赏”的结构有所不同，而且循环实际上也进行了简化。请注意，精确匹配如何比近似匹配明显更有价值。
清单 3. words2.pl fitness() 函数 # this is a closure block!
{
# private static variable @dictionary in closure for fitness() only
my @dictionary;
# calculate the fitness of the DNA
sub fitness
{
my $dna = shift @_;
my @words = split ' ', dna_to_words($dna);
my $fitness = 0; # start with 0 fitness
my $max_entry_length = 20; # longest word we accept
my $precision = 90; # matching precision, in percent
my $imprecision = 100 - 90;
die "Can't use a negative imprecision (your precision must
be less than 100 but it's $precision)"
if $imprecision < 0;
# you can use any word list at the end of the program
# do the @dictionary initialization just once
unless (@dictionary)
{
@dictionary = <DATA>;
foreach (@dictionary)
{
chomp;
}
# eliminate words over $max_entry_length letters, and uppercase them
@dictionary = grep { length($_) > 1 && length($_) < $max_entry_length }
map { uc } @dictionary;
}
# there is no easy way to avoid this exhaustive check of the dictionary
# without complicating this example too much
foreach my $word (@words)
{
next unless length $ word > 1; # don't use single letters
# note we use "S#%", we don't want insert/append similarities,
# only replacement similarities
my @matches = amatch($word, "$imprecision%", @dictionary);
my @precise_matches = grep { $word eq $_ } @dictionary;
$fitness += scalar @matches;
$fitness += (10 ** length $_) foreach @precise_matches;
# reward longer words significantly more
}
return $fitness;
} # end of fitness()
}
结束语
我希望您和我一样觉得运行本文的示例很有趣。不要害怕使用参数和 fitness() 函数。如果您有兴趣在自己的应用程序中使用遗传算法，一定要研究 MyBeasties（请参阅 参考资料一节）。因为速度常常是遗传算法实现的一个问题，因此在大多数情况下必须对算法进行大量优化，几乎没有以各种编程语言实现的可行的通用遗传算法工具箱。MyBeasties 是有用而且相当快的工具箱的良好示例。
遗传算法应用程序领域有无限的潜力。如果量子超级计算机开发成功，那么对于解决某些问题，遗传算法将迅速成为不仅可行而且更优越的方法。量子计算对问题许多可能的解决方案的同步计算的这一前提，似乎注定就适应遗传算法用其巨大的样本种群进行进化计算这一前提。
参考资料
commands.pl
motion.pl
words2.pl
Parsing with Perl modules（ developerWorks，2000 年 4 月）
Perl：化繁为简( developerWorks，2000 年 6 月）
用 Perl 保存（ developerWorks，2000 年 7 月）
Writing Perl programs that speak English（ developerWorks，2000 年 8 月）
《Programming Perl》第三版简介（ developerWorks，2000 年 9 月）
轻松调试 Perl （ developerWorks，2000 年 11 月）
Application configuration with Perl（ developerWorks，2000 年 10 月）
吸引 C 和 Java 程序员目光的 Perl 5.6 （ developerWorks，2001 年 1 月）
程序员面向 Linux 的设置 （ developerWorks，2001 年 3 月）
One-liners 101（ developerWorks，2001 年 4 月）
使用 Perl 自动化 UNIX 系统管理（ developerWorks，2001 年 7 月）
JAPH 的精致（ developerWorks，2001 年 7 月）
Perl 用于实现遗传算法（ developerWorks，2001 年 8 月）
用 Perl 读写 Excel 文件（ developerWorks，2001 年 9 月）
介绍用于系统管理的 cfengine（ developerWorks，2002 年 2 月）
Application configuration with Perl, Part 2（ developerWorks，2002 年 7 月）
上一节 下一节
