目次


洗練された Perl

Perl での遺伝的アルゴリズムの使用

進化のための繁殖地を作る

Comments

コンテンツシリーズ

このコンテンツは全#シリーズのパート#です: 洗練された Perl

このシリーズの続きに乞うご期待。

このコンテンツはシリーズの一部分です:洗練された Perl

このシリーズの続きに乞うご期待。

まず最初に、この記事で示す例を実際に試してみるにはPerl 5.005以降が必要です。システムは最新(2000年以降)のメインストリームUNIX(Linux、Solaris、BSD)が望ましいでしょう。しかし、他のオペレーティング・システムでも同様に動作するはずです。古いバージョンのPerlおよびUNIXその他のオペレーティング・システムでも動作する可能性はありますが、動作しない場合は、皆さん自身の課題として取り組んでみてください。

歴史

20世紀における遺伝学の進歩は、速度と影響力という点だけから見てもエレクトロニクスやコンピューター・サイエンスの進歩に匹敵するものでした。これに合わせて、20世紀の最も興味深いアルゴリズムの1つとして、遺伝的アルゴリズムが登場しました。

1960年代初頭に登場した遺伝的アルゴリズム(および進化的アルゴリズム全般)は、コンピューター・サイエンスにおける決定性アルゴリズムと非決定性アルゴリズムの間の位置を占めるに至りました。原則として遺伝的アルゴリズムは、必要に応じて決定的アルゴリズムとすることができます。つまり、反復数と終了基準をユーザーが決めることができるのです。これはダーウィンの自然淘汰を真似たもので、「適応度」(個々に適用される式によって決定される)と突然変異によって、個体の生存と増殖が決定されます。

その他の進化的アルゴリズムとしては、ラマルク進化論を模倣し、生存メカニズムとしての行動の世代間での継代を可能とするものや、特定の目的によって自分自身のコーディングを行う進化的プログラムもあります。しかし、この記事ではこれらすべてを扱うことはできません。

遺伝的アルゴリズムにおけるPerlの大きな欠点は速度です。遺伝的アルゴリズムは、計算負荷がきわめて高いため、Cその他の事前コンパイル型低水準言語を使用する方がより効率的です。この記事で示すPerlの例は、Cによるものほど高速ではありませんが、遺伝的アルゴリズムの仕組みといくつかの問題を示すという目的には十分なスピードです。

遺伝的アルゴリズムとは

遺伝的アルゴリズムは、高校生の生物学用語の範囲で誰でも理解できるほど簡単なものです。まず、それぞれ固有のDNAを持つ個体の母集団(個体群)を生成します。次いで、各個体の適応度(個体のDNAに適用する関数として)を測定し、その個体の適応度が高ければ増殖の可能性が高くなるようにします。極端に不適応な個体は淘汰します。また、すべての生存者は生殖を行う可能性を持ちます(重要な点は、生存者に対して、生殖が否定されることは決してなく、適応度が低ければそれだけ可能性が低くなるだけだということです)。親のDNAを交叉し、次いで、一定の確率で発生する突然変異を適用して生殖をシミュレートします。理論的には、新しい個体は、突然変異による多少の違いを生じながら、親と同程度に適合していくはずです。以降、このサイクルを繰り返します。

言うまでもなく、母集団の大きさ、世代(アルゴリズムの反復)、交叉方法、適応度関数、生殖の可能性に対する適応度の影響度、突然変異の発生頻度など、遺伝的アルゴリズムに関連したさまざまな変数があります。

このアルゴリズムにはいくつかの欠点もあります。このアルゴリズムは、適応度関数が一連のビットとしてDNAに適用できる場合にきわめてよく機能します。つまり、DNAが一連のバイナリー選択(青い目か?黒い目か?赤い髪か?黒い髪か?などの問いに対する「肯定」か「否定」)であれば最もよいということです。結果として得られるDNAが最初の問題の有効な解にはならない場合には、親のDNAの交叉および後続の突然変異によって得られる特定のビットの組み合わせは無効なものとなります。「DNA」は適応度を表す数式の解に過ぎないということを忘れてはなりません。また、0に対する除算など、式に対する一部の値は無効なものである可能性もあります。

