Permalink
Browse files

main.clj

* Apache License
* mate: renamed arg members in population
* fit?: check only first population, cause population is ranked
* refactored gen-member: moved to test.clj

test.clj
* Apache License
* added gen-member code
  • Loading branch information...
1 parent 634e383 commit 451d949f675182624bbc60d714a1bcd4862182c0 Lars Gregori committed Nov 5, 2009
Showing with 54 additions and 23 deletions.
  1. +34 −19 src/ga/main.clj
  2. +20 −4 src/test/test.clj
View
53 src/ga/main.clj
@@ -1,3 +1,17 @@
+; Copyright 2009 yogthos; Lars Gregori
+;
+; Licensed under the Apache License, Version 2.0 (the "License"); you may
+; not use this file except in compliance with the License. You may obtain
+; a copy of the License at
+;
+; http://www.apache.org/licenses/LICENSE-2.0
+;
+; Unless required by applicable law or agreed to in writing, software
+; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+; License for the specific language governing permissions and limitations
+; under the License.
+
(ns ga.main (:gen-class ))
(defstruct mutator-struct :func :args)
@@ -18,32 +32,36 @@
(int (+ (* (Math/random) (inc (- max min))) min)))
;functions for evolving members
+(defn- gen-member [mutator]
+ (struct member nil ((:func mutator) (:args mutator))))
+
(defn- mutate
"randomly mutates values in members of the population using the mutator function"
[population mutator threshold]
(doseq [member population]
- (let [old-val (:value @member)
- new-val (map #(if (< (rand) threshold) ((:func mutator) (:args mutator)) %1) old-val)]
- (swap! member #(assoc %1 :value new-val)))))
+ (let [old-member (:value @member)
+ gen-member (gen-member mutator)
+ new-member (map #(if (< (rand) threshold) (first %1) (second %1)) (zip (:value gen-member) old-member))]
+ (swap! member #(assoc %1 :value new-member)))))
(defn- rank
"ranks the members of the population using the val-comp function and the target value"
- [population val-comp target]
+ [population val-comp]
(doseq [member population]
- (swap! member #(assoc %1 :fitness (val-comp (:value %1) target))))
+ (swap! member #(assoc %1 :fitness (val-comp (:value %1)))))
(reverse (sort #(compare (:fitness @%1) (:fitness @%2)) population)))
(defn- fit?
- "checks if population has any members which match the desired value"
+ "checks if population (ranked by fitness) has a member which match the desired value"
[population]
- (not (empty? (filter #(== (:fitness @%1) 0) population))))
+ (== 0 (:fitness @(first population))))
(defn- mate
"cross-breeds existing members to produce offspring
values are generated by randomly combining first and second
halves of members of the population."
- [members]
- (let [halves (split-at (/ (count members) 2) members)]
+ [population]
+ (let [halves (split-at (/ (count population) 2) population)]
(loop [new-members (transient []) m1 (first halves) m2 (second halves)]
(if (or (empty? m1) (empty? m2))
(persistent! new-members)
@@ -59,7 +77,7 @@
"mutates the populationtakes then combines the top members
of the population with some of the bottom members to promote
genetic diversity, and adds some offspring"
- [population mutator threshold target]
+ [population mutator threshold]
(mutate population mutator threshold)
(let [promote-size (/ (count population) 5)
keep-size (- (/ (count population) 2) promote-size)
@@ -68,20 +86,17 @@
(take promote-size (second parts))
(mate population))))
-(defn- gen-member [mutator target]
- (struct member nil (for [i (range 0 (count target))] ((:func mutator) (:args mutator)))))
-
(defn- init-population
"creates a population using the generator function"
- [size mutator target]
- (for [i (range 0 size)] (atom (gen-member mutator target))))
+ [size mutator]
+ (for [i (range 0 size)] (atom (gen-member mutator))))
(defn evolve
"generates the initial population and ranks it, then runs the evolve-step until
the solution is found"
- [size threshold target mutator comp]
- (loop [population (init-population size mutator target)]
- (let [ranked (rank population comp target)]
+ [size threshold mutator comp]
+ (loop [population (init-population size mutator)]
+ (let [ranked (rank population comp)]
(if (fit? ranked)
ranked
- (recur (evolve-step ranked mutator threshold target))))))
+ (recur (evolve-step ranked mutator threshold))))))
View
24 src/test/test.clj
@@ -1,18 +1,34 @@
+; Copyright 2009 yogthos; Lars Gregori
+;
+; Licensed under the Apache License, Version 2.0 (the "License"); you may
+; not use this file except in compliance with the License. You may obtain
+; a copy of the License at
+;
+; http://www.apache.org/licenses/LICENSE-2.0
+;
+; Unless required by applicable law or agreed to in writing, software
+; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+; License for the specific language governing permissions and limitations
+; under the License.
+
(ns test.test
(:require (ga [main :as ga]))
(:gen-class ))
;example usage
(defn -main [args]
(let [target (vec "Hello World!")
- mutator (struct ga/mutator-struct (fn[_] (char (ga/rand-in-range 32 126))) {})]
+ mutator (struct ga/mutator-struct (fn[_] (for [i (range 0 (count target))] (char (ga/rand-in-range 32 126)))) {})]
+
(defn get-fitness
"custom comparator function for evaluating fitness of members"
- [value target]
+ [value]
+ (if (not (nil? args)) (println value))
(reduce - 0 (map #(if (= (first %1) (second %1)) 0 1)
(ga/zip value target))))
;run the evolution function and print the result
- (time (println (apply str (:value @(first (ga/evolve 500 0.01 target mutator get-fitness))))))))
+ (time (println (apply str (:value @(first (ga/evolve 500 0.01 mutator get-fitness))))))))
-(-main nil)
+(-main nil)

0 comments on commit 451d949

Please sign in to comment.