-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathoriginal-backup
179 lines (153 loc) · 6.44 KB
/
original-backup
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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
(ns genetic-programming.core)
(defn make-program-into-fn
"Takes a GP program represented as a list, with input x,
and transforms it into a function that can be called on an input.
NOTE: If your GP uses variables other than x, will need to change
the argument list below to something other than [x]!"
[program]
(eval (list 'fn '[x] program)))
(def target
(map #(vector % (+ (* % % %) % 3))
(range -1.0 1.0 0.1)))
(def instructions
'{+ 2
* 2
- 2
pd 2
inc 1})
(def line-separator
"-------------------------------------------------------------------------")
(defn program-size
"Finds the size of the program, i.e. number of nodes in its tree."
[prog]
(if (not (seq? prog))
1
(count (flatten prog))))
(defn pd
[num denom]
(if (zero? denom)
0
(/ num denom)))
(defn select-terminal
[]
(let [random (rand-int 2)]
(if (zero? random)
(rand-nth (concat (list(rand 11)) (list(* -1 (rand 11)))))
'x)))
(defn select-fun
[]
(rand-nth '(+ - * pd)))
(defn generate-prog
[depth]
(if (zero? depth)
(select-terminal)
(list (select-fun)
(generate-prog (dec depth))
(generate-prog (dec depth)))))
(defn generate-pop
[pop-size]
(take pop-size
(repeatedly #(generate-prog (rand-int 2)))))
(def population
(generate-pop 10))
(defn eval-fitness
"Evaluates the error of an individual (the lower, the better)."
[prog]
(let [prog-function (make-program-into-fn prog)]
(reduce + (map (fn [[var1 var2]]
(Math/abs (-' (prog-function var1) var2)))
target))))
(defn select-random-subtree
"Given a program, selects a random subtree and returns it."
([prog]
(select-random-subtree prog (rand-int (program-size prog))))
([prog subtree-index]
(cond
(not (seq? prog)) prog
(and (zero? subtree-index)
(some #{(first prog)} (keys instructions))) prog
(< subtree-index (program-size (first prog))) (recur (first prog)
subtree-index)
:else (recur (rest prog)
(- subtree-index (program-size (first prog)))))))
(defn replace-random-subtree
"Given a program and a replacement-subtree, replace a random node
in the program with the replacement-subtree."
([prog replacement-subtree]
(replace-random-subtree prog replacement-subtree (rand-int (program-size prog))))
([prog replacement-subtree subtree-index]
(cond
(not (seq? prog)) replacement-subtree
(zero? subtree-index) replacement-subtree
:else (map (fn [element start-index]
(if (<= start-index
subtree-index
(+ start-index -1 (program-size element)))
(replace-random-subtree element
replacement-subtree
(- subtree-index start-index))
element))
prog
(cons 0 (reductions + (map program-size prog)))))))
(defn mutate
[prog]
(replace-random-subtree prog (generate-prog (rand-int 3))))
(defn crossover
[prog1 prog2]
(replace-random-subtree prog1 (select-random-subtree prog2)))
(defn pair-individuals-errors
"Returns a vector of [individual error] pairs."
[population]
(vec (map #(vector % (eval-fitness %)) population)))
(defn sort-population
"Sorts the population by ascending order of errors."
[population]
(let [individuals-errors (pair-individuals-errors population)]
(vec (map first ; get the individuals only (discards the error from [individual error])
(sort #(< (second %1) (second %2)) individuals-errors)))))
(defn random-selection
"Selects a random individual from the population of programs, without evaluating
the fitness of the programs."
[population]
(rand-nth population))
(defn tournament-selection
"Selects an individual from the population of programs using tournament-like selection."
[population tournament-size]
(let [index-value (apply min (take tournament-size
(repeatedly #(rand-int (count population)))))]
; index-value is the lowest integer returned by getting index positions repeatedly from
; the population. The individual at this index position is the fittest as compared to
; others in this tournament (assuming that the population is already sorted).
(nth population index-value)))
(defn evolve
[population-size max-generations mutation-ratio crossover-ratio error-threshold]
(if (> (+ mutation-ratio crossover-ratio) 1)
(println "Error: The sum of mutation and crossover ratios should be <= 1.")
(loop [generation-number 0
population (sort-population (generate-pop population-size))]
(let [best-individual (first population)
best-individual-error (eval-fitness best-individual)]
(println line-separator)
(println "Generation number:" generation-number)
(println "Best program so far:" best-individual)
(println "Best error so far:" best-individual-error)
(cond
(< best-individual-error error-threshold) (println line-separator
"\nEvolution successful! \nProgram: "
best-individual
"\nError:" best-individual-error)
(= generation-number max-generations) (println line-separator
"\nMaximum number of generations exceeded! \nBest program so far:"
best-individual
"\nError:" best-individual-error)
:else (recur
(inc generation-number)
(sort-population
(for [i (range population-size)]
(let [genetic-operator (rand)]
(cond
(< genetic-operator mutation-ratio) (mutate (tournament-selection population 7))
(< genetic-operator (+ mutation-ratio crossover-ratio))
(crossover (tournament-selection population 7) (tournament-selection population 7))
:else (tournament-selection population 7)))))))))))
(evolve 500 100 0.5 0.4 0.1)