また、遺伝的アルゴリズムは時間的制約を受けません。生成される世代数はアルゴリズムの作成者が選択します。たとえば、「『適応度が0.99999の個体を探索』し、それが見つかれば終了させるが、それが見つかるまではアルゴリズムを終了させない」といった目標を定義することができます。非現実的な目標を設定した場合や、世代数が少な過ぎる場合には問題が発生する可能性が高くなります。試行錯誤によって最適な目標を見つけることが、このような問題を回避する最もよい方法であると言えるでしょう。

適応度式の返す値は、0?1の浮動小数点がよいでしょう。その他の値も使用できますが、私の経験では浮動小数点数が最も適しているようです。たとえば、最適化のための適応度を7ビットの整数にしたい場合は、0?32767の範囲とすることもできます。

もちろん、必要性が認識されるまで最適化を行わないというのはもっともなので、とりあえず、簡単な適応度式から始めてみましょう。適応度式は、遺伝的アルゴリズムにおいて最もよく使用される関数であり、(この関数は「母集団の大きさ」×「世代数」の回数で呼び出しが行われます)できる限り単純かつ高速なものにしておくことが必要です。

遺伝的アルゴリズムを終了するのには、3つのいい方法があります。第1に、DNAプールにもはや多様性がなくなったときに終了させることができます。これは実際にはなかなか大変です。DNAをストリングとして表現できるのであれば、ストリング間の距離を調べるためのCPANモジュールが役に立つかもしれません。第2に、目標とする適応度に達した段階で終了することができます。適応度式について熟知している(その場合はおそらく遺伝的アルゴリズムは必要ないでしょう)のでなければ、目標適応度を設定することは、無限ループを導くか、完璧ではないが「充分」である個体を得るだけになるかもしれません。そして第3は、設定した回数の反復が行われた、つまり設定した数の「世代」発生が完了した段階でアルゴリズムを終了させるという方法です。

実際の遺伝的アルゴリズムの制御には、上記の3つの方法すべて(少なくとも2番目と3番目の方法)を使用します。10?20回程度のテスト・ランを行えば、アルゴリズムがどのくらいの時間で収束し、どの程度の適応度が期待できるのかを把握することが出来るでしょう。

簡単な例

リスト1のコードでは、DNAとしてシングル・バイトを使用しています(0?255の8ビット値)。すべての新しい個体に対して適応度式を1回適用し、DNAのバイト値を得て、その値を256で除算します。つまり、適応度式は常に0/256?255/256の値を返すため、値は絶対に1にはなりません。最も適応度の高いDNAはどのようなものになると思いますか。

リスト1. 適応度を表すバイトの交配
#!/usr/bin/perl -w

# GA demonstration with numeric DNA (between 0 and 255)

use strict;
use Data::Dumper;

# individuals in the population - no sense making more than DNA can provide for
my $popsize = 256;		    
my $mut_rate = 0.01;			# the mutation rate
my $min_fitness = 0.1;			# the minimum fitness for survival
my $generation_count = 100000;	        # run for this many generations
my $generation = 0;			# generation counter
my $pop_ref = [];                       # a reference to a population array
init_population($pop_ref, $popsize);

do
{
 evaluate_fitness($pop_ref, \&fitness);

 # print out a generation summary line
 my @sorted_population = sort { $a->{fitness} <=> $b->{fitness} } @$pop_ref;
 printf "generation %d: size %d, least fit DNA [%d], most fit DNA [%d]\n",
  $generation,
   scalar @sorted_population,
    $sorted_population[0]->{dna},
     $sorted_population[-1]->{dna};

 survive($pop_ref, $min_fitness);       # select survivors from the population
 select_parents($pop_ref);
 $pop_ref = recombine($pop_ref);        # returns a new population array reference

 # from this point on, we are working with a new generation in $pop_ref
 mutate($pop_ref, $mut_rate);	        # apply mutation to the individuals
} while ($generation++ < $generation_count); # run until we are out of generations

