遺伝的アルゴリズム（もどき）による彩色アルゴリズム。
前回のエントリの通り、作りかけで放置していたので作り上げてみた。
といっても、終了判定が完全な手抜き。
とりあえず1000世代進めたら終了という、とんでもない終了判定を今回は採用してみた。（というのも、それ以外の終了判定にするには、実験を繰り返してみないことにはなんともいえないから。）
にしても、予想通りというかなんというか、彩色問題には遺伝的アルゴリズムはあまり向いてない感じがなんとも。
まぁ、パラメータの調整を全然していないから、完全に結論付けるのはまだ早いけれど。
遺伝的アルゴリズムを実装してみて思ったのが、パラメータの数が多すぎるということ。
挙げていくと、
今回は一番最初の以外はコマンドラインからパラメータを設定できるようにしたけれど、これだけあると解析が大変・・・
パラメータを動かすことによって結果にどのような影響が出るのかも予測しづらい。
なんか、このパラメータを調整すること自体が最適化理論を必要としそうな感じ・・・
あと、彩色問題の場合は「最適化されたときの値」というのが分からないので、終了判定が非常に難しい。
やはり実験を繰り返して解析をすることで、最高値が連続○回出たら終了、とか、この問題サイズに対しては○世代進めれば（だいたい）最適解が得られる、とかを調べていくしかなさそう。
まぁ、途中の様子とかを出力できるようにプログラムを改良して、で、解析していきたいと思います。時間があれば。
一応プログラムの概要。
“各点を彩色する色”の配列を遺伝子としています。
（たとえば、点1を1、点2を2、点3を3という色で塗るのであれば、遺伝子は1-2-3となるわけです。）
生物の場合はA,T,G,Cが遺伝子をなす物質（記号）となりますが、このプログラムでは点を塗る色が高々点の数個であることを利用して、1,2,…,|V(G)|が遺伝子をなす記号となっています。
最初ランダムに遺伝子が100個作られ、交配、変異が決められたパラメータにしたがって行われます。
交配される遺伝子はランダムに選ばれます。
また、変異する遺伝子も、すでにある遺伝子、交配によって得られた遺伝子両方が一緒くたにされた状態で、ランダムに選ばれます。（これは微妙によくない仕様かな・・・？）
こうして世代が進んでいき、決められたパラメータだけ世代が進むと、淘汰が起きます。
淘汰は、遺伝子の適応度の高いものが100個残されるようになっています。
遺伝子の適応度は次の式で定まります：
－（使われている色の数）－ｎ×（隣接していて、同じ色の点の数） （※ｎは１以上）
こうして1000世代進んだら終了で、その時点で適応度の最も高い遺伝子の情報を整理して出力。
ちなみにデフォルトのパラメータは
ってな感じですね。
以下、ソース。
＝Graph.pm＝
以前のと同じなので省略。
＝DNA.pm＝
package DNA;
#--------------------------------------------------
# DNA.pm ver.1.0 06/03/12
#
# 彩色情報を保持するクラス
#
# =フィールド=
# color 彩色の色の配列
# num 彩色情報の長さ
#
# =メソッド=
# obj new(num);
# オブジェクトを作成する
# インスタンスから呼び出された場合、
# インスタンスのコピーをする
# obj オブジェクト
# num 点の数
#
# void init(num);
# オブジェクトを初期化する
# obj オブジェクト
# num 点の数
#
# void copy(obj);
# フィールドをコピーする
# obj コピー元のオブジェクト
#
# void mutate(rate);
# 突然変異を起こさせる
# rate 突然変異の度合い(0～9)
#
# new mate(obj);
# 交配させて新しいオブジェクトを作る
# new 新しいオブジェクト
# obj 交配させるオブジェクト
#
# color get_color(void);
# 彩色の色を得る
# color 彩色の色の配列
#
# void set_color(color);
# 彩色の色を決定する
# color 彩色の色の配列
#
# bool check_color(a, b);
# 同じ色かを調べる
# bool 同じ色なら1
# a 対象の点
# b 対象の点
#--------------------------------------------------
sub new{
}
sub init{
}
sub copy{
}
sub mutate{
}
sub mate{
}
sub get_color{
}
sub set_color{
}
sub check_color{
}
1;
＝Environ.pm＝
package Environ;
#--------------------------------------------------
# Environ.pm ver.1.0 06/03/12
#
# Environクラス
# 環境を定める
#
# =フィールド=
# graph Graphクラスのインスタンス
# DNA DNAクラスのインスタンスの配列
# max 淘汰のときに残る数（最初に生成するDNAの数）
# age 世代
# cycle 淘汰を起こす周期(1-)
# mate_per 交配率(0-10)
# mutate_per 変異率(0-10)
# mutate_rate 変異の度合い(0-9)
#
# =メソッド=
# obj new(graph, max);
# オブジェクトを作成する
# obj オブジェクト
# graph Graphクラスのインスタンス
# max DNAクラスの初期数
#
# obj init(graph);
# オブジェクトを初期化する
# obj オブジェクト
# graph Graphクラスのインスタンス
# max DNAクラスの初期数
#
# void next(void);
# 一世代進める
#
# void selection(void);
# 淘汰を行い、maxの数にする
#
# num value(DNA);
# 適応度を得る
# 適応度は-(使っている色数)-n*(隣接してて同じ色の点の組の数)
# num 適応度
# DNA 対象となるDNAインスタンス
#
# DNA get_max_DNA(void);
# 適応度が最大のDNAを得る
# DNA 条件を満たすDNAインスタンス
#
# age get_age();
# ageを得る
# age 世代
#
# void set_max(max);
# maxをセットする
# max 淘汰のときに残る数
#
# void set_cycle(cycle);
# cycleをセットする
# cycle 淘汰を起こす周期(1-)
#
# void set_mate_per(mate_per);
# mate_perをセットする
# mate_per 交配率(0-10)
#
# void set_mutate_per(mutate_per);
# mutate_perをセットする
# mutate_per 変異率(0-10)
#
# void set_mutate_rate(mutate_rate);
# mutate_rateをセットする
# mutate_rate 変異の度合い(0-9)
#--------------------------------------------------
use Graph;
use DNA;
#初期値--------------------
my %default = (
);
#クロージャー
sub get_default{
}
#--------------------------
sub new{
}
sub init{
}
sub next{
}
sub selection{
}
sub value{
}
sub get_max_DNA{
}
sub get_age{
}
sub set_max{
}
sub set_cycle{
}
sub set_mate_per{
}
sub set_mutate_per{
}
sub set_mutate_rate{
}
1;
＝genetic_paint＝
#!/usr/bin/perl
#--------------------------------------------------
# genetic_paint ver.1.0 06/03/12
#
# 遺伝的アルゴリズムによる点彩色
#
# =オプション=
# -t 対話的にグラフを作成
# -s 標準入力からグラフを作成
# -v 冗長出力をする
# -h ヘルプを出力
# --cycle=num cycleをnumにする
# --mate_per=per mate_perをperにする
# --mutate_per=per mutate_perをperにする
# --mutate_rate=rate mutate_rateをrateにする
# 何も指定されないときには-tvが指定され、
# デフォルトの値が利用される
#--------------------------------------------------
use Graph;
use DNA;
use Environ;
sub print_help{
genetic_graph: 遺伝的アルゴリズムによる点彩色
=構文=
genetic_graph [-tsvh] [--cycle=num] [--mate_per=per] [--mutate_per=per] [--mutate_rate=rate]
=オプション=
オプションを指定しなかった場合、-tvとデフォルト
の値が指定されて実行される
END_OF_HELP
}
sub anly_opt{
}
sub error{
}
sub main{
}
sub determine{
}
&main();
いやぁ、無駄に長い（＾＾；
オプションを解析するクラスを一つ作っちゃった方がいいんですよねぇ。
前回のエントリの通り、作りかけで放置していたので作り上げてみた。
といっても、終了判定が完全な手抜き。
とりあえず1000世代進めたら終了という、とんでもない終了判定を今回は採用してみた。（というのも、それ以外の終了判定にするには、実験を繰り返してみないことにはなんともいえないから。）
にしても、予想通りというかなんというか、彩色問題には遺伝的アルゴリズムはあまり向いてない感じがなんとも。
まぁ、パラメータの調整を全然していないから、完全に結論付けるのはまだ早いけれど。
遺伝的アルゴリズムを実装してみて思ったのが、パラメータの数が多すぎるということ。
挙げていくと、
- 最初に用意する遺伝子の数
- 淘汰は何世代ごとに起こすか
- 淘汰させるとき、何個の遺伝子を残すか
- 交配させるとき、何割の遺伝子を交配させるか
- 変異はどれくらいの割合で起こるか
- １回の変異での、遺伝子の変化の度合い
今回は一番最初の以外はコマンドラインからパラメータを設定できるようにしたけれど、これだけあると解析が大変・・・
パラメータを動かすことによって結果にどのような影響が出るのかも予測しづらい。
なんか、このパラメータを調整すること自体が最適化理論を必要としそうな感じ・・・
あと、彩色問題の場合は「最適化されたときの値」というのが分からないので、終了判定が非常に難しい。
やはり実験を繰り返して解析をすることで、最高値が連続○回出たら終了、とか、この問題サイズに対しては○世代進めれば（だいたい）最適解が得られる、とかを調べていくしかなさそう。
まぁ、途中の様子とかを出力できるようにプログラムを改良して、で、解析していきたいと思います。時間があれば。
一応プログラムの概要。
“各点を彩色する色”の配列を遺伝子としています。
（たとえば、点1を1、点2を2、点3を3という色で塗るのであれば、遺伝子は1-2-3となるわけです。）
生物の場合はA,T,G,Cが遺伝子をなす物質（記号）となりますが、このプログラムでは点を塗る色が高々点の数個であることを利用して、1,2,…,|V(G)|が遺伝子をなす記号となっています。
最初ランダムに遺伝子が100個作られ、交配、変異が決められたパラメータにしたがって行われます。
交配される遺伝子はランダムに選ばれます。
また、変異する遺伝子も、すでにある遺伝子、交配によって得られた遺伝子両方が一緒くたにされた状態で、ランダムに選ばれます。（これは微妙によくない仕様かな・・・？）
こうして世代が進んでいき、決められたパラメータだけ世代が進むと、淘汰が起きます。
淘汰は、遺伝子の適応度の高いものが100個残されるようになっています。
遺伝子の適応度は次の式で定まります：
－（使われている色の数）－ｎ×（隣接していて、同じ色の点の数） （※ｎは１以上）
こうして1000世代進んだら終了で、その時点で適応度の最も高い遺伝子の情報を整理して出力。
ちなみにデフォルトのパラメータは
- 淘汰を起こす周期: 3
- 交配する割合: 5
- 変異を起こす割合: 1
- 変異の度合い: 2
ってな感じですね。
以下、ソース。
＝Graph.pm＝
以前のと同じなので省略。
＝DNA.pm＝
package DNA;
#--------------------------------------------------
# DNA.pm ver.1.0 06/03/12
#
# 彩色情報を保持するクラス
#
# =フィールド=
# color 彩色の色の配列
# num 彩色情報の長さ
#
# =メソッド=
# obj new(num);
# オブジェクトを作成する
# インスタンスから呼び出された場合、
# インスタンスのコピーをする
# obj オブジェクト
# num 点の数
#
# void init(num);
# オブジェクトを初期化する
# obj オブジェクト
# num 点の数
#
# void copy(obj);
# フィールドをコピーする
# obj コピー元のオブジェクト
#
# void mutate(rate);
# 突然変異を起こさせる
# rate 突然変異の度合い(0～9)
#
# new mate(obj);
# 交配させて新しいオブジェクトを作る
# new 新しいオブジェクト
# obj 交配させるオブジェクト
#
# color get_color(void);
# 彩色の色を得る
# color 彩色の色の配列
#
# void set_color(color);
# 彩色の色を決定する
# color 彩色の色の配列
#
# bool check_color(a, b);
# 同じ色かを調べる
# bool 同じ色なら1
# a 対象の点
# b 対象の点
#--------------------------------------------------
sub new{
my ($obj, $num) = @_;
my $new;
my $class;
if($class = ref $obj){
$new = bless {}, $class;
$new-＞copy($obj);
}
else{
$new = bless {}, $obj;
$new-＞init($num);
}return $new;
}
sub init{
my ($self, $num) = @_;
my $color = [];
foreach(1..$num){
my $rand = int(rand $num);
++$rand;
push @$color, $rand;
} $self-＞{color} = $color;
$self-＞{num} = $num;}
sub copy{
my ($self, $obj) = @_;
$self-＞set_color($obj-＞get_color());
$self-＞{num} = $obj-＞{num};
}
sub mutate{
my ($self, $rate) = @_;
my @color = $self-＞get_color();
my $n = $self-＞{num};
if($rate != 0){
#変異させる数を得る
my $mutates = int($n * $rate / 10);
if($mutates == 0){
$mutates = 1;
}
if($mutates ＞= $n){
$mutates = $n-1;
}#変異させる要素を決める
my @target;
foreach(1..$mutates){
push @target, int(rand $n);
}
#変異させる
foreach(@target){
$color[$_] = ($color[$_] + int(rand $n)) % $n + 1;
}
}
$self-＞set_color(@color);
}
sub mate{
my ($self, $obj) = @_;
my $new = $self-＞new();
my @obj_color = $obj-＞get_color();
my $num = $obj-＞{num} - 1;
my $segment = int(rand $num) + 1; foreach($segment..$num){
$new-＞{color}[$_] = $obj_color[$_];
}return $new;
}
sub get_color{
my $self = shift @_;
return @{$self-＞{color}};}
sub set_color{
my ($self, @color) = @_;
$self-＞{color} = \@color;}
sub check_color{
my ($self, $a, $b) = @_;
if($self-＞{color}[$a-1] == $self-＞{color}[$b-1]){
return 1;
}
else{
return 0;
}}
1;
＝Environ.pm＝
package Environ;
#--------------------------------------------------
# Environ.pm ver.1.0 06/03/12
#
# Environクラス
# 環境を定める
#
# =フィールド=
# graph Graphクラスのインスタンス
# DNA DNAクラスのインスタンスの配列
# max 淘汰のときに残る数（最初に生成するDNAの数）
# age 世代
# cycle 淘汰を起こす周期(1-)
# mate_per 交配率(0-10)
# mutate_per 変異率(0-10)
# mutate_rate 変異の度合い(0-9)
#
# =メソッド=
# obj new(graph, max);
# オブジェクトを作成する
# obj オブジェクト
# graph Graphクラスのインスタンス
# max DNAクラスの初期数
#
# obj init(graph);
# オブジェクトを初期化する
# obj オブジェクト
# graph Graphクラスのインスタンス
# max DNAクラスの初期数
#
# void next(void);
# 一世代進める
#
# void selection(void);
# 淘汰を行い、maxの数にする
#
# num value(DNA);
# 適応度を得る
# 適応度は-(使っている色数)-n*(隣接してて同じ色の点の組の数)
# num 適応度
# DNA 対象となるDNAインスタンス
#
# DNA get_max_DNA(void);
# 適応度が最大のDNAを得る
# DNA 条件を満たすDNAインスタンス
#
# age get_age();
# ageを得る
# age 世代
#
# void set_max(max);
# maxをセットする
# max 淘汰のときに残る数
#
# void set_cycle(cycle);
# cycleをセットする
# cycle 淘汰を起こす周期(1-)
#
# void set_mate_per(mate_per);
# mate_perをセットする
# mate_per 交配率(0-10)
#
# void set_mutate_per(mutate_per);
# mutate_perをセットする
# mutate_per 変異率(0-10)
#
# void set_mutate_rate(mutate_rate);
# mutate_rateをセットする
# mutate_rate 変異の度合い(0-9)
#--------------------------------------------------
use Graph;
use DNA;
#初期値--------------------
my %default = (
max =＞ 100,
cycle =＞ 3,
meta_per =＞ 5,
mutate_per =＞ 1,
mutate_rate =＞ 2,
);
#クロージャー
sub get_default{
my $key = shift @_;
return $default{$key};
}
#--------------------------
sub new{
my ($class, $graph, $max) = @_;
my $obj = bless {}, $class;
return $obj-＞init($graph, $max);}
sub init{
my ($self, $graph, $max) = @_;
if(!$max){
$max = &get_default(max);
} $self-＞{graph} = $graph;
$self-＞{max} = $max;
$self-＞{age} = 1;
$self-＞{cycle} = &get_default(cycle);
$self-＞{meta_per} = &get_default(meta_per);
$self-＞{mutate_per} = &get_default(mutate_per);
$self-＞{mutate_rate} = &get_default(mutate_rate);my $num = $graph-＞get_n();
$self-＞{DNA} = [];
foreach(1..$max){
push @{$self-＞{DNA}}, DNA-＞new($num);
}
return $self;
}
sub next{
my $self = shift @_;
my $DNA = $self-＞{DNA};
my @new;#交配
my $nums = int((@$DNA * $self-＞{mate_per}) / (10 * 2));
foreach(1..$nums){
my $rand1 = int(rand @$DNA);
my $rand2 = int(rand @$DNA);
push @new, $DNA-＞[$rand1]-＞mate($DNA-＞[$rand2]);
}
#突然変異
$nums = int(@new * $self-＞{mutate_per} / 10);
foreach(1..$nums){
my $rand = int(rand @$DNA);
$DNA-＞[$rand]-＞mutate($self-＞{mutate_rate});
}
@$DNA = (@$DNA, @new);
$self-＞{DNA} = $DNA;
++$self-＞{age};#淘汰
if(($self-＞{age} % $self-＞{cycle}) == 0){
$self-＞selection();
}
}
sub selection{
my $self = shift @_;
my $max = $self-＞{max};
my $DNA = $self-＞{DNA}; @$DNA = sort {$self-＞value($b) ＜=＞ $self-＞value($a)} @$DNA;my $new;
foreach(1..$max){
push @$new, shift @$DNA;
}
$self-＞{DNA} = $new;}
sub value{
my ($self, $DNA) = @_;
my $value = 0;
my $graph = $self-＞{graph};
my @color = $DNA-＞get_color();
my $num = $graph-＞get_n();
#使われている色の数
my %color_list;
foreach(@color){
$color_list{$_} = 0;
}
$value -= scalar(keys %color_list);
#隣接していて同じ色の点の数
my $i, $j;
foreach $i (1..$num){
foreach $j (1..$num){
if(
$graph-＞check_nbr($i, $j)
&&
$DNA-＞check_color($i, $j)
){
--$value;
}
}
}
return $value;
}
sub get_max_DNA{
my $self = shift @_;
my $DNA = $self-＞{DNA};
@$DNA = sort {$self-＞value($b) ＜=＞ $self-＞value($a)} @$DNA;return $DNA-＞[0];
}
sub get_age{
my $self = shift @_;
return $self-＞{age};
}
sub set_max{
my ($self, $max) = @_;
$self-＞{max} = $max;
}
sub set_cycle{
my ($self, $cycle) = @_;
$self-＞{cycle} = $cycle;
}
sub set_mate_per{
my ($self, $mate_per) = @_;
$self-＞{mate_per} = $mate_per;
}
sub set_mutate_per{
my ($self, $mutate_per) = @_;
$self-＞{mutate_per} = $mutate_per;
}
sub set_mutate_rate{
my ($self, $mutate_rate) = @_;
$self-＞{mutate_rate} = $mutate_rate;
}
1;
＝genetic_paint＝
#!/usr/bin/perl
#--------------------------------------------------
# genetic_paint ver.1.0 06/03/12
#
# 遺伝的アルゴリズムによる点彩色
#
# =オプション=
# -t 対話的にグラフを作成
# -s 標準入力からグラフを作成
# -v 冗長出力をする
# -h ヘルプを出力
# --cycle=num cycleをnumにする
# --mate_per=per mate_perをperにする
# --mutate_per=per mutate_perをperにする
# --mutate_rate=rate mutate_rateをrateにする
# 何も指定されないときには-tvが指定され、
# デフォルトの値が利用される
#--------------------------------------------------
use Graph;
use DNA;
use Environ;
sub print_help{
print ＜＜END_OF_HELP;
genetic_graph: 遺伝的アルゴリズムによる点彩色
=構文=
genetic_graph [-tsvh] [--cycle=num] [--mate_per=per] [--mutate_per=per] [--mutate_rate=rate]
=オプション=
- t 対話的にグラフを作成
- s 標準入力からグラフを作成
- v 冗長出力をする
- h ヘルプを出力
- cycle=num 淘汰を起こす周期(1-)
- mute_per=per 交配率(0-10)
- mutate_per=per 変異率(0-10)
- mutate_rate=rate 変異の度合い(0-9)
オプションを指定しなかった場合、-tvとデフォルト
の値が指定されて実行される
END_OF_HELP
}
sub anly_opt{
my $opt;
$opt-＞{t} = 1; foreach(@ARGV){
if(!/=/){
if(/t/){
$opt-＞{t} = 1;
$opt-＞{s} = 0;
}
elsif(/s/){
$opt-＞{t} = 0;
$opt-＞{s} = 1;
} if(/v/){
$opt-＞{v} = 1;
} if(/h/){
$opt-＞{h} = 1;
}
}
else{
if(s/--cycle=//){
$opt-＞{cycle} = $_;
if($_ ＜ 1){
&error("オプションが不正です");
}
}
elsif(s/--mate_per=//){
$opt-＞{mate_per} = $_;
if($_ ＜ 0 or $_ ＞ 10){
&error("オプションが不正です");
}
}
elsif(s/--mutate_per=//){
$opt-＞{mutate_per} = $_;
if($_ ＜ 0 or $_ ＞ 10){
&error("オプションが不正です");
}
}
elsif(s/--mutate_rate=//){
$opt-＞{mutate_rate} = $_;
if($_ ＜ 0 or $_ ＞ 9){
&error("オプションが不正です");
}
}
}
} if(scalar(@ARGV) == 0){
$opt-＞{v} = 1;
}return $opt;
}
sub error{
my $msg = shift @_;
print "$msg\n";
exit;
}
sub main{
my $opt = &anly_opt();
my $graph;
my $env;
my $best;
if($opt-＞{h}){
&print_help();
exit;
} if($opt-＞{t} == 1){
$graph = Graph-＞talk_new();
}
elsif($opt-＞{s} == 1){
$graph = Graph-＞input_new();
}
else{
&error("グラフが作成されません");
} if($opt-＞{v} == 1){
$| = 1;
print "グラフのチェック中...";
$| = 0;
}
if($graph-＞check()){
if($opt-＞{v} == 1){
print "OK\n\n";
}
}else{
&error("グラフになっていません");
}$env = Environ-＞new($graph);
if(exists $opt-＞{cycle}){
$env-＞set_cycle($opt-＞{cycle});
}
if(exists $opt-＞{mate_per}){
$env-＞set_mate_per($opt-＞{mate_per});
}
if(exists $opt-＞{mutate_per}){
$env-＞set_mutate_per($opt-＞{mutate_per});
}
if(exists $opt-＞{mutate_rate}){
$env-＞set_mutate_rate($opt-＞{mutate_rate});
} if($opt-＞{v} == 1){
$| = 1;
print "グラフ彩色中...";
$| = 0;
}
while(1){
$env-＞next();
if(&determine($env)){
last;
}
}
if($opt-＞{v} == 1){
print "OK\n\n";
}$best = $env-＞get_max_DNA();
my @color = $best-＞get_color();
#データの整理
my $i = 0;
my %list;
foreach(@color){
$list{$_} .= "$i＜＞";
++$i;
}
$i = 1;
@color = ();
foreach(keys %list){
my @nums = split /＜＞/,$list{$_};
foreach(@nums){
$color[$_] = $i;
}
++$i;
}
if($opt-＞{v} == 1){
print "隣接行列\n";
$graph-＞print_matrix();
print "\n各点の色\n";
}
$i = 1;
foreach(@color){
printf "v%02d:%3d\n", $i, $_;
++$i;
}}
sub determine{
my $env = shift @_;
if($env-＞get_age() ＞ 1000){
return 1;
}
else{
return 0;
}}
&main();
いやぁ、無駄に長い（＾＾；
オプションを解析するクラスを一つ作っちゃった方がいいんですよねぇ。