cortex: org/worm_learn.clj comparison

comparison org/worm_learn.clj @ 415:af7945c27474

working on phi-space.

author	Robert McIntyre <rlm@mit.edu>
date	Wed, 19 Mar 2014 21:46:58 -0400
parents	634795361af8
children	9e52b6730fd0

comparison

equal deleted inserted replaced

-:634795361af8
+:af7945c27474
 ;; These are scripts that direct the worm to move in two radically
 ;; different patterns -- a sinusoidal wiggling motion, and a curling
 ;; motions that causes the worm to form a circle.
 (def curl-script
-[[370 :d-flex 40]
+[[150 :d-flex 40]
-[600 :d-flex 0]])
+[250 :d-flex 0]])
 (def period 18)
 (def worm-muscle-labels
 [:base-ex :base-flex
 (def wiggle-script
 (mapcat gen-wiggle (repeat 4000 [:a-ex :a-flex])
 (range 100 1000000 (+ 3 (* period 2)))))
+(defn shift-script [shift script]
+(map (fn [[time label power]] [(+ time shift) label power])
+script))
+(def do-all-the-things
+(concat
+curl-script
+[[300 :d-ex 40]
+[320 :d-ex 0]]
+(shift-script 280 (take 16 wiggle-script))))
 ;; Normally, we'd use unsupervised/supervised machine learning to pick
 ;; out the defining features of the different actions available to the
 ;; worm. For this project, I am going to explicitely define functions
 ;; that recognize curling and wiggling respectively. These functions
 ;; are defined using all the information available from an embodied
 ;; invariance are complete non-issues here. This is the advantage of
 ;; body-centered action recognition and what I hope to show with this
 ;; thesis.
-(defn straight?
+;; curled? relies on proprioception, resting? relies on touch,
-"Is the worm straight?"
+;; wiggling? relies on a fourier analysis of muscle contraction, and
-[experiences]
+;; grand-circle? relies on touch and reuses curled? as a gaurd.
-(every?
-(fn [[_ _ bend]]
-(< (Math/sin bend) 0.05))
-(:proprioception (peek experiences))))
 (defn curled?
 "Is the worm curled up?"
 [experiences]
 (every?
 (fn [[_ _ bend]]
 (> (Math/sin bend) 0.64))
 (:proprioception (peek experiences))))
-(defn grand-circle?
-"Does the worm form a majestic circle (one end touching the other)?"
-[experiences]
-(and (curled? experiences)
-true)) ;; TODO: add code here.
-(defn vector:last-n [v n]
-(let [c (count v)]
-(if (< c n) v
-(subvec v (- c n) c))))
 (defn touch-average [[coords touch]]
 (/ (average (map first touch)) (average (map second touch))))
 (defn rect-region [[x0 y0] [x1 y1]]
 (vec
 (for [x (range x0 (inc x1))
 y (range y0 (inc y1))]
 [x y])))
-(def worm-segment-touch-bottom (rect-region [8 15] [14 22]))
+(def worm-segment-bottom (rect-region [8 15] [14 22]))
 (defn contact
 "Determine how much contact a particular worm segment has with
 other objects. Returns a value between 0 and 1, where 1 is full
 contact and 0 is no contact."
-[[coords contact :as touch]]
+[touch-region [coords contact :as touch]]
 (-> (zipmap coords contact)
-(select-keys worm-segment-touch-bottom)
+(select-keys touch-region)
 (vals)
 (#(map first %))
 (average)
 (* 10)
 (- 1)
 (Math/abs)))
+(defn resting?
+"Is the worm straight?"
+[experiences]
+(every?
+(fn [touch-data]
+(< 0.9 (contact worm-segment-bottom touch-data)))
+(:touch (peek experiences))))
+(defn vector:last-n [v n]
+(let [c (count v)]
+(if (< c n) v
+(subvec v (- c n) c))))
 (defn fft [nums]
 (map
 #(.getReal %)
 (.transform
 (FastFourierTransformer. DftNormalization/STANDARD)
 (def indexed (partial map-indexed vector))
 (defn max-indexed [s]
 (first (sort-by (comp - second) (indexed s))))
 (defn wiggling?
 "Is the worm wiggling?"
 [experiences]
 (let [analysis-interval 0x40]
 (map :muscle (vector:last-n experiences analysis-interval))
 base-activity
 (map #(- (% a-flex) (% a-ex)) muscle-activity)]
 (= 2
 (first
-(max-indexed (map #(Math/abs %) (take 20 (fft base-activity))))))))))
+(max-indexed
+(map #(Math/abs %)
-;; (println-repl
+(take 20 (fft base-activity))))))))))
-;;  (apply format "%d  %.2f"
-;;         (first (sort-by
+(def worm-segment-bottom-tip (rect-region [15 15] [22 22]))
-;;                 (comp -  second)
-;;                 (indexed (take 20 ))))))))))
+(def worm-segment-top-tip (rect-region [0 15] [7 22]))
-;;     (println-repl
+(defn grand-circle?
-;;      (apply
+"Does the worm form a majestic circle (one end touching the other)?"
-;;       format
+[experiences]
-;;       (apply str (repeat analysis-interval "%5.1f"))
+(and true;; (curled? experiences)
-;;       (fft base-activity)))
+(let [worm-touch (:touch (peek experiences))
+tail-touch (worm-touch 0)
-;; ;;(println-repl (last base-activity))
+head-touch (worm-touch 4)]
-;;   )))
+(and (< 0.55 (contact worm-segment-bottom-tip tail-touch))
+(< 0.55 (contact worm-segment-top-tip    head-touch))))))
 (def standard-world-view
 [(Vector3f. 4.207176, -3.7366982, 3.0816958)
 (Quaternion. 0.11118768, 0.87678415, 0.24434438, -0.3989771)])
 (.mkdir file))
 file)
 (defn record-experience! [experiences data]
 (swap! experiences #(conj % data)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;   Phi-Space   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defn generate-phi-space []
+(let [experiences (atom [])]
+(run-world
+(apply-map
+worm-world
+(merge
+(worm-world-defaults)
+{:end-frame 700
+:motor-control
+(motor-control-program worm-muscle-labels do-all-the-things)
+:experiences experiences})))
+@experiences))
+(defn bin [digits]
+(fn [angles]
+(->> angles
+(flatten)
+(map (juxt #(Math/sin %) #(Math/cos %)))
+(flatten)
+(mapv #(Math/round (* % (Math/pow 10 (dec digits))))))))
+;; k-nearest neighbors with spatial binning.
+(defn gen-phi-scan [phi-space]
+(let [bin-keys (reverse (map bin (range 4)))
+bin-maps
+(map (fn [bin-key phi-space]
+(group-by (comp bin-key :proprioception) phi-space))
+bin-keys (repeat phi-space))
+lookups (map (fn [bin-key bin-map]
+(fn [proprio] (bin-map (bin-key proprio))))
+bin-keys bin-maps)]
+(fn lookup [proprio-data]
+(some #(% proprio-data) lookups))))
 (defn worm-world
 [& {:keys [record motor-control keybindings view experiences
 worm-model end-frame] :as settings}]
 (let [{:keys [record motor-control keybindings view experiences
 (fn [world tpf]
 (if (and end-frame (> (.getTime timer) end-frame))
 (.stop world))
 (let [muscle-data (vec (motor-control muscles))
 proprioception-data (prop)
-touch-data (map #(% (.getRootNode world)) touch)]
+touch-data (mapv #(% (.getRootNode world)) touch)]
 (when experiences
 (record-experience!
 experiences {:touch touch-data
 :proprioception proprioception-data
 :muscle muscle-data})
-;;(if (curled? @experiences) (println "Curled"))
+(cond
-;;(if (straight? @experiences)    (println "Straight"))
+(grand-circle? @experiences) (println "Grand Circle")
-;; (println-repl
+(curled? @experiences)       (println "Curled")
-;;  (apply format "%.2f %.2f %.2f %.2f %.2f\n"
+(wiggling? @experiences)     (println "Wiggling")
-;;         (map contact touch-data)))
+(resting? @experiences)      (println "Resting"))
-(wiggling? @experiences)
 )
 (muscle-display
 muscle-data
 (if record (dir! (File. record "muscle"))))
 (prop-display

Mercurial > cortex

comparison org/worm_learn.clj @ 415:af7945c27474