cortex: org/worm_learn.clj comparison

comparison 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

comparison

equal deleted inserted replaced

-:432f2c4646cb
+:0a4362d1f138
 (let [model (load-blender-model "Models/worm/worm.blend")]
 {:body (doto model (body!))
 :touch (touch! model)
 :proprioception (proprioception! model)
 :muscles (movement! model)}))
+(defn worm* []
+(let [model (load-blender-model "Models/worm/worm-of-the-imagination.blend")]
+{:body (doto model (body!))
+:touch (touch! model)
+:proprioception (proprioception! model)
+:muscles (movement! model)}))
 (def output-base (File. "/home/r/proj/cortex/render/worm-learn/curl"))
 (defn motor-control-program
 (first (sort-by (comp - second) (indexed s))))
 (defn wiggling?
 "Is the worm wiggling?"
 [experiences]
-(let [analysis-interval 0x40]
+(let [analysis-interval 96]
 (when (> (count experiences) analysis-interval)
 (let [a-flex 3
 a-ex   2
 muscle-activity
 (map :muscle (vector:last-n experiences analysis-interval))
 base-activity
-(map #(- (% a-flex) (% a-ex)) muscle-activity)]
+(map #(- (% a-flex) (% a-ex)) muscle-activity)
-(= 2
+accept?
-(first
+(fn [activity]
-(max-indexed
+(->> activity (fft) (take 20) (map #(Math/abs %))
-(map #(Math/abs %)
+(max-indexed) (first) (<= 2)))]
-(take 20 (fft base-activity))))))))))
+(or (accept? (take 64 base-activity))
+(accept? (take 64 (drop 20 base-activity))))))))
 (def worm-segment-bottom-tip (rect-region [15 15] [22 22]))
 (def worm-segment-top-tip (rect-region [0 15] [7 22]))
 [experiences]
 (and (curled? experiences)
 (let [worm-touch (:touch (peek experiences))
 tail-touch (worm-touch 0)
 head-touch (worm-touch 4)]
-(and (< 0.55 (contact worm-segment-bottom-tip tail-touch))
+(and (< 0.1 (contact worm-segment-bottom-tip tail-touch))
-(< 0.55 (contact worm-segment-top-tip    head-touch))))))
+(< 0.1 (contact worm-segment-top-tip    head-touch))))))
 (declare phi-space phi-scan debug-experience)
 (merge direct-control
 {:view worm-side-view
 :record nil
 :experiences (atom [])
 :experience-watch debug-experience
-:worm-model worm-model
+:worm worm
 :end-frame nil})))
 (defn dir! [file]
 (if-not (.exists file)
 (.mkdir file))
 [experiences text]
 (cond
 (grand-circle? experiences) (.setText text "Grand Circle")
 (curled? experiences)       (.setText text "Curled")
 (wiggling? experiences)     (.setText text "Wiggling")
-(resting? experiences)      (.setText text "Resting")))
+(resting? experiences)      (.setText text "Resting")
+:else                       (.setText text "Unknown")))
 (defn worm-world
-[& {:keys [record motor-control keybindings view experiences
+[& {:keys    [record motor-control keybindings view experiences
-worm-model end-frame experience-watch] :as settings}]
+worm end-frame experience-watch] :as settings}]
 (let [{:keys [record motor-control keybindings view experiences
-worm-model end-frame experience-watch]}
+worm end-frame experience-watch]}
 (merge (worm-world-defaults) settings)
 touch-display  (view-touch)
 prop-display   (view-proprioception)
 muscle-display (view-movement)
 (when record
 (dir! record)
 (Capture/captureVideo
 world
 (dir! (File. record "main-view"))))
-(speed-up world)
+(speed-up world 0.5)
 ;;(light-up-everything world)
 )
 (fn [world tpf]
 (if (and end-frame (> (.getTime timer) end-frame))
 (.stop world))
 ;;(infer-nils [1 nil 1 1]) [1 1 1 1]
 ;;(infer-nils [1 1 1 nil]) [1 1 1 0]
 ;;(infer-nils [nil 2 1 1]) [2 2 1 1]
-(defn debug-experience-phi []
+(defn empathy-demonstration []
 (let [proprio (atom ())]
 (fn
-[experiences]
+[experiences text]
 (let [phi-indices (phi-scan (:proprioception (peek experiences)))]
 (swap! proprio (partial cons phi-indices))
 (let [exp-thread (longest-thread (take 300 @proprio))
-phi-loop (mapv phi-space (infer-nils exp-thread))]
+empathy (mapv phi-space (infer-nils exp-thread))]
 (println-repl (vector:last-n exp-thread 22))
 (cond
-(grand-circle? phi-loop) (println "Grand Circle")
+(grand-circle? empathy) (.setText text "Grand Circle")
-(curled? phi-loop)       (println "Curled")
+(curled? empathy)       (.setText text "Curled")
-(wiggling? phi-loop)     (println "Wiggling")
+(wiggling? empathy)     (.setText text "Wiggling")
-(resting? phi-loop)      (println "Resting")
+(resting? empathy)      (.setText text "Resting")
-:else                    (println "Unknown")))))))
+:else                   (.setText text "Unknown")))))))
 (defn init-interactive []
 (def phi-space
 (let [experiences (atom [])]
 (run-world
 (merge
 (worm-world-defaults)
 {:experiences experiences})))
 @experiences))
 (def phi-scan (gen-phi-scan phi-space)))
+(defn empathy-experiment-1 [record]
-(defn run-experiment-1 []
+(.start (worm-world :experience-watch (empathy-demonstration)
-(.start (worm-world :experience-watch (debug-experience-phi))))
+:record record :worm worm*)))
+(def worm-action-label
+(juxt grand-circle? curled? wiggling?))
+(defn compare-empathy-with-baseline [accuracy]
+(let [proprio (atom ())]
+(fn
+[experiences text]
+(let [phi-indices (phi-scan (:proprioception (peek experiences)))]
+(swap! proprio (partial cons phi-indices))
+(let [exp-thread (longest-thread (take 300 @proprio))
+empathy (mapv phi-space (infer-nils exp-thread))
+experience-matches-empathy
+(= (worm-action-label experiences)
+(worm-action-label empathy))]
+(cond
+(grand-circle? empathy) (.setText text "Grand Circle")
+(curled? empathy)       (.setText text "Curled")
+(wiggling? empathy)     (.setText text "Wiggling")
+(resting? empathy)      (.setText text "Resting")
+:else                   (.setText text "Unknown"))
+(println-repl experience-matches-empathy)
+(swap! accuracy #(conj % experience-matches-empathy)))))))
+(defn accuracy [v]
+(float (/ (count (filter true? v)) (count v))))
+(defn test-empathy-accuracy []
+(let [res (atom [])]
+(run-world
+(worm-world :experience-watch
+(compare-empathy-with-baseline res)
+:worm worm*))
+(accuracy @res)))

Mercurial > cortex

comparison org/worm_learn.clj @ 451:0a4362d1f138