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までの段階)は「世代」と呼ばれる。