ランダムな個体(木構造)の生成 random-tree-v0.1.scm デバッグバージョン
cond car cdr if 等をランダムに組み合わせて構文木を構築するプログラムを書いてみました。
以下に示した生成プログラムによって生成されたコードは、まだ正しい文法にはなりません。
それと、出力されるコードの構文木の深さを表すallowable-depthが生成プログラム中のどこで
インクレメントされているかがわからないです…
遺伝的プログラミング (情報科学セミナー)のサンプルの一つ
に収められているcreate-individual-program, create-arguments-for-function
(ともに古いCLISPっぽい)をを参考に、以下のschemeのコードを自分で書きました。
(use math.mt-random)
(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
; Creates a program recursively using the specified functions
; and terminals. Argument map is used to determine how many
; arguments each function in the function set is supposed to
; have if it is selected. Allowable depth is the remaining
; depth of the tree we can create, when we hit zero we will
; only select terminals. Top-node-p is true only when we
; are being called as the top node in the tree. This allows
; us to make sure that we always put a function at the top
; of the tree. Full-p indicates whether this individual
; is to be maximally bushy or not.
; 指定された関数および終端記号を再帰的に使用して、プログラムを
; 作成します。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)
(display " A ")
;; We've reached maxdepth, so just pack a terminal.
;; 最深に到達。よって終端記号を選択する。
(terminal))
((or full-p top-node-p)
(display " B ")
;; We are the top node or are a full tree,
;; so pick only a function.
;; 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
(display " C ")
;; choose one from the bag of functions and terminals.
;; 非終端記号(関数)か終端記号から1つ選ぶ。
;0 or 1 でまず2択にしてから関数を呼ぶ
(let ((set (mt-random-integer mt 2) ))
(let ((choice (cond ((eq? set 0) (display " D ") (terminal))
((eq? set 1) (display " E ") (non-terminal)) ) ))
(display choice)
(cond ((eq? set 1)
;; We chose a function, so pick it out and go
;; on creating the tree down from here.
;; 非終端記号(関数)を選び、ここから下へ木を作成し続ける。
(display " F ")
(display choice)
(let ((function choice)
(number-of-arguments (cdr (assq choice (argument-map)))))
(display " G ")
(cons function
(create-arguments-for-function
number-of-arguments
(- allowable-depth 1)
full-p))))
;; We chose an atom, so pick it out.
;; atomを選ぶ
(else
(display " H ")
(terminal)) ) ))))))
; Creates the argument list for a node in the tree.
; Number-Of-Arguments is the number of arguments still
; remaining to be created. Each argument is created
; in the normal way using Create-Individual-Program.
; ツリーのノード用の引数のリストを作成します。
; 引数の数は、今から作成される残りの引数の数です。
; 各引数は、create-individual-programを
; 使用することで正常な方法で作成されます。
(define create-arguments-for-function
(lambda (number-of-arguments
allowable-depth
full-p)
(display "\tI-")
(display allowable-depth)
(cond ((eq? number-of-arguments 0)
(display "\tJ-")
(display allowable-depth)
()
)
(else
(display "\tK-")
(display allowable-depth)
(cons (create-individual-program
allowable-depth
()
full-p)
(create-arguments-for-function
(- number-of-arguments 1)
allowable-depth
full-p))))))実行結果の例(ランダムに作っているので毎回違います。これはその一例です。)
gosh> (create-individual-program allowable-depth top-node-p full-p)
B I-4 K-4 B I-3 K-3 B I-2 K-2 B I-1
K-1 B I-0 K-0 A I-0 J-0 I-1 J-1
I-2 J-2 I-3 J-3 I-4 J-4
''(car (cdr (list? g)))display文を使用してデバッグ出力してます。
A〜Kでどの経路をたどったかチェック。
H-4 や J-0 などHの後の数字は、現在の構文木の深さを表してます。
この実行結果ではI,J,A,Bしか通過していないはずで、
その経路にはallowable-depthが増加する要因は無いはず。
仮にI,J,K,A,B以外の経路を通過してもallowable-depthは増加しないように見える…
なんで増えるんだろう？
まぁ、増えないとちゃんとランダムな構文木を作ってくれないと思うけど…
- 考えてみたら、関数に (number-of-arguments - 1) を渡しているから再帰から戻ると元の値(これがインクリメントに見えた)になり、また関数に入ると(number-of-arguments - 1) を渡すので、allowable-depthは増加しないという結論に至りました。このことを示そうと思い、traceを使う方法を次のページを参考にしました。[2006.8.2 修正]
- Gauche:FAQ
- ひげぽんさんのページ
- apt-get install slib を試す方法
などを行ったのですが、残念ながらどれもうまくいかずtraceをgaucheで使うにいたりませんでした。
