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))