Permalink
Browse files

better selection

  • Loading branch information...
1 parent 6259370 commit e355140271e1dc75adad77031509e870c1a0a14e @danielstockton committed Dec 3, 2011
Showing with 30 additions and 19 deletions.
  1. 0 .gitignore
  2. 0 README.md
  3. 0 project.clj
  4. +21 −17 src/evolve/core.clj
  5. +9 −2 test/evolve/test/core.clj
View
0 .gitignore 100644 → 100755
No changes.
View
0 README.md 100644 → 100755
No changes.
View
0 project.clj 100644 → 100755
No changes.
View
38 src/evolve/core.clj 100644 → 100755
@@ -22,50 +22,54 @@
[target]
(fn [source]
(apply +
- (map
- (fn [x y] (* (- x y) (- x y)))
- (contstr/codepoints source)
- (contstr/codepoints target)))))
+ (map
+ (fn [x y] (* (- x y) (- x y)))
+ (contstr/codepoints source)
+ (contstr/codepoints target)))))
(defn popfitness
"maps a fitness to each member of the population"
[population fitness]
- (into {} (map #(vector % (fitness %)) population)))
+ (into [] (map #(vector % (fitness %)) population)))
-
-;;; currently selects unfit parents
(defn selection
"selects two parents with a higher probability of selecting fit parents"
[popfitness]
- (let [total (apply + (vals popfitness))]
- (take 2
- (shuffle
- (for [[k v] popfitness itm (repeat (* 1000000 (/ 1 (inc v))) k)] itm)))))
+ (first
+ (last
+ (remove
+ #(< (rand) (second %))
+ (let
+ [fits (map #(/ 1 (+ 0.0000001 (second %))) popfitness)
+ tot-fit (reduce + fits)
+ cum-fits (reductions + 0 fits)
+ roulette (for [k (range (count popfitness))] [(first (nth popfitness k)) (float (/ (nth cum-fits k) tot-fit))])]
+ roulette)))))
(defn mutate [source]
(let [i (rand-int (count source))]
(str
(subs source 0 i) (char (+ (rand-nth [-1 1]) (first (contstr/codepoints (str (nth source i)))))) (subs source (inc i)))))
(defn breed
- "breeds two parents together to create two offspring"
+ "breeds two parents together to create one offspring"
[parent1 parent2]
(let [l1 (count parent1) l2 (count parent2)]
(mutate
(apply str
- (concat
- (subs parent1 0 (/ l1 2))
- (subs parent2 (/ l2 2) l2))))))
+ (concat
+ (subs parent1 0 (/ l1 2))
+ (subs parent2 (/ l2 2) l2))))))
(defn evolve
[population target]
- (repeatedly (count population) #(breed (first (selection (popfitness population (fitness-fn target)))) (last (selection (popfitness population (fitness-fn target)))))))
+ (repeatedly (count population) #(breed (selection (popfitness population (fitness-fn target))) (selection (popfitness population (fitness-fn target))))))
(defn start
[generations popsize target]
(let [populate (population popsize (count target))]
- (nth (iterate #(evolve % target) populate) generations)))
+ (println (nth (iterate #(evolve % target) populate) generations))))
(defn -main [generations popsize target]
(start (new Integer generations) (new Integer popsize) target))
View
11 test/evolve/test/core.clj 100644 → 100755
@@ -2,5 +2,12 @@
(:use [evolve.core])
(:use [clojure.test]))
-(deftest fitness
- (is ((fitness-fn "jimmy") "james") 164))
+(deftest fitness-test
+ (is
+ (= ((fitness-fn "jimmy") "james") 164)
+ "Fitness is calculated incorrectly"))
+
+(deftest failure-test
+ (is
+ (= 2 3)
+ "Definite Failure"))

0 comments on commit e355140

Please sign in to comment.