sub init_population
{
 my $population = shift @_;
 my $pop_size = shift @_;

 # for each individual
 foreach my $id (1 .. $pop_size)
 {
  # insert an anonymous hash reference in the population array with the individual's data
  # the DNA is equal to the individual's number minus 1 (0-255)
  push @$population, { dna => $id-1, survived => 1, parent => 0, fitness => 0 };
 }
}

sub evaluate_fitness
{
 my $population = shift @_;
 my $fitness_function = shift @_;

 foreach my $individual (@$population)
 {
  # set the fitness to the result of invoking the fitness function
  # on the individual's DNA
  $individual->{fitness} = $fitness_function->($individual->{dna});
 }
}

sub survive
{
 my $population = shift @_;
 my $min_fitness = shift @_;

 foreach my $individual (@$population)
 {
  # set the fitness to the result of invoking the fitness function
  # on the individual's DNA
  $individual->{survived} = $individual->{fitness} >= $min_fitness;

  # set the fitness to 0 for unfit individuals (so they won't procreate)
  $individual->{fitness} = 0 if $individual->{fitness} < $min_fitness;
 }
}

sub select_parents
{
 my $population = shift @_;
 my $pop_size = scalar @$population;	# population size

 # create the weights array: select only survivors from the population,
 # then use map to have only the fitness come through
 my @weights = map { $_->{fitness} } grep { $_->{survived} } @$population;

 # if we have less than 2 survivors, we're in trouble
 die "Population size $pop_size is too small" if $pop_size < 2;

 # we need to fill $pop_size parenting slots, to preserve the population size
 foreach my $slot (1..$pop_size)
 {
  my $index = sample(\@weights); # we pass a reference to the weights array here

  # do sanity checking on $index
  die "Undefined index returned by sample()"
   unless defined $index;
  die "Invalid index $index returned by sample()"
   unless $index >= 0 && $index < $pop_size;

  # increase the parenting slots for this population member
  $population->[$index]->{parent}++;

 }

}

sub recombine
{
 my $population = shift @_;
 my $pop_size = scalar @$population;	# population size
 my @parent_population;
 my @new_population;

 my $total_parent_slots = 1;

 while ($total_parent_slots)
 {
  # find out how many parent slots are left
  $total_parent_slots = 0;
  $total_parent_slots += $_->{parent} foreach @$population;

  last unless $total_parent_slots;

  # if we are here, we're sure we have at least one individual with parent > 0
  my $individual = undef;		# start with an undefined individual
  do
  {
   # select a random individual
   $individual = $population->[int(rand($pop_size))];
   # individual is acceptable only if he can be a parent
   undef($individual) unless $individual->{parent};
  } while (not defined $individual);

  push @parent_population, $individual;	# insert the individual in the parent population
  $individual->{parent}--;		# decrease the parenting slots by 1

 }

 foreach my $parent (@parent_population)
 {
  # select a random individual from the parent population (parent #2)
  my $parent2 = @parent_population[int(rand($pop_size))];

  my $child = { survived => 1, parent => 0, fitness => 0 };

  # this is breeding!
  my $bitmask = int(rand(256));	        # a random byte between 0 and 255
  # swap random bits between parents, according to the bitmask
  $child->{dna} = ($parent2->{dna} & $bitmask) | ($parent->{dna} & ~$bitmask);

  push @new_population, $child;		# the child is now a part of the new generation
 }

 return \@new_population;
}

sub mutate
{
 my $population = shift @_;
 my $mut_rate   = shift @_;

 foreach my $individual (@$population)
 {
  # only mutate individuals if rand() returns more than mut_rate
  next if rand > $mut_rate;
  # mutate the DNA by and-ing and then or-ing it with two random
  # integers between 0 and 255
  my $old_dna = $individual->{dna};
  $individual->{dna} &= int(rand(256));
  $individual->{dna} |= int(rand(256));
#  print "Mutated $old_dna to ", $individual->{dna}, "\n";
 }
}

