AI Techniques for game programmingを読みながら学習
(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)
(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)))))))
(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)))))))
(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))))
(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)))
(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))
'(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)
(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)
Loop untill a solution is fond:
End Loop
解が求まるまで繰り返し:
つぎに
Each loop through the algorithm is called a generation (steps 1 through 5).
それぞれの繰り返しアルゴリズム(1から5までの段階)は「世代」と呼ばれる。