Merge pull request #42 from ryanboldi/simplification

Autosimplification and Tests

src/propeller/gp.cljc

@@ -2,6 +2,7 @@
   (:require [clojure.string]
             [clojure.pprint]
             [propeller.genome :as genome]
+            [propeller.simplification :as simplification]
             [propeller.variation :as variation]
             [propeller.push.instructions.bool]
             [propeller.push.instructions.character]
@@ -58,7 +59,10 @@
         (<= (:total-error best-individual) solution-error-threshold)
         (do (prn {:success-generation generation})
             (prn {:total-test-error
-                  (:total-error (error-function argmap (:testing-data argmap) best-individual))}))
+                  (:total-error (error-function argmap (:testing-data argmap) best-individual))})
+            (if (:simplification? argmap)
+              (let [simplified-plushy (simplification/auto-simplify-plushy argmap (:plushy best-individual) (:simplification-steps argmap) error-function (:training-data argmap) (:simplification-k argmap) (:simplification-k-prob argmap) (:simplification-verbose? argmap))]
+                (prn {:total-test-error-simplified (:total-error (error-function argmap (:testing-data argmap) (hash-map :plushy simplified-plushy)))}))))
         ;;
         (>= generation max-generations)
         nil

src/propeller/simplification.cljc

@@ -0,0 +1,34 @@
+(ns propeller.simplification
+  (:require [propeller.genome :as genome]
+             [propeller.push.interpreter :as interpreter]
+            [propeller.push.state :as state]
+            [propeller.tools.math :as math]
+            ))
+
+(defn choose-random-k
+  [k indices]
+  (take k (shuffle indices)))
+
+(defn delete-at-indices
+  "deletes the values at given set of indices"
+  [indices plushy]
+  (let [sorted-indices (sort > indices)]
+    (keep-indexed #(if (not (some #{%1} sorted-indices)) %2) plushy)))
+
+(defn delete-k-random
+  [k plushy]
+  (delete-at-indices (choose-random-k k (range (count plushy))) plushy))
+
+(defn auto-simplify-plushy
+  "naive auto-simplification"
+  [argmap plushy steps error-function training-data k verbose?]
+  (if verbose? (prn {:start-plushy-length (count plushy) :k k}))
+  (let [initial-errors (:errors (error-function argmap training-data {:plushy plushy}))]
+    (loop [step 0 curr-plushy plushy]
+      (if (< steps step)
+        (do (if verbose? (prn {:final-plushy-length (count curr-plushy) :final-plushy curr-plushy})) curr-plushy)
+        (let [new-plushy (delete-k-random (rand-int k) curr-plushy)
+              new-plushy-errors (:errors (error-function argmap training-data {:plushy new-plushy}))
+              new-equal? (= new-plushy-errors initial-errors)]
+          (recur (inc step)
+                 (if new-equal? new-plushy curr-plushy)))))))

test/propeller/utils_test.cljc

@@ -1,6 +1,8 @@
 (ns propeller.utils-test
   (:require [clojure.test :as t]
-            [propeller.utils :as u]))
+            [propeller.utils :as u]
+            [propeller.simplification :as s]))
+
 (t/deftest first-non-nil-test
   (t/is (= 1 (u/first-non-nil '(1 2 3))))
   (t/is (= nil (u/first-non-nil [])))
@@ -26,15 +28,51 @@
               true
               (= 2 test))))))
 
-
 (t/deftest count-points-test
   (t/is (= 6 (u/count-points '(:a :b (:c :d)))))
   (t/is (= 1 (u/count-points '())))
   (t/is (= 2 (u/count-points '(:a)))))
 
-;(t/deftest seq-zip-test
-;  (t/is ))
+(t/testing "choose-random-k"
+  (t/testing "should return indices that are a member of the original array"
+    (t/is (every? identity (map #(contains? (set (range 10)) %) (s/choose-random-k 3 (range 10))))))
+  (t/testing "should return a list of size k"
+    (t/is (= (count (s/choose-random-k 7 (range 10))) 7))))
 
-;(t/deftest depth-test
-;  (t/is (= 3 (u/depth ()))))
+(t/testing "delete-at-indices"
+  (t/testing "should actually remove indicated items"
+    (t/is (= '(:hi1 :hi2) (s/delete-at-indices '(0 3) '(:hi0 :hi1 :hi2 :hi3)))))
+  (t/testing "should work with numerical indices"
+    (t/is (= '(:hi1 :hi2 :hi3) (s/delete-at-indices '(0) '(:hi0 :hi1 :hi2 :hi3)))))
+  (t/testing "should not delete anything for index out of bounds"
+    (t/is (= '(:hi1 :hi2 :hi3) (s/delete-at-indices '(0 10) '(:hi0 :hi1 :hi2 :hi3))))
+    (t/is (= '(:hi1 :hi2 :hi3) (s/delete-at-indices '(0 -10) '(:hi0 :hi1 :hi2 :hi3))))
+    (t/is (= '(:hi1 :hi2 :hi3) (s/delete-at-indices '(-0 -10) '(:hi0 :hi1 :hi2 :hi3)))))
+  (t/testing "should only delete at single index once"
+    (t/is (= '(:hi1 :hi2) (s/delete-at-indices '(0 0 0 0 3 3 3) '(:hi0 :hi1 :hi2 :hi3)))))
+  (t/testing "should return empty list when deleting from empty list"
+    (t/is (= '() (s/delete-at-indices '(0) '()))))
+  (t/testing "should be able to delete at arbitrary indices"
+    (t/is (= (count (s/delete-at-indices (s/choose-random-k 3 (range 10)) (range 10))) 7))))
 
+(t/testing "delete-random-k"
+  (t/testing "should remove the correct amount of items"
+    (t/is (= (count (s/delete-k-random 3 (range 10))) 7))
+    (t/is (= (count (s/delete-k-random 10 (range 10))) 0))
+    (t/is (= (count (s/delete-k-random 0 (range 10))) 10)))
+  (t/testing "should not fail if k >> size of collection"
+    (t/is (= (count (s/delete-k-random 300 (range 10))) 0))
+    (t/is (= (s/delete-k-random 300 '(:hi1 :hi2 :hi3)) '())))
+  (t/testing "should not fail if the collection is empty"
+    (t/is (= (count (s/delete-k-random 300 '())) 0))
+    (t/is (= (count (s/delete-k-random 0 '())) 0)))
+  (t/testing "should maintain order of the remaining items"
+    (t/is (apply < (s/delete-k-random 3 (range 10))))))
+
+(t/testing "auto-simplify-plushy"
+  (t/testing "should handle having an empty plushy"
+    (t/is (= (s/auto-simplify-plushy {} '() 100 (fn [argmap data plushy] 0) {} 3 false) '())))
+  (let [plushy '(:exec_dup 1 :integer_add close :in1 :integer_add 0 :in1 :in1 :integer_mult :integer_add)]
+        (t/testing "should decrease size of plushy that always has perfect scores"
+              (t/is (< (count (s/auto-simplify-plushy {} plushy 5 (fn [argmap data plushy] 0) {} 3 false)) (count plushy)))
+              (t/is (< (count (s/auto-simplify-plushy {} plushy 1 (fn [argmap data plushy] 0) {} 10 false)) (count plushy))))))