Gauche:遺伝的アルゴリズム
AI Techniques for game programmingを読みながら学習
- p.115 void CgaBob::Mutate
- p.114 void CgaBob::Crossover
- p.113 SGnome GgaBob::RouretteWheelSelection
- p.109 void CgaBob::Epoch()
- p.107 class CgaBob
- p.105 struct SGenome
- p.102 迷路データ
- p.99 Evolution Inside Your Computer
p.115 void CgaBob::Mutate
(define-method mutate ((obj <ga-bob>)(baby <genome>))
(set-bits! baby
(map
(lambda (bit) (if (< (random-real) (mutate-rate-of obj))
(if (> bit 0) 0 1)
bit))
(bits-of baby)))
baby)
p.114 void CgaBob::Crossover
(define-method crossover ((obj <ga-bob>) (mam <genome>) (dad <genome>))
(if (or (> (random-real) (crossover-rate-of obj))
(eq? mam dad))
(values mam dad)
(let ((cp (random-integer (- (chromo-length-of obj) 1))))
(values (make <genome> :bits (list (take (bits-of mam) cp)
(drop (bits-of dad) cp)))
(make <genome> :bits (list (take (bits-of dad) cp)
(drop (bits-of mam) cp)))))))
p.113 SGnome GgaBob::RouretteWheelSelection
(define-method routette-wheel-selection ((obj <ga-bob>))
(let ((slice (* (random-real) (total-fitness-score-of obj)))
(total 0))
(let loop ((glist (genome-list-of obj)))
(let ((total (+ total (fitness-of (car glist)))))
(if (> total slice)
(car glist)
(loop (cdr glist)))))))
p.109 void CgaBob::Epoch()
(define-method epoch ((obj <ga-bob>))
(define (make-generation obj)
(let ((mam (rourette-wheel-selection obj))
(dad (routette-wheel-selection obj)))
(receive (baby1 baby2) (crossover mam dad)
(let ((b1 (mutate baby1))
(b2 (mutate baby2)))
(list b1 b2)))))
(update-fitness-scores obj)
(set-genome-list! obj
(append-ec (: i (/ (pop-size-of obj) 2))
(make-generation obj))))
p.107 class CgaBob
(define-class <ga-bob> ()
((%genome-list :init-keyword :genome
:getter genome-list-of :setter set-genome-list!
:init-value '())
(%pop-size :init-keyword :pop-size :getter pop-size-of
:init-value 140)
(%crossover-rate :init-keyword :crossover-rate
:getter crossover-rate-of :init-value 0.7)
(%mutation-rate :init-keyword :mutation-rate :init-value 0.001)
(%chromo-length :init-keyword :chromo-length
:getter chromo-length-of :init-value 70)
(%gene-length :init-keyword :gene-length :init-value 2)
(%fittest-genome :init-keyword :fittest-genome :init-value 0)
(%best-fitness-score :init-keyword :best-fitness-score :init-value 0)
(%total-fitness-score :init-keyword :total-fitness-score
:getter total-fitness-score-of
:init-value 0)
(%generation :init-keyword :generation :init-value 0)
(%bobs-map :init-keyword :bobs-map :init-value #f)
(%bobs-brain :init-keyword :bobs-brain :init-value #f)
(%busy :init-keyword :busy :init-value #f)))
p.105 struct SGenome
(use srfi-27)
(use srfi-42)
(define-class <genome> ()
((bits :init-keyword :bits
:getter bits-of :setter set-bits!
:init-value '())
(fitness :init-keyword :fitness :getter fitness-of :init-value 0)))
(define (make-genome length)
(let ((genome (make <genome>)))
(set-bits! genome
(list-ec (: i length) (random-integer 2)))
genome))
p.102 迷路データ
'(1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 0 0 0 1 8 0 0 0 0 0 0 0 1 1 1 0 0 0 1 1 0 0 0 1 1 1 0 0 1 0 0 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 1 1 1 0 0 1 1 1 0 0 0 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 1 0 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 5 1 0 1 1 0 0 0 1 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
class CBobsMap
(define-class <bobs-map> ()
((%map :init-keyword :map
:init-value '(1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
1 0 1 0 0 0 0 0 1 1 1 0 0 0 1
8 0 0 0 0 0 0 0 1 1 1 0 0 0 1
1 0 0 0 1 1 1 0 0 1 0 0 0 0 1
1 0 0 0 1 1 1 0 0 0 0 0 1 0 1
1 1 0 0 1 1 1 0 0 0 0 0 1 0 1
1 0 0 0 0 1 0 0 0 0 1 1 1 0 1
1 0 1 1 0 0 0 1 0 0 0 0 0 0 5
1 0 1 1 0 0 0 1 0 0 0 0 0 0 1
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1))
(%map-width :init-keyword :map-width :init-value 15)
(%map-height :init-keyword :map-height :init-value 10)
(%start-x :init-keyword :start-x :init-value 14)
(%start-y :init-keyword :start-y :init-value 7)
(%end-x :init-keyword :start-x :init-value 0)
(%end-y :init-keyword :start-y :init-value 2)
(memory :init-keyword :memory :init-value '())))
(define-method initialize ((obj <bobs-map>))
(next-method)
(reset-memory obj))
(define-generic test-route) ;; (path) (memory <bobs-map>)
(define-generic render) ;; (x-client) (y-client) (surface)
(define-generic memory-render) ;; (x-client) (y-client) (surface)
(define-generic reset-memory)
p.99 Evolution Inside Your Computer
Loop untill a solution is fond:
- Test each chromosome to see how good it is at solving the problem and assign a fitness score accordingly
- Select two members from the current population. The Probability of being selected is proportional to the chromosome's fitness -- the higher the fitness, the better the probability of being selected. A common method for this is called Roulette wheel selection.
- Dependent on the Crossover Rate, crossover the bits from each chosen chromosome at a randomly chosen point.
- Step through the chosen chromosome's bits and flip dependent on the Mutation Rate.
- Repeat steps 2, 3, and 4 until a new population of the hundred members has been created.
End Loop
解が求まるまで繰り返し:
- それぞれの染色体が問題を解くのにどのぐらい役立つか見極め、また適宜適切なスコアを割り振って試験する
- 現在の群から2つのメンバーを選択する。 選択される確率は染色体の適切性に比例する--適切性が高いなら、選択される確率はより良くなる。 この一般的な方法は「ルーレットの輪の選択」と呼ばれる。
- 「交差比率」に従い、選択された染色体それぞれから無作為に点を抽出してビットを交差させる
- 段階を経て染色体のビットを選択し、「突然変異率」に従って反転させる
- 100個ほどの数の新たな群が生成されるまで2〜4を繰り返す。
つぎに
Each loop through the algorithm is called a generation (steps 1 through 5).
それぞれの繰り返しアルゴリズム(1から5までの段階)は「世代」と呼ばれる。