├── .gitignore ├── LICENSE ├── README.md ├── project.clj ├── src └── darwin │ ├── algorithms │ ├── spea2.clj │ └── sso.clj │ ├── core.clj │ ├── evolution │ ├── core.clj │ ├── metrics.clj │ ├── pareto.clj │ ├── reproduction.clj │ ├── scoring.clj │ ├── selection.clj │ └── transform.clj │ └── utility │ └── random.clj └── ws └── demo.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | /.gorilla-port 11 | .idea 12 | *.iml 13 | .DS_Store 14 | /nb/data -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Imperial College London 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 21 | THE SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Darwin 2 | 3 | Darwin is a flexible framework for programming genetic algorithms, aimed at research applications. It is representation 4 | agnostic, working just as well for simple GA examples as it does for complex genetic programming problems. It can be 5 | configured to perform both single- and multi-objective optimisation, including the SPEA2 algorithm. It has facility for 6 | adaptive evolution where the run parameters evolve in response to changes in the population. 7 | 8 | ## Usage 9 | 10 | Add it to your project.clj file: 11 | ```` 12 | [darwin "1.0.0"] 13 | ```` 14 | 15 | A simple usage example can be found in the ws/demo.clj, viewable 16 | [here](http://viewer.gorilla-repl.org/view.html?source=github&user=JonyEpsilon&repo=darwin&path=ws/demo.clj). 17 | 18 | ## License 19 | 20 | Copyright © 2015 Imperial College London 21 | 22 | Distributed under the MIT licence. 23 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | ; 2 | ; This file is part of darwin. 3 | ; 4 | ; Copyright (C) 2014-, Imperial College, London, All rights reserved. 5 | ; 6 | ; Contributors: Jony Hudson 7 | ; 8 | ; Released under the MIT license.. 9 | ; 10 | 11 | (defproject darwin "1.0.1" 12 | :url "https://github.com/JonyEpsilon/darwin" 13 | :license {:name "MIT"} 14 | :dependencies [[org.clojure/clojure "1.6.0"]] 15 | :javac-options ["-target" "1.7" "-source" "1.7"] 16 | :plugins [[lein-gorilla "0.3.4"]] 17 | :jvm-opts ^:replace ["-server" "-Xmx4g"]) 18 | -------------------------------------------------------------------------------- /src/darwin/algorithms/spea2.clj: -------------------------------------------------------------------------------- 1 | ; 2 | ; This file is part of darwin. 3 | ; 4 | ; Copyright (C) 2014-, Imperial College, London, All rights reserved. 5 | ; 6 | ; Contributors: Jony Hudson 7 | ; 8 | ; Released under the MIT license.. 9 | ; 10 | 11 | (ns darwin.algorithms.spea2 12 | "An implementation of the SPEA2 algorithm of Zitzler et al. Well, almost. There's a very slight 13 | difference in way the archive is constructed. Using my technique you can replicate SPEA2 exactly, but 14 | it runs slowly. You can approximate the behaviour of SPEA2 and have it run pretty fast. I've tested 15 | the approximation on a few problems and it doesn't seem to make any real difference. See the archive 16 | thinner functions for details of the difference. 17 | 18 | This code is currently limited to two objectives, but the API is arranged so that should be easy to 19 | generalise if needed." 20 | (:require [darwin.evolution.pareto :as pareto] 21 | [kdtree] 22 | [darwin.evolution.selection :as selection])) 23 | 24 | ;; These functions can be grouped into: 25 | ;; - functions for calculating the fitness values 26 | ;; - functions for constructing the archive from the population and previous archive 27 | ;; - functions for plugging the algorithm into darwin.evolution.core 28 | 29 | 30 | ;; * Fitness calculation functions * 31 | 32 | (defn- calculate-strength 33 | "The strength of an individual is the count of how many individuals it dominates. This function 34 | calculates the strength for each member of the population, and assocs it into the individual." 35 | [keys population] 36 | (map 37 | #(assoc % :spea2-strength (pareto/dominated-count keys population %)) 38 | population)) 39 | 40 | (defn- calculate-raw-fitness 41 | "The raw fitness of an individual i is the sum of the strengths of the individuals that dominate i. 42 | The smaller this fitness measure the better." 43 | [keys population i] 44 | (let [dominators (pareto/dominator-set keys population i)] 45 | (apply + (map :spea2-strength dominators)))) 46 | 47 | 48 | (defn- calculate-raw-fitnesses 49 | "Calculates raw fitnesses for each individual in a population and assocs it into the individual's 50 | under the :spea2-raw-fitness key" 51 | [keys population] 52 | (let [counted-pop (calculate-strength keys population)] 53 | (map 54 | #(assoc % :spea2-raw-fitness (calculate-raw-fitness keys counted-pop %)) 55 | population))) 56 | 57 | (defn coords-from-individual 58 | "Get the individuals coordinates in objective space as a vector." 59 | [[k1 k2] i] 60 | [(k1 i) (k2 i)]) 61 | 62 | (defn- calculate-density 63 | [distance] 64 | (/ 1 (+ distance 2))) 65 | 66 | (defn- kth-nearest-distance 67 | "Get the distance to the kth nearest neighbour of p, given a set of points represented by the given kd-tree." 68 | [tree k p] 69 | (Math/sqrt (first (sort > (map :dist-squared (kdtree/nearest-neighbor tree p k)))))) 70 | 71 | (defn- calculate-densities 72 | "Calculate the 'densities' for each individual in a population. The density is defined as 1 / (distance to 73 | kth-nearest neighbour + 2). k is taken as the sqrt of the population size. Assocs the densities into the 74 | individuals." 75 | [[k1 k2] population] 76 | (let [k (Math/sqrt (count population)) 77 | ;; we extract the coordinates of each individual in objective space and build a kd-tree from them 78 | ;; so we can efficiently find the nearest neighbours. 79 | coords (map (partial coords-from-individual [k1 k2]) population) 80 | tree (kdtree/build-tree coords)] 81 | (map #(assoc % :spea2-density 82 | (calculate-density 83 | (kth-nearest-distance tree k (coords-from-individual [k1 k2] %)))) 84 | population))) 85 | 86 | (defn calculate-fitnesses 87 | "Calculates the SPEA2 fitness values with respect to the given keys. Assocs the fitness values into 88 | a :spea2-fitness key." 89 | [keys population] 90 | (map #(assoc % :spea2-fitness (+ (:spea2-raw-fitness %) (:spea2-density %))) 91 | (->> population 92 | (calculate-densities keys) 93 | (calculate-raw-fitnesses keys)))) 94 | 95 | 96 | ;; * Archive construction functions * 97 | 98 | (defn- k-nearest-distances 99 | "Returns the distances to the k nearest neighbours, in ascending order. The first neighbour is really 100 | a neighbour, not the point itself." 101 | [tree k-max p] 102 | ;; the rest drops the distance from the point to itself, which is always zero 103 | (apply vector (rest (sort < (map #(Math/sqrt (:dist-squared %)) (kdtree/nearest-neighbor tree p k-max)))))) 104 | 105 | (defn- remove-one-item 106 | "One step of the archive thinning routine, removes one individual from the archive." 107 | [goals comparison-depth tree-and-archive] 108 | (let [tree (:tree tree-and-archive) 109 | oversized-archive (:archive tree-and-archive) 110 | measured-archive (map #(assoc % :spea2-distances 111 | (k-nearest-distances tree comparison-depth (coords-from-individual goals %))) 112 | oversized-archive) 113 | ;; this next step relies on the sort being done lexicographically on the distance arrays. 114 | ;; That `sort-by` does this isn't mentioned in the docstring, but is explicitly stated 115 | ;; here http://clojure.org/data_structures 116 | sorted-archive (sort-by :spea2-distances measured-archive)] 117 | {:archive (rest sorted-archive) 118 | :tree (kdtree/delete tree (coords-from-individual goals (first sorted-archive)))})) 119 | 120 | (defn thin-archive 121 | "SPEA2 has a fairly complicated prescription for thinning out the archive if it's oversized. It specifies 122 | that one should look for the individual who has the least distance to its nearest neighbour. If this doesn't 123 | yield a unique individual, then we should rank on distance to the second nearest neighbour, recursing until 124 | the tie is broken. We remove this individual from the population and repeat until we have thinned the archive 125 | to the desired size. 126 | 127 | We implement a modification of this algorithm. Instead we calculate for each point the distance to its 128 | `comparison-depth` nearest neighbours. We then sort the points lexicographically by these distance lists 129 | and drop the first item. Then we recalculate the distances and repeat to drop the desired number of items. 130 | If `comparison-depth` is the same as the archive size then this is equivalent to the SPEA2 technique, 131 | although spectacularly inefficient. Experiments have shown that using a `comparison-depth` of 5 does not 132 | give appreciably different results than SPEA2 for common problems." 133 | [goals oversized-archive comparison-depth target-size] 134 | (let [coords (map (partial coords-from-individual goals) oversized-archive) 135 | tree (kdtree/build-tree coords) 136 | thinned-tree-and-archive (nth (iterate 137 | (partial remove-one-item goals comparison-depth) 138 | {:tree tree :archive oversized-archive}) 139 | (- (count oversized-archive) target-size))] 140 | (:archive thinned-tree-and-archive))) 141 | 142 | (defn- dedupe-individual 143 | "Checks whether an individual has been seen, wrt a seen-set, and if not adds it to the collection (and set)." 144 | [goals [seen-set deduped-coll] individual] 145 | (let [coords (coords-from-individual goals individual) 146 | dupe (contains? seen-set coords)] 147 | (if dupe 148 | [seen-set deduped-coll] 149 | [(conj seen-set coords) (conj deduped-coll individual)]))) 150 | 151 | (defn deduplicate-population 152 | "Remove duplicated with respect to the scores for `goals` from the given population." 153 | [goals archive] 154 | (last (reduce (partial dedupe-individual goals) [#{} []] archive))) 155 | 156 | (defn make-new-archive 157 | "Implements the core step of the SPEA2 algorithm which is constructing a new archive of elite 158 | individuals from the old archive and a population of new individuals." 159 | [goals deduplicate comparison-depth archive-size population old-archive] 160 | (let [pool (into population old-archive) 161 | scored-pool (calculate-fitnesses goals pool) 162 | ;; individuals that are non-dominated will have a fitness less than 1. Duplicates are removed if the 163 | ;; dedupe parameter is true. It's not quite clear to me whether deduplication is part of the SPEA2 algorithm 164 | ;; as published. But I suppose it doesn't matter, so long as you can turn it on and off! 165 | dedupe-fn (if deduplicate (partial deduplicate-population goals) identity) 166 | new-elites (dedupe-fn (filter #(< (:spea2-fitness %) 1.0) scored-pool)) 167 | new-size (count new-elites) 168 | ;;_ (println "New archive raw size: " new-size) 169 | ] 170 | ;; there are three cases here: either the new archive is exactly the right size, too big, or too small 171 | (cond 172 | ;; the easy one, if we happen to have the right number, then we're done. 173 | (= new-size archive-size) new-elites 174 | ;; if we have too few non-dominated individuals to fill the archive then we select the dominated 175 | ;; individuals with the lowest fitness scores to make up the difference. The easiest way to do this 176 | ;; is to just sort and select from the pool. If requested, the pool is deduplicated. See above for notes. 177 | (< new-size archive-size) (take archive-size (sort-by :spea2-fitness < (dedupe-fn scored-pool))) 178 | ;; and finally, if we've got too many non-dominated individuals then some of them are for the chop 179 | (> new-size archive-size) (thin-archive goals new-elites comparison-depth archive-size)))) 180 | 181 | 182 | ;; * darwin.evolution.core configuration * 183 | 184 | (defn spea2-config 185 | "A configuration implementing SPEA2. Needs to be fed the set of goal keys (which must be of 186 | length 2 currently) and the unary and binary genetic operations that will be used in reproduction. 187 | 188 | The SPEA2 algorithm preserves an elite population from generation to generation. On each iteration 189 | first the newly bred individuals will be pooled with the elite population, and all have their 190 | :spea2-fitness calculated. Then, a new elite population is constructed made up of the non-dominated 191 | individuals - with thinning if there are too many elite individuals, and promotion from the population 192 | if there are too few. Finally, a new generation is bred from the archived individuals, using binary 193 | tournament selection on the :spea2-fitness, and the cycle begins again. 194 | 195 | There are a couple of deviations from the SPEA2 algorithm as described in the literature. First, the 196 | thinning algorithm is slightly simplified (see above). The setting :comparison-depth controls this 197 | simplification. The default value should be fine. Second, there is the option to de-duplicate the elite 198 | and the population at every iteration. This is off by default, which I _think_ corresponds to the published 199 | algorithm, but can be controlled with the boolean :deduplicate option." 200 | [config] 201 | (let [{:keys [unary-ops binary-ops goals archive-size comparison-depth deduplicate] 202 | :or {comparison-depth 5 203 | deduplicate false}} config] 204 | {:elite-selector (fn [rabble elite] 205 | (make-new-archive goals deduplicate comparison-depth archive-size rabble elite)) 206 | :mating-pool-selector (fn [_ elite] elite) 207 | :reproduction-config {:selector (partial selection/tournament-selector 2 :spea2-fitness) 208 | :unary-ops unary-ops 209 | :binary-ops binary-ops}})) -------------------------------------------------------------------------------- /src/darwin/algorithms/sso.clj: -------------------------------------------------------------------------------- 1 | ; 2 | ; This file is part of darwin. 3 | ; 4 | ; Copyright (C) 2014-, Imperial College, London, All rights reserved. 5 | ; 6 | ; Contributors: Jony Hudson 7 | ; 8 | ; Released under the MIT license.. 9 | ; 10 | 11 | (ns darwin.algorithms.sso 12 | "Implements a simple, single-objective genetic algorithm." 13 | (:require [darwin.evolution.selection :as selection])) 14 | 15 | (defn sso-ea-config 16 | "Generate a default config for a simple, single-objective genetic algorithm." 17 | [config] 18 | (let [{:keys [unary-ops binary-ops tournament-size goal]} config] 19 | {:elite-selector (fn [_ _] []) 20 | :mating-pool-selector (fn [rabble _] rabble) 21 | :reproduction-config {:selector (partial selection/tournament-selector tournament-size goal) 22 | :unary-ops unary-ops 23 | :binary-ops binary-ops}})) -------------------------------------------------------------------------------- /src/darwin/core.clj: -------------------------------------------------------------------------------- 1 | ; 2 | ; This file is part of darwin. 3 | ; 4 | ; Copyright (C) 2014-, Imperial College, London, All rights reserved. 5 | ; 6 | ; Contributors: Jony Hudson 7 | ; 8 | ; Released under the MIT license.. 9 | ; 10 | 11 | (ns darwin.core 12 | (:require [darwin.algorithms.sso :as sso] 13 | [darwin.evolution.core :as evolution])) 14 | 15 | (defn evolve 16 | "A simple interface to get started. Runs an evolutionary optimisation of a single objective with a single mutation 17 | and single crossover function. The score function should take an individual and return a numeric score. Lower is taken 18 | to be better. The mutation function should return a single mutated individual. The crossover function should return a 19 | vector of two individuals. The function `random-individual` should return a single random individual and will be used 20 | to intialise the population. The evolution will be run for max-generations generations." 21 | [score crossover mutate generate-random-individual max-generations] 22 | (let [ea-config (sso/sso-ea-config {:unary-ops [{:op mutate :repeat 5} {:op identity :repeat 45}] 23 | :binary-ops [{:op crossover :repeat 25}] 24 | :tournament-size 4 25 | :goal :score}) 26 | config {:ea-config ea-config 27 | :score-functions {:score score} 28 | :reporting-function (fn [z] (when (= (mod (:age z) 10) 0) (print ".") (flush)))} 29 | initial-zg (evolution/make-zeitgeist (repeatedly 100 generate-random-individual))] 30 | (evolution/run-evolution config initial-zg (fn [zg gc] (>= (:age zg) max-generations))))) -------------------------------------------------------------------------------- /src/darwin/evolution/core.clj: -------------------------------------------------------------------------------- 1 | ; 2 | ; This file is part of darwin. 3 | ; 4 | ; Copyright (C) 2014-, Imperial College, London, All rights reserved. 5 | ; 6 | ; Contributors: Jony Hudson 7 | ; 8 | ; Released under the MIT license.. 9 | ; 10 | 11 | (ns darwin.evolution.core 12 | "The functions in this namespace provide generic plumbing for an adaptive generational evolutionary algorithm. 13 | Supported features include explicit mating pool generation, optional maintenance of an elite population, 14 | optional pre-processing/transformation of the population before scoring, and optional flexible adaptation during 15 | the run. Central to these functions are the zeitgeist and generation-config data structures. The zeitgeist contains 16 | all of the state of the evolutionary algorithm at one generation. The generation-config gives a complete specification 17 | of how to evolve from one generation to the next. Adpatation is introduced by allowing the generation-config to change 18 | during the run. 19 | 20 | This plumbing is general enough to run simple GA, or more complex multi-objective algorithms like NSGA-II 21 | or SPEA2, along with hybrid algorithms that combine these with hill-descent and other non EA 22 | transformations. This namespace doesn't, though, implement any of those algorithms itself. See other 23 | namespaces in the algorithms package for specific implementations." 24 | (:require [darwin.evolution.reproduction :as reproduction] 25 | [darwin.evolution.scoring :as scoring] 26 | [darwin.evolution.metrics :as metrics])) 27 | 28 | ;; An atom to store the lastest generation which is useful for debugging etc 29 | (def latest (atom {})) 30 | 31 | (defn evolve 32 | "Runs one generation of the evolutionary algorithm. Takes a zeitgeist and a generation-config 33 | and returns the new zeitgeist. 34 | 35 | This function just provides the plumbing and calls out to functions provided in the config to do the actual work. 36 | The algorithm proceeds in a number of steps: 37 | - determine the new elite by taking the current rabble and elite, and applying a function 38 | - decide who is eligible to participate in reproduction, by applying a function to the rabble and elite 39 | - generate a new rabble from the mating pool, using a given selection procedure and given genetic operations 40 | - run a list of transformations on the rabble 41 | - update the scores of the new rabble 42 | - update metrics 43 | - run a reporting function to provide the user with information about this generation 44 | - run a checkpoint function to optionally save the state of the algorithm." 45 | [zeitgeist generation-config] 46 | (let [{:keys [ea-config transformations score-functions reporting-function checkpoint-function]} generation-config 47 | {:keys [elite-selector mating-pool-selector reproduction-config]} ea-config 48 | ;; we time each generations execution (against the wall-clock) 49 | start-time (System/currentTimeMillis) 50 | ;; the EA proper 51 | rabble (:rabble zeitgeist) 52 | elite (or (:elite zeitgeist) []) 53 | new-elite (elite-selector rabble elite) 54 | elite-selected-time (System/currentTimeMillis) 55 | mating-pool (mating-pool-selector rabble new-elite) 56 | new-rabble (reproduction/reproduce reproduction-config mating-pool) 57 | transformed-rabble (if (nil? transformations) 58 | new-rabble 59 | ((apply comp transformations) new-rabble)) 60 | rabble-ready-time (System/currentTimeMillis) 61 | scored-transformed-rabble (scoring/update-scores transformed-rabble score-functions) 62 | scored-new-elite (scoring/update-scores new-elite score-functions) 63 | evolved-zg (assoc (assoc zeitgeist :rabble scored-transformed-rabble) :elite scored-new-elite) 64 | _ (reset! latest evolved-zg) 65 | end-time (System/currentTimeMillis) 66 | ;; track generation number 67 | final-zg (update-in evolved-zg [:age] (fn [x] (if (nil? x) 0 (inc x)))) 68 | ;; update the timing metrics 69 | _ (metrics/add! :time (- end-time start-time)) 70 | _ (metrics/add! :selection-time (- elite-selected-time start-time)) 71 | _ (metrics/add! :reproduction-time (- rabble-ready-time elite-selected-time)) 72 | _ (metrics/add! :scoring-time (- end-time rabble-ready-time)) 73 | ;; add stats of all the scores to the metrics 74 | _ (mapv #(metrics/add-stats! 75 | (first %) 76 | (mapv (first %) (into scored-transformed-rabble new-elite))) 77 | score-functions) 78 | ;; report and checkpoint 79 | _ (when reporting-function (reporting-function final-zg)) 80 | _ (when checkpoint-function (checkpoint-function final-zg))] 81 | final-zg)) 82 | 83 | (defn- no-adpatation 84 | "An adaptation function that does ... no adapation. Used as a default below." 85 | [zg gc] 86 | gc) 87 | 88 | (defn run-evolution 89 | "Runs the evolutionary algorithm until the stopping-function is satisfied. The stopping function is passed both 90 | the current zeitgeist and the current generation-config (so it can stop in response to adaptive behaviour). 91 | Returns the final zeitgeist. 92 | 93 | The algorithm can adapt to the state of the run through the adapt function, if provided this will be called 94 | after each generation, with the previous generation's generation-config, and the new zeitgeist. It must return 95 | the generation-config for the next generation. If no adapt-function is provided, then the same generation-config 96 | will be used for each generation. 97 | 98 | Each iteration round the loop looks something like this: 99 | 100 | zg new-zg 101 | -----> evolve -------+--------------------> 102 | ^ | 103 | g-c | v new-g-c 104 | ---------+----- adapt-function -----------> 105 | 106 | When viewed this way, it's natural to think of the generation-config as a kind of environment for the evolution. 107 | In an adaptive run, not only does the population change to fit the environment, the environment also changes, 108 | possibly in response to the population. 109 | 110 | Metrics are accumulated and stored in an atom. This allows one to monitor the run in realtime by watching 111 | the atom in another thread, if desired." 112 | ([initial-gc initial-zg stopping-function] 113 | (run-evolution initial-gc initial-zg stopping-function no-adpatation)) 114 | ([initial-gc initial-zg stopping-function adapt-function] 115 | ;; score the initial zeitgeist 116 | (let [scored-initial-zg (update-in initial-zg [:rabble] #(scoring/update-scores % (:score-functions initial-gc))) 117 | adapt (if adapt-function adapt-function (fn [_ gc] gc))] 118 | ;; reset metrics 119 | (metrics/clear!) 120 | ;; run the main loop 121 | (loop [zg scored-initial-zg 122 | gc initial-gc] 123 | (if (not (stopping-function zg gc)) 124 | ;; evolve a new generation and adapt 125 | (let [new-zg (evolve zg gc) 126 | new-gc (adapt new-zg gc)] 127 | (recur new-zg new-gc)) 128 | ;; stopping condition met, return the final zeitgiest 129 | zg))))) 130 | 131 | 132 | (defn make-zeitgeist 133 | "A helper function for making an initial zeitgeist from a list of genotypes." 134 | [genotypes-list] 135 | {:elite [] 136 | :rabble (map (fn [g] {:genotype g}) genotypes-list) 137 | :age 0}) -------------------------------------------------------------------------------- /src/darwin/evolution/metrics.clj: -------------------------------------------------------------------------------- 1 | ; 2 | ; This file is part of darwin. 3 | ; 4 | ; Copyright (C) 2014-, Imperial College, London, All rights reserved. 5 | ; 6 | ; Contributors: Jony Hudson 7 | ; 8 | ; Released under the MIT license.. 9 | ; 10 | 11 | (ns darwin.evolution.metrics 12 | "Functions for capturing metrics for the run.") 13 | 14 | (def metrics (atom {})) 15 | 16 | (defn clear! 17 | "Reset the metrics." 18 | [] 19 | (reset! metrics {})) 20 | 21 | (defn add! 22 | [key value] 23 | (swap! metrics #(update-in % [key] (fn [x] (apply vector (conj x value)))))) 24 | 25 | (defn- calculate-stats 26 | "Update a single population-level metric." 27 | [values] 28 | (let [mean-val (double (/ (apply + values) (count values))) 29 | min-val (apply min values) 30 | max-val (apply max values)] 31 | [mean-val min-val max-val])) 32 | 33 | (defn- update-stat 34 | [key stat value] 35 | (swap! metrics #(update-in % [key stat] (fn [x] (apply vector (conj x value)))))) 36 | 37 | (defn add-stats! 38 | "Adds a metric derived from the statistics of a given set of values. Adds the mean, min and max of 39 | the given values to the metric with the given name." 40 | [key values] 41 | (mapv #(update-stat key %1 %2) [:mean :min :max] (calculate-stats values))) 42 | -------------------------------------------------------------------------------- /src/darwin/evolution/pareto.clj: -------------------------------------------------------------------------------- 1 | ; 2 | ; This file is part of darwin. 3 | ; 4 | ; Copyright (C) 2014-, Imperial College, London, All rights reserved. 5 | ; 6 | ; Contributors: Jony Hudson 7 | ; 8 | ; Released under the MIT license.. 9 | ; 10 | 11 | (ns darwin.evolution.pareto 12 | "Functions for computing Pareto dominance, rank etc. Currently limited to two-objective 13 | comparison, but the API should be easy to extend to more.") 14 | 15 | (defn dominates 16 | "Does i1 Pareto-dominate i2, as judged by the values associated with the given keys, k1 and k2. 17 | Lower scores are considered better." 18 | [[k1 k2] i1 i2] 19 | (or (and (<= (k1 i1) (k1 i2)) (< (k2 i1) (k2 i2))) 20 | (and (<= (k2 i1) (k2 i2)) (< (k1 i1) (k1 i2))))) 21 | 22 | (defn dominated-set 23 | "Returns the individuals that i dominates wrt k1 and k2. Note that it doesn't return a set, rather a 24 | list (which I guess is a multiset) but `dominated-multiset` is too much of a mouthful." 25 | [[k1 k2] individuals i] 26 | (filter #(dominates [k1 k2] i %) individuals)) 27 | 28 | (defn dominator-set 29 | "Returns the individuals that dominate i wrt k1 and k2. As above, it doesn't return a set." 30 | [[k1 k2] individuals i] 31 | (filter #(dominates [k1 k2] % i) individuals)) 32 | 33 | (defn dominated-count 34 | "Count how many individuals i dominates wrt to k1 and k2." 35 | [[k1 k2] individuals i] 36 | (count (dominated-set [k1 k2] individuals i))) 37 | 38 | (defn- individual-dominated? 39 | "Is an individual i dominated by any of the given individuals wrt the keys k1 and k2?" 40 | [[k1 k2] individuals i] 41 | (reduce #(or %1 %2) (map #(dominates [k1 k2] % i) individuals))) 42 | 43 | (defn non-dominated-individuals 44 | "Returns the individuals that are non-dominated with respect to k1 and k2." 45 | [[k1 k2] individuals] 46 | (filter #(not (individual-dominated? [k1 k2] individuals %)) individuals)) -------------------------------------------------------------------------------- /src/darwin/evolution/reproduction.clj: -------------------------------------------------------------------------------- 1 | ; 2 | ; This file is part of darwin. 3 | ; 4 | ; Copyright (C) 2014-, Imperial College, London, All rights reserved. 5 | ; 6 | ; Contributors: Jony Hudson 7 | ; 8 | ; Released under the MIT license.. 9 | ; 10 | 11 | (ns darwin.evolution.reproduction 12 | "The purpose of a reproduction step is to take a mating pool - a set of individuals that have 13 | somehow been selected from the population - and generate a new generation of the population. 14 | In the simplest case the mating pool is just the previous population, but in more complex 15 | algorithms it may also be made up from members of an archive etc. 16 | 17 | This implementation tracks the age of each individual. Individuals are represented by maps, 18 | which must have a :genotype key that contains the genetic material. The age will be tracked 19 | as an :age key on this map. It is permissible to store any other information you like on the 20 | individual maps, such as score information etc, but this will be destroyed in the reproduction 21 | step.") 22 | 23 | (defn- unary-genotype-op-with-age-tracking 24 | "Applies an operation to the genotype of an individual, generating a new individual. The 25 | :age key of the individual is carried through and incremented." 26 | [op individual] 27 | (let [new-genotype (op (:genotype individual)) 28 | new-age (inc (or (:age individual) 0))] 29 | {:genotype new-genotype :age new-age})) 30 | 31 | (defn- binary-genotype-op-with-age-tracking 32 | "Applies an operation to the genotypes of two individuals, generating a pair of new individuals. The 33 | :age key of the new individual is the age of the eldest parent plus one." 34 | [op i1 i2] 35 | (let [new-genotypes (op (:genotype i1) (:genotype i2)) 36 | new-age (inc (max (or (:age i1) 0) (or (:age i2) 0)))] 37 | [{:genotype (first new-genotypes) :age new-age} 38 | {:genotype (second new-genotypes) :age new-age}])) 39 | 40 | (defn- apply-unary-operation 41 | "Takes a unary operation, the operation the requested number of times. Gathers all of the generated children 42 | into a list which it returns." 43 | [op reps pool selector] 44 | (repeatedly reps #(unary-genotype-op-with-age-tracking op (selector pool)))) 45 | 46 | (defn- apply-binary-operation 47 | "Takes a unary operation, the operation the requested number of times. Gathers all of the generated children 48 | into a list which it returns." 49 | [op reps pool selector] 50 | (reduce into [] 51 | (repeatedly reps #(binary-genotype-op-with-age-tracking op (selector pool) (selector pool))))) 52 | 53 | (defn reproduce 54 | "Generates a population from a mating pool. The config contains a selector function which will be used 55 | to pull individuals from the pool. The list of operations that will be applied are also in the config, 56 | in the keys :unary-ops for ops that act on one individual and :binary-ops that act on two individuals. 57 | Each operation is specified as a function :op, a :count of how many times to apply this operation. Unary 58 | operations are expected to return one individual, and binary operations a sequence of two individuals. 59 | It is up to the user to make sure that the total number of individuals returned gives the correct 60 | population size. 61 | 62 | The operations should be functions that operate directly on genetic material: this function will take 63 | care of extracting the genetic material from individuals and rebuilding new individuals after reproduction. 64 | During this process it will keep track of the age of each individual." 65 | [config pool] 66 | (let [{:keys [selector unary-ops binary-ops]} config 67 | unary-results (map #(apply-unary-operation (:op %) (:repeat %) pool selector) unary-ops) 68 | binary-results (map #(apply-binary-operation (:op %) (:repeat %) pool selector) binary-ops)] 69 | (doall (reduce into 70 | [(reduce into [] unary-results) 71 | (reduce into [] binary-results)])))) -------------------------------------------------------------------------------- /src/darwin/evolution/scoring.clj: -------------------------------------------------------------------------------- 1 | ; 2 | ; This file is part of darwin. 3 | ; 4 | ; Copyright (C) 2014-, Imperial College, London, All rights reserved. 5 | ; 6 | ; Contributors: Jony Hudson 7 | ; 8 | ; Released under the MIT license.. 9 | ; 10 | 11 | (ns darwin.evolution.scoring 12 | "Functions in this namespace manage the process of scoring individuals in a population. 13 | The actual score functions themselves are representation dependent and will be found with 14 | the implementations of the representations.") 15 | 16 | (defn update-individual-scores 17 | "Update the scores for an individual. The score functions are given as a map of functions: 18 | each function will be applied to the individual's genotype and its result stored on the individual, 19 | under the function's key." 20 | [score-funcs individual] 21 | (merge individual 22 | (into {} (map (fn [s] [(first s) ((second s) (:genotype individual))]) score-funcs)))) 23 | 24 | (defn update-scores 25 | "Update the scores for each individual in the given list. See above for how the score functions are 26 | specified." 27 | [individuals score-funcs] 28 | (doall (pmap (partial update-individual-scores score-funcs) individuals))) -------------------------------------------------------------------------------- /src/darwin/evolution/selection.clj: -------------------------------------------------------------------------------- 1 | ; 2 | ; This file is part of darwin. 3 | ; 4 | ; Copyright (C) 2014-, Imperial College, London, All rights reserved. 5 | ; 6 | ; Contributors: Jony Hudson 7 | ; 8 | ; Released under the MIT license.. 9 | ; 10 | 11 | (ns darwin.evolution.selection 12 | "The purpose of selection is to pick an individual from a set. The selector will usually not 13 | pick uniformly, so as to exert some evolutionary pressure. This namespace has some general 14 | purpose selection algorithms." 15 | (:refer-clojure :exclude [rand rand-nth rand-int]) 16 | (:use [darwin.utility.random])) 17 | 18 | (defn tournament-selector 19 | "A simple tournament selector. Selects from the given population with given tournament-size 20 | using the score-key to extract the score from the individual. Scores are always minimized." 21 | [tournament-size score-key population] 22 | (let [competitors (repeatedly tournament-size #(rand-nth population))] 23 | (apply min-key score-key competitors))) -------------------------------------------------------------------------------- /src/darwin/evolution/transform.clj: -------------------------------------------------------------------------------- 1 | ; 2 | ; This file is part of darwin. 3 | ; 4 | ; Copyright (C) 2014-, Imperial College, London, All rights reserved. 5 | ; 6 | ; Contributors: Jony Hudson 7 | ; 8 | ; Released under the MIT license.. 9 | ; 10 | 11 | (ns darwin.evolution.transform 12 | "Functions for transforming individuals, and the population. These can be supplied to the EA 13 | to perform non-EA transformations before scoring (see `darwin.evolution.core` for details. 14 | This namespace contains general helper functions for constructing transformations, and generic 15 | transformations that are representation independent. A given representation might implement more 16 | specific transformations (think simplifying symbolic regression expressions, for instance)." 17 | (:refer-clojure :exclude [rand rand-nth rand-int]) 18 | (:use [darwin.utility.random])) 19 | 20 | 21 | ;; * Helpers * 22 | 23 | (defn apply-to-genotype 24 | [func individual] 25 | (assoc individual :genotype (func (:genotype individual)))) 26 | 27 | (defn apply-to-fraction-of-genotypes 28 | "Apply a transformation to a randomly selected fraction of the population. The transformation will 29 | be applied to the genotype of the individual. The rest of the information in the individual will be 30 | preserved." 31 | [transform fraction population] 32 | (map 33 | #(if (< (rand) fraction) ((partial apply-to-genotype transform) %) %) 34 | population)) 35 | 36 | (defn apply-to-all-genotypes 37 | "Apply a transformation to all of the population. The transformation will be applied to the genotype of 38 | the individual. The rest of the information in the individual will be preserved." 39 | [transform population] 40 | (map (partial apply-to-genotype transform) population)) 41 | 42 | 43 | ;; * Generic transformations * 44 | 45 | (defn hill-descent 46 | "Takes a genotype and applies the given tweak function, returns the new individual if it 47 | scores better on the score-function, otherwise returns the individual. The tweak function and 48 | the score function should operate on the genotype of the individual." 49 | [tweak-function score-function genotype] 50 | (let [tweaked (tweak-function genotype) 51 | score (score-function genotype) 52 | tweaked-score (score-function tweaked)] 53 | (if (< tweaked-score score) 54 | tweaked 55 | genotype))) 56 | 57 | -------------------------------------------------------------------------------- /src/darwin/utility/random.clj: -------------------------------------------------------------------------------- 1 | ; 2 | ; This file is part of darwin. 3 | ; 4 | ; Copyright (C) 2014-, Imperial College, London, All rights reserved. 5 | ; 6 | ; Contributors: Jony Hudson 7 | ; 8 | ; Released under the MIT license.. 9 | ; 10 | 11 | (ns darwin.utility.random 12 | "Random number generators and associated functions. These mirror the functions in clojure.core, but 13 | use java's ThreadLocalRandom which works well with multi-threading." 14 | (:refer-clojure :exclude [rand rand-int rand-nth]) 15 | (:import java.util.concurrent.ThreadLocalRandom)) 16 | 17 | (defn- nextDouble 18 | [] 19 | (.nextDouble (ThreadLocalRandom/current))) 20 | 21 | (defn rand 22 | ([] (nextDouble)) 23 | ([n] (* n (rand)))) 24 | 25 | (defn rand-int 26 | [n] 27 | (int (rand n))) 28 | 29 | (defn rand-nth 30 | [l] 31 | (nth l (rand-int (count l)))) --------------------------------------------------------------------------------