001 (ns nature.genetic-operators
002 "Functions to transform individuals and create"
003 (:require [nature.population-presets :as pp]
004 [nature.initialization-operators :as io]))
005
006 (defn fitness-based-scanning-allele
007 "Pick one of two alleles"
008 [allele-1 allele-2 percent]
009 (if (<= percent (rand-int 100))
010 allele-1
011 allele-2))
012
013 (defn fitness-based-scanning-genome
014 [sequence-1 sequence-2 percent]
015 (loop [new-genome []
016 gs-1 sequence-1
017 gs-2 sequence-2]
018 (if (empty? gs-1)
019 new-genome
020 (recur (conj new-genome (fitness-based-scanning-allele (first gs-1) (first gs-2) percent))
021 (rest gs-1)
022 (rest gs-2)))))
023
024 (defn fitness-based-scanning*
025 "Construct a new inidiviidual, where each allele is picked from a parent base on the ratio of their fitnesses"
026 [fitness-function selected-individuals]
027 (let [individual-1 (first selected-individuals)
028 individual-2 (second selected-individuals)
029 fitness-total (+ (:fitness-score individual-1) (:fitness-score individual-2))
030 percent (* 100 (/ (:fitness-score individual-1) fitness-total))]
031 (io/build-individual
032 (fitness-based-scanning-genome (:genetic-sequence individual-1)
033 (:genetic-sequence individual-2)
034 percent)
035 (vector (:guid individual-1) (:guid individual-2))
036 pp/default-age
037 fitness-function)))
038
039 (defn fitness-based-scanning
040 "A curried form of `fitness-based-scanning*` to more easily pass around"
041 [fitness-function]
042 (partial fitness-based-scanning* fitness-function))
043
044 (defn crossover*
045 "Construct two new individuals by splitting the genetic sequences of two parents and crossing them over wiith each other"
046 [fitness-function selected-individuals]
047 (let [individual-1 (first selected-individuals)
048 individual-2 (second selected-individuals)
049 crossover-point (/ (count (:genetic-sequence individual-1)) 2)
050 split-1 (split-at crossover-point (:genetic-sequence individual-1))
051 split-2 (split-at crossover-point (:genetic-sequence individual-2))]
052 (io/build-individual (concat (first split-1) (last split-2))
053 (vector (:guid individual-1) (:guid individual-2))
054 pp/default-age
055 fitness-function)))
056
057 (defn crossover
058 "A curried form of `crossover*` to more easily pass around"
059 [fitness-function]
060 (partial crossover* fitness-function))
061
062 (defn no-op
063 "A proxy for `identity` to signal when a particular operation category is not needed,
064 but the `selected-individuals` are kept in the pool"
065 [fitness-function selected-individuals]
066 (map #(update % :age inc) selected-individuals))
067
068 (defn mutation-operator
069 "Construct a new individual, by flipping alleles in the genetiic sequence to a random legal allele"
070 [fitness-function allele-set percent individual]
071 (io/build-individual
072 (fitness-based-scanning-genome (:genetic-sequence individual)
073 (io/generate-sequence allele-set (count (:genetic-sequence individual)))
074 percent)
075 (:parents individual)
076 (:age individual)
077 fitness-function))