Mercurial > cortex
diff org/worm_learn.clj @ 451:0a4362d1f138
finishing up chapter 3.
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Wed, 26 Mar 2014 20:38:17 -0400 |
parents | 09b7c8dd4365 |
children | ced955c3c84f |
line wrap: on
line diff
1.1 --- a/org/worm_learn.clj Wed Mar 26 03:18:57 2014 -0400 1.2 +++ b/org/worm_learn.clj Wed Mar 26 20:38:17 2014 -0400 1.3 @@ -34,6 +34,14 @@ 1.4 :proprioception (proprioception! model) 1.5 :muscles (movement! model)})) 1.6 1.7 +(defn worm* [] 1.8 + (let [model (load-blender-model "Models/worm/worm-of-the-imagination.blend")] 1.9 + {:body (doto model (body!)) 1.10 + :touch (touch! model) 1.11 + :proprioception (proprioception! model) 1.12 + :muscles (movement! model)})) 1.13 + 1.14 + 1.15 (def output-base (File. "/home/r/proj/cortex/render/worm-learn/curl")) 1.16 1.17 1.18 @@ -198,19 +206,22 @@ 1.19 (defn wiggling? 1.20 "Is the worm wiggling?" 1.21 [experiences] 1.22 - (let [analysis-interval 0x40] 1.23 + (let [analysis-interval 96] 1.24 (when (> (count experiences) analysis-interval) 1.25 (let [a-flex 3 1.26 a-ex 2 1.27 muscle-activity 1.28 (map :muscle (vector:last-n experiences analysis-interval)) 1.29 base-activity 1.30 - (map #(- (% a-flex) (% a-ex)) muscle-activity)] 1.31 - (= 2 1.32 - (first 1.33 - (max-indexed 1.34 - (map #(Math/abs %) 1.35 - (take 20 (fft base-activity)))))))))) 1.36 + (map #(- (% a-flex) (% a-ex)) muscle-activity) 1.37 + accept? 1.38 + (fn [activity] 1.39 + (->> activity (fft) (take 20) (map #(Math/abs %)) 1.40 + (max-indexed) (first) (<= 2)))] 1.41 + (or (accept? (take 64 base-activity)) 1.42 + (accept? (take 64 (drop 20 base-activity)))))))) 1.43 + 1.44 + 1.45 1.46 (def worm-segment-bottom-tip (rect-region [15 15] [22 22])) 1.47 1.48 @@ -223,8 +234,8 @@ 1.49 (let [worm-touch (:touch (peek experiences)) 1.50 tail-touch (worm-touch 0) 1.51 head-touch (worm-touch 4)] 1.52 - (and (< 0.55 (contact worm-segment-bottom-tip tail-touch)) 1.53 - (< 0.55 (contact worm-segment-top-tip head-touch)))))) 1.54 + (and (< 0.1 (contact worm-segment-bottom-tip tail-touch)) 1.55 + (< 0.1 (contact worm-segment-top-tip head-touch)))))) 1.56 1.57 1.58 (declare phi-space phi-scan debug-experience) 1.59 @@ -250,7 +261,7 @@ 1.60 :record nil 1.61 :experiences (atom []) 1.62 :experience-watch debug-experience 1.63 - :worm-model worm-model 1.64 + :worm worm 1.65 :end-frame nil}))) 1.66 1.67 (defn dir! [file] 1.68 @@ -283,14 +294,15 @@ 1.69 (grand-circle? experiences) (.setText text "Grand Circle") 1.70 (curled? experiences) (.setText text "Curled") 1.71 (wiggling? experiences) (.setText text "Wiggling") 1.72 - (resting? experiences) (.setText text "Resting"))) 1.73 + (resting? experiences) (.setText text "Resting") 1.74 + :else (.setText text "Unknown"))) 1.75 1.76 1.77 (defn worm-world 1.78 - [& {:keys [record motor-control keybindings view experiences 1.79 - worm-model end-frame experience-watch] :as settings}] 1.80 + [& {:keys [record motor-control keybindings view experiences 1.81 + worm end-frame experience-watch] :as settings}] 1.82 (let [{:keys [record motor-control keybindings view experiences 1.83 - worm-model end-frame experience-watch]} 1.84 + worm end-frame experience-watch]} 1.85 (merge (worm-world-defaults) settings) 1.86 1.87 touch-display (view-touch) 1.88 @@ -333,7 +345,7 @@ 1.89 (Capture/captureVideo 1.90 world 1.91 (dir! (File. record "main-view")))) 1.92 - (speed-up world) 1.93 + (speed-up world 0.5) 1.94 ;;(light-up-everything world) 1.95 ) 1.96 (fn [world tpf] 1.97 @@ -475,22 +487,21 @@ 1.98 ;;(infer-nils [nil 2 1 1]) [2 2 1 1] 1.99 1.100 1.101 -(defn debug-experience-phi [] 1.102 +(defn empathy-demonstration [] 1.103 (let [proprio (atom ())] 1.104 (fn 1.105 - [experiences] 1.106 + [experiences text] 1.107 (let [phi-indices (phi-scan (:proprioception (peek experiences)))] 1.108 (swap! proprio (partial cons phi-indices)) 1.109 (let [exp-thread (longest-thread (take 300 @proprio)) 1.110 - phi-loop (mapv phi-space (infer-nils exp-thread))] 1.111 + empathy (mapv phi-space (infer-nils exp-thread))] 1.112 (println-repl (vector:last-n exp-thread 22)) 1.113 (cond 1.114 - (grand-circle? phi-loop) (println "Grand Circle") 1.115 - (curled? phi-loop) (println "Curled") 1.116 - (wiggling? phi-loop) (println "Wiggling") 1.117 - (resting? phi-loop) (println "Resting") 1.118 - :else (println "Unknown"))))))) 1.119 - 1.120 + (grand-circle? empathy) (.setText text "Grand Circle") 1.121 + (curled? empathy) (.setText text "Curled") 1.122 + (wiggling? empathy) (.setText text "Wiggling") 1.123 + (resting? empathy) (.setText text "Resting") 1.124 + :else (.setText text "Unknown"))))))) 1.125 1.126 (defn init-interactive [] 1.127 (def phi-space 1.128 @@ -503,7 +514,49 @@ 1.129 {:experiences experiences}))) 1.130 @experiences)) 1.131 (def phi-scan (gen-phi-scan phi-space))) 1.132 - 1.133 1.134 -(defn run-experiment-1 [] 1.135 - (.start (worm-world :experience-watch (debug-experience-phi)))) 1.136 \ No newline at end of file 1.137 +(defn empathy-experiment-1 [record] 1.138 + (.start (worm-world :experience-watch (empathy-demonstration) 1.139 + :record record :worm worm*))) 1.140 + 1.141 + 1.142 +(def worm-action-label 1.143 + (juxt grand-circle? curled? wiggling?)) 1.144 + 1.145 +(defn compare-empathy-with-baseline [accuracy] 1.146 + (let [proprio (atom ())] 1.147 + (fn 1.148 + [experiences text] 1.149 + (let [phi-indices (phi-scan (:proprioception (peek experiences)))] 1.150 + (swap! proprio (partial cons phi-indices)) 1.151 + (let [exp-thread (longest-thread (take 300 @proprio)) 1.152 + empathy (mapv phi-space (infer-nils exp-thread)) 1.153 + experience-matches-empathy 1.154 + (= (worm-action-label experiences) 1.155 + (worm-action-label empathy))] 1.156 + (cond 1.157 + (grand-circle? empathy) (.setText text "Grand Circle") 1.158 + (curled? empathy) (.setText text "Curled") 1.159 + (wiggling? empathy) (.setText text "Wiggling") 1.160 + (resting? empathy) (.setText text "Resting") 1.161 + :else (.setText text "Unknown")) 1.162 + 1.163 + (println-repl experience-matches-empathy) 1.164 + (swap! accuracy #(conj % experience-matches-empathy))))))) 1.165 + 1.166 +(defn accuracy [v] 1.167 + (float (/ (count (filter true? v)) (count v)))) 1.168 + 1.169 +(defn test-empathy-accuracy [] 1.170 + (let [res (atom [])] 1.171 + (run-world 1.172 + (worm-world :experience-watch 1.173 + (compare-empathy-with-baseline res) 1.174 + :worm worm*)) 1.175 + (accuracy @res))) 1.176 + 1.177 + 1.178 + 1.179 + 1.180 + 1.181 +