ランダムな個体(木構造)の生成 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))))))