sub fitness
{
 my $dna = shift @_;
 return $dna/256;
}

# Function to sample from an array of weighted elements
# originally written by Abigail <abigail@foad.org>
sub sample
{
 # get the reference to the weights array
 my $weights = shift @_ or return undef;
 # internal counting variables
 my ($count, $sample);

 for (my $i  = 0; $i < scalar @$weights; $i ++)
 {
  $count += $weights->[$i];
  $sample = $i if rand $count < $weights->[$i];
 }

 # return an index into the weights array
 return $sample;
}

リスト1には興味深い点がいくつかあります。メインループは先頭にあります。まず各部分について理解した上で、それらが総合して母集団に対してどのように作用するのかを理解してください(次の例で再使用できるようにサブルーチンにしてあります)。

select_parents()関数では、grep()の上にmap()をスタックすることによってweights配列を生成します。ループとして記述することも可能ですが、そのように1行にした方がずっとすっきりし、プログラムの実行速度もそれほど遅くはなりません。

リスト2. mapとgrepのスタック
my @weights = map { $_->{fitness} } grep { $_->{survived} } @$population;

$population配列のリファレンスをデリファレンスした後、配列の「生き残った」フィールド(survive()関数によって先に設定された)を持つ要素のみがgrepを通過します。次いで、その生き残った者(生存者)からそれぞれの適応度値を抽出し、weights配列のそれぞれの位置に配置します。

母集団の大きさは256としていますが、これは、こうすると各個体をそのインデックスと同じ数字で初期化すればよく、簡単だからです。母集団の大きさを変えて試してみてください。

突然変異率を1%より大きい値に設定した場合、最大適応度と最小適応度が大幅に変動し、母集団が高い適応度で安定することはありませんでした。逆に突然変異率を低くすると全体として母集団は高い適応度に到達しますが、速度がはるかに遅くなります。いろいろ考慮した結果、この母集団の大きさに対しては「1%」が概ね適当であると判断しました。

選択交配アルゴリズムは、重み(ウエイト)を見て片方の親を選択します。事実上、すべての個体に親となる可能性がありますが、親スロットの数は有限です。もう片方の親は親母集団からランダムに選択します。これはなぜでしょう。それは、もう片方の親も同様に重みによって決定することもできるのですが、ランダムな選択の方が、親になりうるすべての個体に対して交配プロセスに参加する機会を確実に与えることができるためです。

実際の交配は、8ビットのランダム・ビット・マスクを使用して実行します。そのビットマスクと片方の親のDNAをAND演算し、反転したビットマスクともう片方の親のDNAをAND演算します。こうして、片方の親からランダム・ビットを選択し、もう片方の親から残りのビットを得ることができます。

突然変異は、個体のDNAと8ビットのランダム・ビット・マスクのAND演算およびOR演算によって行います。

ちなみに、当然のことですが、最も適応度の高いDNAは255でした。10万回の交配が行われるのを待つ必要はありません。ステータス行を確認したら、Ctrl+ Cを押してください。

交配によって単語を作り出す

この例では、DNAを32ビット(5バイト)とします。各バイトは文字またはスペースを表します。各バイトにもっとたくさんの情報を持たせることもできますが、それではこの例の目的が分かりにくくなってしまいます。各バイトの値(0?255の数値)は、A?Z(値は65?90。ASCII文字集合に一致するように便宜的に選択)とスペース(値は0?64または91?255)のいずれかになります。

この例とリスト1の例がどのくらい似ているか見てみてください。プログラムの後に単語の辞書があります。

リスト3. 交配によって単語を作り出す

