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 +