Mercurial > cortex
diff org/worm_learn.clj @ 418:027707c75f39
saving progress for the night.
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Thu, 20 Mar 2014 00:24:46 -0400 |
parents | f689967c2545 |
children | dd40244255d4 |
line wrap: on
line diff
1.1 --- a/org/worm_learn.clj Wed Mar 19 22:47:13 2014 -0400 1.2 +++ b/org/worm_learn.clj Thu Mar 20 00:24:46 2014 -0400 1.3 @@ -222,6 +222,43 @@ 1.4 (and (< 0.55 (contact worm-segment-bottom-tip tail-touch)) 1.5 (< 0.55 (contact worm-segment-top-tip head-touch)))))) 1.6 1.7 + 1.8 +(declare phi-space phi-scan) 1.9 + 1.10 +(defn next-phi-states 1.11 + "Given proprioception data, determine the most likely next sensory 1.12 + pattern from previous experience." 1.13 + [proprio phi-space phi-scan] 1.14 + (if-let [results (phi-scan proprio)] 1.15 + (mapv phi-space 1.16 + (filter (partial > (count phi-space)) 1.17 + (map inc results))))) 1.18 + 1.19 +(defn debug-experience 1.20 + [experiences] 1.21 + (cond 1.22 + (grand-circle? experiences) (println "Grand Circle") 1.23 + (curled? experiences) (println "Curled") 1.24 + (wiggling? experiences) (println "Wiggling") 1.25 + (resting? experiences) (println "Resting"))) 1.26 + 1.27 + 1.28 +(defn debug-experience 1.29 + [experiences] 1.30 + ;; (println-repl 1.31 + ;; (count (next-phi-states (:proprioception (peek experiences)) 1.32 + ;; phi-space phi-scan))) 1.33 + (cond 1.34 + (grand-circle? experiences) (println "Grand Circle") 1.35 + (curled? experiences) (println "Curled") 1.36 + (wiggling? experiences) (println "Wiggling") 1.37 + (resting? experiences) (println "Resting")) 1.38 + ) 1.39 + 1.40 + 1.41 + 1.42 + 1.43 + 1.44 (def standard-world-view 1.45 [(Vector3f. 4.207176, -3.7366982, 3.0816958) 1.46 (Quaternion. 0.11118768, 0.87678415, 0.24434438, -0.3989771)]) 1.47 @@ -240,7 +277,8 @@ 1.48 :motor-control (:motor-control direct-control) 1.49 :keybindings (:keybindings direct-control) 1.50 :record nil 1.51 - :experiences nil 1.52 + :experiences (atom []) 1.53 + :experience-watch debug-experience 1.54 :worm-model worm-model 1.55 :end-frame nil})) 1.56 1.57 @@ -252,15 +290,11 @@ 1.58 (defn record-experience! [experiences data] 1.59 (swap! experiences #(conj % data))) 1.60 1.61 - 1.62 - 1.63 -(declare phi-space phi-scan) 1.64 - 1.65 (defn worm-world 1.66 [& {:keys [record motor-control keybindings view experiences 1.67 - worm-model end-frame] :as settings}] 1.68 + worm-model end-frame experience-watch] :as settings}] 1.69 (let [{:keys [record motor-control keybindings view experiences 1.70 - worm-model end-frame]} 1.71 + worm-model end-frame experience-watch]} 1.72 (merge (worm-world-defaults) settings) 1.73 worm (doto (worm-model) (body!)) 1.74 touch (touch! worm) 1.75 @@ -298,13 +332,9 @@ 1.76 (record-experience! 1.77 experiences {:touch touch-data 1.78 :proprioception proprioception-data 1.79 - :muscle muscle-data}) 1.80 - (cond 1.81 - (grand-circle? @experiences) (println "Grand Circle") 1.82 - (curled? @experiences) (println "Curled") 1.83 - (wiggling? @experiences) (println "Wiggling") 1.84 - (resting? @experiences) (println "Resting")) 1.85 - ) 1.86 + :muscle muscle-data})) 1.87 + (when experience-watch 1.88 + (experience-watch @experiences)) 1.89 (muscle-display 1.90 muscle-data 1.91 (if record (dir! (File. record "muscle")))) 1.92 @@ -333,7 +363,6 @@ 1.93 (motor-control-program worm-muscle-labels do-all-the-things) 1.94 :experiences experiences}))) 1.95 @experiences)) 1.96 - 1.97 1.98 (defn bin [digits] 1.99 (fn [angles] 1.100 @@ -343,7 +372,9 @@ 1.101 (flatten) 1.102 (mapv #(Math/round (* % (Math/pow 10 (dec digits)))))))) 1.103 1.104 -;; k-nearest neighbors with spatial binning. 1.105 +;; k-nearest neighbors with spatial binning. Only returns a result if 1.106 +;; the propriceptive data is within 10% of a previously recorded 1.107 +;; result in all dimensions. 1.108 (defn gen-phi-scan [phi-space] 1.109 (let [bin-keys (map bin [3 2 1]) 1.110 bin-maps 1.111 @@ -357,19 +388,8 @@ 1.112 (fn lookup [proprio-data] 1.113 (some #(% proprio-data) lookups)))) 1.114 1.115 -;; (defn gen-phi-scan [phi-space] 1.116 -;; (let [bin-keys (map bin [3 2 1]) 1.117 -;; bin-maps 1.118 -;; (map (fn [bin-key phi-space] 1.119 -;; (group-by (comp bin-key :proprioception) phi-space)) 1.120 -;; bin-keys (repeat phi-space)) 1.121 -;; lookups (map (fn [bin-key bin-map] 1.122 -;; (fn [proprio] (bin-map (bin-key proprio)))) 1.123 -;; bin-keys bin-maps)] 1.124 -;; (fn lookup [proprio-data] 1.125 -;; (some #(% proprio-data) lookups)))) 1.126 - 1.127 (defn init [] 1.128 (def phi-space (generate-phi-space)) 1.129 (def phi-scan (gen-phi-scan phi-space)) 1.130 ) 1.131 +