この例での大きな問題は、32ビットよりも長いDNAの扱いが難しいという点でした。独自のビット操作を試みたのですが、扱いにくいだけでなく速度がきわめて遅くなりました。また、Math::BigIntパッケージも試してみましたが、十分なスピードは得られませんでした。

結局、vec()関数を使用することにしました。これは非常に高速で、DNAの処理に最適でした(本質的にDNAは、Perlの組み込みデータ構造であるビット・ベクトルです)。vec()関数の詳細については、"perldoc -f vec"で参照してください。

1024個の個体が適応度0で終了する可能性もあるため、そのような「アクシデント」への対応という点において、最初の例よりもこの例の方が優れています。

init_population()、recombine()、およびmutate()関数は、バイトの代わりにビット・ベクトルを扱うように変更しました。

dna_to_words()関数はやや効率が悪いのですが、呼び出しが頻繁には行われないため、あまり影響しません。実行速度が低下する最大の原因は、fitness()関数が辞書内のすべての単語とすべてのアルファベットとの照合を試みることです。

適応度は、DNAに含まれる各文字を2とし、辞書内でのその文字の頻度を加味し、さらにDNAに含まれる長さNのすべての辞書記載単語を2^Nとして計算しました。辞書配列および文字頻度のハッシュは、(クロージャーを使用して)1度だけ取得しました。適応度関数と辞書を自由に変更して独自の英単語を交配してみてください。ここで示した適応度式は文字に対する偏りがかなりあるため、英単語として収束するまでには少し時間がかかります(ただし、"on"や"in"などはすぐに得られますが)。

まとめ

進化的/遺伝的アルゴリズムは、1回の記事ではとても語り尽くせない非常に興味深いトピックです。ここで示した例をぜひ試してみて、「進化のための繁殖地」を自分で作ってみてください。特に2番目の例では、適応度関数を変えてみて、混沌とした中から現れ出る単語を観察してみるのも面白いと思います。

これらの例では、初心者レベルから上級者レベルまでのさまざまなテクニックが用いられています。理解できるまでじっくりと取り組んでください。まだ、いろいろな点で改良することができます。特に興味深いのはvec()関数で、DNAその他の数値データなどの長いビット・ベクトルに最適の関数です。

読者の皆さんも、独自の遺伝的アルゴリズムを作成してみてください。そして、私のものと比較して、それぞれの問題点(どちらにもその可能性はあります)を発見/解決しながら学んでいってください。アルゴリズムの実行はなかなか難しい作業であり、いろいろな点で間違いを犯しやすく、また、簡単には成功しないものです。


ダウンロード可能なリソース


関連トピック

  • CPANをご覧ください。ここには、皆さんに必要なあらゆるPerlモジュールがあります。
  • Perl.comで、Perlに関する情報および関連リソースをご覧ください。
  • 『Programming Perl Third Edition』(Larry Wall、Tom Christiansen、Jon Orwant共著、O'Reilly & Associates2000)は最も優れたPerlのガイドであり、5.005および5.6.0に対応しています。
  • 『Mastering Algorithms with Perl』(Jon Orwant、Jarkko Hietaniemi、John Macdonald共著、O'Reilly & Associates1999)は、Perlによるアルゴリズム生成に関する優れた解説書です。第14章「Probability」には、Perlによる加重および非加重確率分布の方法が示されています。
  • Genetic Algorithms FAQは最新の情報ではありませんが、フリー/市販の役立つ遺伝的アルゴリズム・ソフトウェアが示されています。
  • Teodor Zlatanov氏によるdeveloperWorksの関連記事もご覧ください。
  • developerWorksの他のLinux関連記事もご覧ください。
  • developerWorksの他のオープン・ソース関連記事もご覧ください。

コメント

コメントを登録するにはサインインあるいは登録してください。

static.content.url=http://www.ibm.com/developerworks/js/artrating/
SITE_ID=60
Zone=Linux
ArticleID=228242
ArticleTitle=洗練された Perl: Perl での遺伝的アルゴリズムの使用
publish-date=08012001