-
Notifications
You must be signed in to change notification settings - Fork 1
/
gp.clj
97 lines (82 loc) · 2.67 KB
/
gp.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
(ns gp (:require [clojure.zip :as zip]))
(defn- rand-elem [coll]
(nth coll (rand-int (count coll))))
(defn- replicate-fn [n f]
(take n (repeatedly f)))
;; (list function
;; (initialize functions terminals (dec height))
;; (initialize functions terminals (dec height)))
(defn initialize [functions terminals height]
(if (= 0 height)
(rand-elem terminals)
(let [[function arity] (rand-elem functions)]
(cons function
(take arity
(repeatedly
#(initialize functions terminals (dec height))))))))
(defn count-nodes [tree]
(if-let [children (and (seq? tree) (next tree))]
(apply + 1
(map #(count-nodes %) children))
1))
(defn height [tree]
(if-let [children (and (seq? tree) (next tree))]
(apply max
(map #(inc (height %)) children))
0))
(defn- nth-zipper [n tree f]
(loop [distance n
zipper (zip/seq-zip tree)]
(if (= 0 distance)
(f zipper)
(recur (if (zip/branch? zipper)
distance
(dec distance))
(zip/next zipper)))))
(defn get-node [n tree]
(nth-zipper n tree zip/node))
(defn set-node [n replacement tree]
(nth-zipper n tree
#(zip/root (zip/replace % replacement))))
(defn crossover [max-height male female]
(let [child
(set-node
(rand-int (count-nodes male))
(get-node (rand-int (count-nodes female))
female)
male)]
(if (> (height child) max-height)
male
child)))
(defn to-fn [args tree]
(eval `(memoize (fn [~@args] ~tree))))
(def to-fn (memoize to-fn))
(defn- fitter [fitness parameters x y]
(if (> (fitness (to-fn parameters x))
(fitness (to-fn parameters y)))
x y))
(defn select [fitness parameters individuals]
(let [x (rand-elem individuals)
y (rand-elem individuals)]
(fitter fitness parameters x y)))
(defn fittest [fitness parameters individuals]
(reduce #(fitter fitness parameters %1 %2)
individuals))
(defn evolve [{:keys [generations population-size max-height
fitness termination
functions parameters terminals] :as options}]
(loop [generation 0
population (replicate-fn population-size
#(initialize functions
(concat terminals parameters) max-height))
best (fittest fitness parameters population)]
(when-let [o (:output options)] (o generation best population))
(if (or (termination (to-fn parameters best))
(= generation generations))
(do (shutdown-agents) best)
(recur (inc generation)
(map (fn [_] (crossover max-height
(select fitness parameters population)
(select fitness parameters population)))
population)
(fittest fitness parameters (conj population best))))))