マッチ箱の脳(AI)のお題をClojureで解いてみる。
まずは一番初めの遺伝的アルゴリズム(Genetic Algorithm)
マッチ箱は使わないので、以下のような仕様でプログラムを作ってみます。
- 遺伝子の世代交代を繰り返し三択問題を10個解くのに優良な遺伝子を残すプログラム
- 三択問題の解答はあらかじめ定数で与えておく。
- 各個体は三択問題への解答と対応する数字を10個遺伝子として持っている。
- 問題に対して100点満点の解答を行う個体が出現するまで世代交代を繰り返し、繰り返した個体数を得る。
世代交代は以下のように行うものとします。
- 各個体の採点を行い、成績上位の2個体が親となる。
- 親の各個体の遺伝子を適当な位置で分割し、それぞれ交換したものを子供とする。(2個体ができる)
- 子供の遺伝子は10個の中から適当なものが突然変異する。
- 成績順位下位の2個体は淘汰される。(子供と入れ替わる)
実際作ってみたコードはこんな感じ
; 正解
(def right-answers [0 2 1 2 1 2 1 2 0 0])
; 個体を作る
(defn create-individual []
(repeatedly 10 #(+ (rand-int 3))))
; 個体の採点をする
(defn score-generic [gen]
(* 10 (count (filter true? (map = gen right-answers)))))
; 遺伝子を突然変異させる
(defn mutate [gen]
(let [n (rand-int 11)]
; nが10の場合は突然変異しない
(if (= n 10) gen
(assoc (vec gen) n (rand-int 3)))))
; 遺伝子の交叉を行う
(defn cross [p1 p2]
(let [cross-point (+ 2 (rand-int 10))]
(if (> cross-point 9) [p1 p2]
(let [c1 (concat (take cross-point p1) (take-last (- 10 cross-point) p2))
c2 (concat (take cross-point p2) (take-last (- 10 cross-point) p1))]
[c1 c2]
))))
; 引数で与えられた各個体の採点を行い、世代交代を繰り返す。
; 成績順位の上位2個体が親となり最下位の2個体は淘汰される。
; 100点満点の個体が現れた時点で処理を終了し、世代数を返す
(defn generate [gens]
(loop [gens gens generation 1]
; まず、成績順にソートする
(let [sorted-gens (sort-by score-generic > gens)]
; 100点の個体がいたら世代数を返却する
(if (= (apply max (map score-generic sorted-gens)) 100) generation
; 成績上位の2個体で交叉と突然変異を行い、子供の個体を二つ作り、成績下位の2個体と入れ替える
(let [[c1 c2] (map mutate (apply cross (take 2 sorted-gens)))]
(recur (-> (drop-last 2 sorted-gens)
(conj c1)
(conj c2))
(inc generation)))))))
100個の個体で試してみるには
=> (generate
(repeatedly 100 create-individual))
で100点の個体を得るまでに世代交代を繰り返した数を返してくれる。
試してみると、generateに与える個体数が多いほど優良個体が現れるまでの世代交代の数は少なくなる傾向がある、ということがわかります。
100万個くらいの個体を与えた時の計算速度が遅いのがちょっと気に入らない。