参考文献
- 作者: 伊庭斉志
- 出版社/メーカー: 東京電機大学出版局
- 発売日: 1996/06/01
- メディア: 単行本
- クリック: 3回
- この商品を含むブログ (5件) を見る
【謝罪】
- 本のCDに収録されていたサンプルコードを無断で公開してしまいました。過去においてFTPで公開されていたため問題が無いと独断で判断した結果でした。本にはライセンスに関して詳しく書かれていませんが、違反を犯す可能性があるので公開を停止しました。もし関係者の方々にご迷惑をおかけしてしまっていたのならまことに申し訳ありませんでした。以後このようなリンクを無断で張ることを避け許可を得る等のしかるべき対応を行うように心がけます。申し訳ありませんでした。
掲載してしまったファイルのオリジナルのソースコードが記述されたPDFファイルをGenetic Algorithms and Genetic Programmingからみつけました＞PDF file on Little LISP software for GP John Koza 氏オリジナルの資料のようです。
http://cs.felk.cvut.cz/~xobitko/ga/jp/intro.html
このページは、Javaアプレットで実際に動く(GPではなく)GAの例を見ることができます。GPのことも解説されていて、説明も丁寧で判りやすいです。
初期個体群の生成1
【内部主要記事】
【本文】
さて、今日は「個体群を作成する関数」を作ることにしました。コレを無事作り終えたなら、初期化の機能まで組み込めることになる。…ふむ、順調か？この関数の作成に参考文献に付属しているCLISPのコードを参考にしました。ソコに収録されているプロシージャ create-population をschemeへ移植するだけなんですけどね。
create-populationのアルゴリズムは大体以下のようなものです（本文は英語です）
- Creates the population
- コレは size-of-population の大きさの配列です。この配列は個体群を記録するために初期化されてます。各固体の「プログラム」スロットは第1のNプログラム(seeded-program？)を除いて適切な任意のプログラムに初期化されます。これらの最初のN固体は seeded-program によってそれぞれ初期化されます。この seeded-program はデバッグに役に立ちます。
で早速動作に疑問が出ました。初期個体群の生成をする手前に場所に書いてあるのですがよくわかりません。以下schemeに書き換えたプログラム。
;;テストのための暫定的な変数設定
(define *max-depth-for-new-individuals* 5)
(define minimum-depth-of-trees 1)
(define full-cycle-p #f)
(define individual-index 4)
(if (eq? 0 (modulo individual-index
(max 1 (- *max-depth-for-new-individuals*
minimum-depth-of-trees))))
(set! full-cycle-p (not full-cycle-p)))コレは、
- individual-index が奇数なら、必ず #
になる。 - individual-index が偶数なら、実行するたびに #t #f を切り替える。
という動作のようです。しかしコレはいったい何をやっているんだろう？
#
このプログラムでは when が出てきます。このwhenは scheme の標準関数ではないので一応書き換えておきます。gauche では使えるんですけどね。で、このwhenはいったい何か？
以下を見る限り、whenは条件を満たしたら式を実行、満たさなければ実行しないみたいです。
gosh>
(let ((i 0))
(when (= i 0)
(display "abc")))
abc#<undef>
gosh>
(let ((i 0))
(when (= i 1)
(display "abc")))
#<undef>
gosh>
(let ((i 0))
(when (= i 1)
(display "abc")
(display "ABC"))) <----ifと違って代替式を実行するわけではない。
#<undef>どうやら、whenはifと似た動作をするようです。
;; 個体数より seeded-program が多ければ
(if (< individual-index (length seeded-programs))
;; 種となる個体の選択
(nth individual-index seeded-programs)
;; 新しいランダムプログラム作成
(create-individual-program
(case *method-of-generation*
((full grow) *max-depth-for-new-individuals*)
((ramped-half-and-half)
(+ minimum-depth-of-trees
(modulo individual-index
(- *max-depth-for-new-individuals*
minimum-depth-of-trees))))) ;allowble-depth
#t ;top-node-p
(case *method-of-generation*
((full) #t)
((grow) #f)
((ramped-half-and-half)
full-cycle-p)))))) ;full-pこの動作は個体を生成するようです。初期個体群を用意するに当たっては
- ランダムプログラム作成して初期個体群の1つとする。
- あらかじめ seeded-program というプログラムのセットをどこかに用意しておいて、それを初期個体群の1つとする。
という２つの方法があるようです。で、この seeded-program を検索してみたら、サンプルコードのドコにも載っていない。コレは重要なんだろうか？。とりあえず seeded-program を作るか、全てランダムコードにするかしなければならないようです。さて、後日の課題に「seeded-programの作成」を追加すべきか、それともランダムコードのみでいくべきか悩みどころ。
(本文のアシスタント的な人：ネオン)
構文木が文法的に正しく出力されるようにする3(if文正常出力成功)
【内部主要記事】
if文が通常の使われ方をするようにコードを出力することに成功しました。
(use math.mt-random)
(define mt (make <mersenne-twister> :seed (sys-time)))
(define terminal
(lambda ()
(let ((rdm (mt-random-integer mt 26) ))
(string-ref "abcdefghijklmnopqrstuvwxyz" rdm))))
(define non-terminal
(lambda ()
(let ((rdm (mt-random-integer mt 2) ))
(cond
;((eq? rdm 0) 'car)
;((eq? rdm 1) 'cdr)
((eq? rdm 0) 'cons)
(else 'if)))))
;(eq? rdm 3) 'quote)
;((eq? rdm 3) 'if)
;((eq? rdm 4) 'define)
;((eq? rdm 4) 'eq?)
;(else 'list?)))))
(define atom?
(lambda (atom)
(if (pair? atom) #f #t)))
(define argument-map
(lambda ()
(list
;(cons 'car 1)
;(cons 'cdr 1)
;(cons 'list? 1)
(cons 'cons 2)
(cons 'eq? 2)
(cons 'atom? 1))))
(define if-eq '(if (eq?)))
(define allowable-depth 5) ;const
(define full-p #t) ;const
(define top-node-p #f) ;const
(define eq?-or-atom?
(lambda ()
(let ((ea (mt-random-integer mt 2) ))
(cond ((eq? ea 0) 'eq?)
((eq? ea 1) 'atom?)))))
; 指定された関数および終端記号を再帰的に使用して、プログラムを
; 作成します。argument-mapは、関数セットにおける各関数が
; いくつの引数を持つべきかを決定するのに使用されます。
; allowable-depthさは私たちが作成することができる木の残りの
; 深さであり、0がヒットした時は、単体の終端記号を選択します。
; 私たちが木のトップのノードとして呼ばれている場合に限り、
; top-node-pは真です。これは、常に木の一番上に関数を置いた
; ことを私たちが確かめることを可能にします。
; full-pは、最高に枝が多い個体かどうかを示します。
(define create-individual-program
(lambda (allowable-depth
top-node-p
full-p)
(cond ((<= allowable-depth 0)
;; 最深に到達。よって終端記号を選択する。
(terminal))
((or full-p top-node-p)
;; top-node-p か full-p を満たした。
;; よって非終端記号(関数)だけを選択する。
(let ((choice (non-terminal)))
; if が選択されたら eq? か list? を cons し
; choice を eq? か list? に変換する。
(cond ((eq? 'if choice)
(let ((eq-or-atom (mt-random-integer mt 2) ))
(define choice (cond ((eq? eq-or-atom 0) 'eq?)
((eq? eq-or-atom 1) 'atom?)))
(let ((number-of-arguments (cdr (assq choice (argument-map)))))
;(set! allowable-depth (- allowable-depth 2))
(list 'if (cons choice
(create-arguments-for-function
number-of-arguments
(- allowable-depth 1)
full-p))
(terminal)
(terminal) ))))
; choiceがif以外の場合。
(else
(let ((number-of-arguments (cdr (assq choice (argument-map)))))
(cons choice
(create-arguments-for-function
number-of-arguments
(- allowable-depth 1)
full-p)))))))
(else
;; 非終端記号(関数)か終端記号から1つ選ぶ。
;0 or 1 でまず2択にしてから関数を呼ぶ
(let ((set (mt-random-integer mt 2) ))
(let ((choice (cond ((eq? set 0) (terminal))
((eq? set 1) (non-terminal)) ) ))
(cond ((eq? set 1)
;; 非終端記号(関数)を選び、ここから下へ木を作成し続ける。
(let ((function choice)
(number-of-arguments (cdr (assq choice (argument-map)))))
(cons function
(create-arguments-for-function
number-of-arguments
(- allowable-depth 1)
full-p))))
;; atomを選ぶ
(else
(terminal)) ) ))))))
; ツリーのノード用の引数のリストを作成します。
; 引数の数は、今から作成される残りの引数の数です。
; 各引数は、create-individual-programを
; 使用することで正常な方法で作成されます。
(define create-arguments-for-function
(lambda (number-of-arguments
allowable-depth
full-p)
(cond ((eq? number-of-arguments 0)
())
(else
(cons (create-individual-program
allowable-depth
()
full-p)
(create-arguments-for-function
(- number-of-arguments 1)
allowable-depth
full-p))))))以下に実行例を示します。
gosh> (load "./random-tree.scm") #t ;;ランダムなプログラム出力 gosh> (create-individual-program allowable-depth top-node-p full-p) (cons (cons (if (eq? (if (atom? (cons #\d #\e)) #\a #\s) (if (eq? (cons #\h #\t) (if (atom? #\e) #\x #\u)) #\a #\p)) #\e #\u) (if (eq? (cons (cons #\i #\h) (cons #\m #\q)) (if (eq? (if (eq? #\g #\o) #\k #\y) (cons #\g #\y)) #\b #\o)) #\t #\c)) (cons (if (eq? (cons (cons #\s #\b) (if (eq? #\j #\b) #\b #\x)) (if (atom? (if (eq? #\n #\o) #\h #\d)) #\h #\u)) #\i #\v) (cons (cons (if (eq? #\i #\u) #\e #\t) (cons #\g #\m)) (cons (cons #\c #\t) (cons #\g #\t))))) ;;出力されたランダムなプログラムの実行 gosh> (cons (cons (if (eq? (if (atom? (cons #\d #\e)) #\a #\s) (if (eq? (cons #\h #\t) (if (atom? #\e) #\x #\u)) #\a #\p)) #\e #\u) (if (eq? (cons (cons #\i #\h) (cons #\m #\q)) (if (eq? (if (eq? #\g #\o) #\k #\y) (cons #\g #\y)) #\b #\o)) #\t #\c)) (cons (if (eq? (cons (cons #\s #\b) (if (eq? #\j #\b) #\b #\x)) (if (atom? (if (eq? #\n #\o) #\h #\d)) #\h #\u)) #\i #\v) (cons (cons (if (eq? #\i #\u) #\e #\t) (cons #\g #\m)) (cons (cons #\c #\t) (cons #\g #\t))))) ;;実行結果 ((#\u . #\c) #\v (#\t #\g . #\m) (#\c . #\t) #\g . #\t)
構文木が文法的に正しく出力されるようにする2
内部リンク
- 以下の変更を加える
- carを使わない。
- cdrを使わない。
- (実質、非終端記号(関数)はcons、if、list?、eq?)
とりあえず、出力された構文木(コード)は実行可能になりました。
まだ、if構文が(文法的に正しくても)、通常の使い方として
出力するように書き換えられていません。
(use math.mt-random)
(define mt (make <mersenne-twister> :seed (sys-time)))
(define terminal
(lambda ()
(let ((rdm (mt-random-integer mt 26) ))
(string-ref "abcdefghijklmnopqrstuvwxyz" rdm))))
(define non-terminal
(lambda ()
(let ((rdm (mt-random-integer mt 2) ))
(cond
;((eq? rdm 0) 'car)
;((eq? rdm 1) 'cdr)
((eq? rdm 0) 'cons)
(else 'if)))))
;(eq? rdm 3) 'quote)
;((eq? rdm 3) 'if)
;((eq? rdm 4) 'define)
;((eq? rdm 4) 'eq?)
;(else 'list?)))))
(define argument-map
(lambda ()
(list
;(cons 'car 1)
;(cons 'cdr 1)
(cons 'cons 2)
(cons 'eq? 2)
(cons 'list? 1))))
(define allowable-depth 5) ;const
(define full-p #t) ;const
(define top-node-p #f) ;const
; 指定された関数および終端記号を再帰的に使用して、プログラムを
; 作成します。argument-mapは、関数セットにおける各関数が
; いくつの引数を持つべきかを決定するのに使用されます。
; allowable-depthさは私たちが作成することができる木の残りの
; 深さであり、0がヒットした時は、単体の終端記号を選択します。
; 私たちが木のトップのノードとして呼ばれている場合に限り、
; top-node-pは真です。これは、常に木の一番上に関数を置いた
; ことを私たちが確かめることを可能にします。
; full-pは、最高に枝が多い個体かどうかを示します。
(define create-individual-program
(lambda (allowable-depth
top-node-p
full-p)
(cond ((<= allowable-depth 0)
;; 最深に到達。よって終端記号を選択する。
(terminal))
((or full-p top-node-p)
;; top-node-p か full-p を満たした。
;; よって非終端記号(関数)だけを選択する。
(let ((choice (non-terminal)))
; if が選択されたら eq? か list? を cons し
; choice を eq? か list? に変換する。
(cond ((eq? 'if choice)
(let ((eq-or-list (mt-random-integer mt 2) ))
(define choice (cond ((eq? eq-or-list 0) 'eq?)
((eq? eq-or-list 1) 'list?)))
(let ((number-of-arguments (cdr (assq choice (argument-map)))))
(cons 'if (cons choice
(create-arguments-for-function
number-of-arguments
(- allowable-depth 1)
full-p))))))
; choiceがif以外の場合。
(else
(let ((number-of-arguments (cdr (assq choice (argument-map)))))
(cons choice
(create-arguments-for-function
number-of-arguments
(- allowable-depth 1)
full-p)))))))
(else
;; 非終端記号(関数)か終端記号から1つ選ぶ。
;0 or 1 でまず2択にしてから関数を呼ぶ
(let ((set (mt-random-integer mt 2) ))
(let ((choice (cond ((eq? set 0) (terminal))
((eq? set 1) (non-terminal)) ) ))
(cond ((eq? set 1)
;; 非終端記号(関数)を選び、ここから下へ木を作成し続ける。
(let ((function choice)
(number-of-arguments (cdr (assq choice (argument-map)))))
(cons function
(create-arguments-for-function
number-of-arguments
(- allowable-depth 1)
full-p))))
;; atomを選ぶ
(else
(terminal)) ) ))))))
; ツリーのノード用の引数のリストを作成します。
; 引数の数は、今から作成される残りの引数の数です。
; 各引数は、create-individual-programを
; 使用することで正常な方法で作成されます。
(define create-arguments-for-function
(lambda (number-of-arguments
allowable-depth
full-p)
(cond ((eq? number-of-arguments 0)
())
(else
(cons (create-individual-program
allowable-depth
()
full-p)
(create-arguments-for-function
(- number-of-arguments 1)
allowable-depth
full-p))))))実行例
1.ランダムな構文木の出力 gosh> (create-individual-program allowable-depth top-node-p full-p) (cons (if eq? (cons (if eq? (if list? #\b) (if eq? #\f #\g)) (if eq? (if list? #\t) (cons #\f #\c))) (cons (cons (cons #\j #\o) (if list? #\t)) (cons (if eq? #\n #\o) (if eq? #\e #\s)))) (if eq? (cons (if eq? (if list? #\h) (cons #\m #\g)) (cons (cons #\w #\i) (if eq? #\g #\y))) (cons (cons (if eq? #\x #\i) (if eq? #\y #\y)) (if eq? (if list? #\o) (cons #\l #\k))))) 2.出力された構文木(コード)を実行 gosh> (cons (if eq? (cons (if eq? (if list? #\b) (if eq? #\f #\g)) (if eq? (if list? #\t) (cons #\f #\c))) (cons (cons (cons #\j #\o) (if list? #\t)) (cons (if eq? #\n #\o) (if eq? #\e #\s)))) (if eq? (cons (if eq? (if list? #\h) (cons #\m #\g)) (cons (cons #\w #\i) (if eq? #\g #\y))) (cons (cons (if eq? #\x #\i) (if eq? #\y #\y)) (if eq? (if list? #\o) (cons #\l #\k))))) 3.結果 ((#\b . #\t) #\h (#\w . #\i) . #\g)
注意：「#\」は文字型を意味します。
ランダムな個体(木構造)の生成 random-tree-v0.2.scm
内部リンク
出力コードが文法的に正しくなるように調整中。
(define mt (make <mersenne-twister> :seed (sys-time)))
(define terminal
(lambda ()
(let ((rdm (mt-random-integer mt 26) ))
(cond ((eq? rdm 0) 'a)
((eq? rdm 1) 'b)
((eq? rdm 2) 'c)
((eq? rdm 3) 'd)
((eq? rdm 4) 'e)
((eq? rdm 5) 'f)
((eq? rdm 6) 'g)
((eq? rdm 7) 'h)
((eq? rdm 8) 'i)
((eq? rdm 9) 'j)
((eq? rdm 10) 'k)
((eq? rdm 11) 'l)
((eq? rdm 12) 'm)
((eq? rdm 13) 'n)
((eq? rdm 14) 'o)
((eq? rdm 15) 'p)
((eq? rdm 16) 'q)
((eq? rdm 17) 'r)
((eq? rdm 18) 's)
((eq? rdm 19) 't)
((eq? rdm 20) 'u)
((eq? rdm 21) 'v)
((eq? rdm 22) 'w)
((eq? rdm 23) 'x)
((eq? rdm 24) 'y)
(else 'z)))))
(define non-terminal
(lambda ()
(let ((rdm (mt-random-integer mt 8) ))
(cond ((eq? rdm 0) 'car)
((eq? rdm 1) 'cdr)
((eq? rdm 2) 'cons)
((eq? rdm 3) 'quote)
((eq? rdm 4) 'if)
((eq? rdm 5) 'define)
((eq? rdm 6) 'eq?)
(else 'list?)))))
(define argument-map
(lambda ()
(list (cons 'car 1)
(cons 'cdr 1)
(cons 'cons 2)
(cons 'quote 1)
(cons 'define 2)
(cons 'if 3)
(cons 'eq? 2)
(cons 'list? 1))))
(define allowable-depth 5) ;const
(define full-p #t) ;const
(define top-node-p #f) ;const
; 指定された関数および終端記号を再帰的に使用して、プログラムを
; 作成します。argument-mapは、関数セットにおける各関数が
; いくつの引数を持つべきかを決定するのに使用されます。
; allowable-depthさは私たちが作成することができる木の残りの
; 深さであり、0がヒットした時は、単体の終端記号を選択します。
; 私たちが木のトップのノードとして呼ばれている場合に限り、
; top-node-pは真です。これは、常に木の一番上に関数を置いた
; ことを私たちが確かめることを可能にします。
; full-pは、最高に枝が多い個体かどうかを示します。
(define create-individual-program
(lambda (allowable-depth
top-node-p
full-p)
(cond ((<= allowable-depth 0)
;; 最深に到達。よって終端記号を選択する。
(terminal))
((or full-p top-node-p)
;; top-node-p か full-p を満たした。
;; よって非終端記号(関数)だけを選択する。
(let ((choice (non-terminal)))
(let ((number-of-arguments (cdr (assq choice (argument-map)))))
(cons choice
(create-arguments-for-function
number-of-arguments
(- allowable-depth 1)
full-p)))))
(else
;; 非終端記号(関数)か終端記号から1つ選ぶ。
;0 or 1 でまず2択にしてから関数を呼ぶ
(let ((set (mt-random-integer mt 2) ))
(let ((choice (cond ((eq? set 0) (terminal))
((eq? set 1) (non-terminal)) ) ))
(cond ((eq? set 1)
;; 非終端記号(関数)を選び、ここから下へ木を作成し続ける。
(let ((function choice)
(number-of-arguments (cdr (assq choice (argument-map)))))
(cons function
(create-arguments-for-function
number-of-arguments
(- allowable-depth 1)
full-p))))
;; atomを選ぶ
(else
(terminal)) ) ))))))
; ツリーのノード用の引数のリストを作成します。
; 引数の数は、今から作成される残りの引数の数です。
; 各引数は、create-individual-programを
; 使用することで正常な方法で作成されます。
(define create-arguments-for-function
(lambda (number-of-arguments
allowable-depth
full-p)
(cond ((eq? number-of-arguments 0)
())
(else
(cons (create-individual-program
allowable-depth
()
full-p)
(create-arguments-for-function
(- number-of-arguments 1)
allowable-depth
full-p))))))
構文木が文法的に正しく出力されるようにする1
内部リンク
- 以下の変更を加えます。
- ifの次にlist?かeq?かが来るようにする。
- defineは使わない
- quoteは使わない
- 終端記号(ここではアルファベット小文字)を文字型とする。
1は難しそう。
とりあえず掲載。
ifの構文はまだ変。
- listとatomを区別して配置する
という作業がはっせいするかも？
(use math.mt-random)
(define mt (make <mersenne-twister> :seed (sys-time)))
(define terminal
(lambda ()
(let ((rdm (mt-random-integer mt 26) ))
(string-ref "abcdefghijklmnopqrstuvwxyz" rdm))))
(define non-terminal
(lambda ()
(let ((rdm (mt-random-integer mt 5) ))
(cond ((eq? rdm 0) 'car)
((eq? rdm 1) 'cdr)
((eq? rdm 2) 'cons)
(else 'if)))))
(define argument-map
(lambda ()
(list (cons 'car 1)
(cons 'cdr 1)
(cons 'cons 2)
(cons 'eq? 2)
(cons 'list? 1))))
(define allowable-depth 5) ;const
(define full-p #t) ;const
(define top-node-p #f) ;const
; 指定された関数および終端記号を再帰的に使用して、プログラムを
; 作成します。argument-mapは、関数セットにおける各関数が
; いくつの引数を持つべきかを決定するのに使用されます。
; allowable-depthさは私たちが作成することができる木の残りの
; 深さであり、0がヒットした時は、単体の終端記号を選択します。
; 私たちが木のトップのノードとして呼ばれている場合に限り、
; top-node-pは真です。これは、常に木の一番上に関数を置いた
; ことを私たちが確かめることを可能にします。
; full-pは、最高に枝が多い個体かどうかを示します。
(define create-individual-program
(lambda (allowable-depth
top-node-p
full-p)
(cond ((<= allowable-depth 0)
;; 最深に到達。よって終端記号を選択する。
(terminal))
((or full-p top-node-p)
;; top-node-p か full-p を満たした。
;; よって非終端記号(関数)だけを選択する。
(let ((choice (non-terminal)))
; if が選択されたら eq? か list? を cons し
; choice を eq? か list? に変換する。
(cond ((eq? 'if choice)
(let ((eq-or-list (mt-random-integer mt 2) ))
(define choice (cond ((eq? eq-or-list 0) 'eq?)
((eq? eq-or-list 1) 'list?)))
(let ((number-of-arguments (cdr (assq choice (argument-map)))))
(cons 'if (cons choice
(create-arguments-for-function
number-of-arguments
(- allowable-depth 1)
full-p))))))
; choiceがif以外の場合。
(else
(let ((number-of-arguments (cdr (assq choice (argument-map)))))
(cons choice
(create-arguments-for-function
number-of-arguments
(- allowable-depth 1)
full-p)))))))
(else
;; 非終端記号(関数)か終端記号から1つ選ぶ。
;0 or 1 でまず2択にしてから関数を呼ぶ
(let ((set (mt-random-integer mt 2) ))
(let ((choice (cond ((eq? set 0) (terminal))
((eq? set 1) (non-terminal)) ) ))
(cond ((eq? set 1)
;; 非終端記号(関数)を選び、ここから下へ木を作成し続ける。
(let ((function choice)
(number-of-arguments (cdr (assq choice (argument-map)))))
(cons function
(create-arguments-for-function
number-of-arguments
(- allowable-depth 1)
full-p))))
;; atomを選ぶ
(else
(terminal)) ) ))))))
; ツリーのノード用の引数のリストを作成します。
; 引数の数は、今から作成される残りの引数の数です。
; 各引数は、create-individual-programを
; 使用することで正常な方法で作成されます。
(define create-arguments-for-function
(lambda (number-of-arguments
allowable-depth
full-p)
(cond ((eq? number-of-arguments 0)
())
(else
(cons (create-individual-program
allowable-depth
()
full-p)
(create-arguments-for-function
(- number-of-arguments 1)
allowable-depth
full-p))))))
