# HG changeset patch # User Robert McIntyre # Date 1395280018 14400 # Node ID af7945c274740367dc79b7ebf18ca4c9f2fa66a8 # Parent 634795361af8f018602043d93bd21cf8321f083e working on phi-space. diff -r 634795361af8 -r af7945c27474 org/worm_learn.clj --- a/org/worm_learn.clj Wed Mar 19 15:59:46 2014 -0400 +++ b/org/worm_learn.clj Wed Mar 19 21:46:58 2014 -0400 @@ -81,8 +81,8 @@ ;; motions that causes the worm to form a circle. (def curl-script - [[370 :d-flex 40] - [600 :d-flex 0]]) + [[150 :d-flex 40] + [250 :d-flex 0]]) (def period 18) @@ -106,6 +106,17 @@ (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 @@ -118,13 +129,9 @@ ;; thesis. -(defn straight? - "Is the worm straight?" - [experiences] - (every? - (fn [[_ _ bend]] - (< (Math/sin bend) 0.05)) - (:proprioception (peek experiences)))) +;; curled? relies on proprioception, resting? relies on touch, +;; wiggling? relies on a fourier analysis of muscle contraction, and +;; grand-circle? relies on touch and reuses curled? as a gaurd. (defn curled? "Is the worm curled up?" @@ -134,17 +141,6 @@ (> (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)))) @@ -154,15 +150,15 @@ 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) @@ -170,6 +166,19 @@ (- 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 %) @@ -182,7 +191,6 @@ (defn max-indexed [s] (first (sort-by (comp - second) (indexed s)))) - (defn wiggling? "Is the worm wiggling?" [experiences] @@ -196,24 +204,23 @@ (map #(- (% a-flex) (% a-ex)) muscle-activity)] (= 2 (first - (max-indexed (map #(Math/abs %) (take 20 (fft base-activity)))))))))) + (max-indexed + (map #(Math/abs %) + (take 20 (fft base-activity)))))))))) - ;; (println-repl - ;; (apply format "%d %.2f" - ;; (first (sort-by - ;; (comp - second) - ;; (indexed (take 20 )))))))))) +(def worm-segment-bottom-tip (rect-region [15 15] [22 22])) - ;; (println-repl - ;; (apply - ;; format - ;; (apply str (repeat analysis-interval "%5.1f")) - ;; (fft base-activity))) +(def worm-segment-top-tip (rect-region [0 15] [7 22])) - ;; ;;(println-repl (last base-activity)) - ;; ))) - - +(defn grand-circle? + "Does the worm form a majestic circle (one end touching the other)?" + [experiences] + (and true;; (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)) + (< 0.55 (contact worm-segment-top-tip head-touch)))))) (def standard-world-view [(Vector3f. 4.207176, -3.7366982, 3.0816958) @@ -245,6 +252,50 @@ (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}] @@ -282,18 +333,17 @@ (.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")) - ;;(if (straight? @experiences) (println "Straight")) - ;; (println-repl - ;; (apply format "%.2f %.2f %.2f %.2f %.2f\n" - ;; (map contact touch-data))) - (wiggling? @experiences) + (cond + (grand-circle? @experiences) (println "Grand Circle") + (curled? @experiences) (println "Curled") + (wiggling? @experiences) (println "Wiggling") + (resting? @experiences) (println "Resting")) ) (muscle-display muscle-data diff -r 634795361af8 -r af7945c27474 thesis/org/roadmap.org --- a/thesis/org/roadmap.org Wed Mar 19 15:59:46 2014 -0400 +++ b/thesis/org/roadmap.org Wed Mar 19 21:46:58 2014 -0400 @@ -194,17 +194,26 @@ *** DONE complete automatic touch partitioning CLOSED: [2014-03-18 Tue 21:43] SCHEDULED: <2014-03-18 Tue> -*** TODO complete cyclic predicate - SCHEDULED: <2014-03-18 Tue> -*** TODO complete three phi-stream action predicatates; test them with debug control - SCHEDULED: <2014-03-17 Mon> - CLOCK: [2014-03-18 Tue 18:36] +*** DONE complete cyclic predicate + CLOSED: [2014-03-19 Wed 16:34] SCHEDULED: <2014-03-18 Tue> + CLOCK: [2014-03-19 Wed 13:16]--[2014-03-19 Wed 16:34] => 3:18 +*** DONE complete three phi-stream action predicatates; test them with debug control + CLOSED: [2014-03-19 Wed 16:35] SCHEDULED: <2014-03-17 Mon> + CLOCK: [2014-03-18 Tue 18:36]--[2014-03-18 Tue 21:43] => 3:07 CLOCK: [2014-03-18 Tue 18:34]--[2014-03-18 Tue 18:36] => 0:02 CLOCK: [2014-03-17 Mon 19:19]--[2014-03-17 Mon 21:19] => 2:00 +*** DONE build an automatic "do all the things" sequence. + CLOSED: [2014-03-19 Wed 16:55] SCHEDULED: <2014-03-19 Wed> + CLOCK: [2014-03-19 Wed 16:53]--[2014-03-19 Wed 16:55] => 0:02 +*** TODO implement proprioception based movement lookup in phi-space + SCHEDULED: <2014-03-19 Wed> + CLOCK: [2014-03-19 Wed 16:55] + CLOCK: [2014-03-19 Wed 16:53]--[2014-03-19 Wed 16:53] => 0:00 + + *** TODO create test videos, also record positions of worm segments - SCHEDULED: <2014-03-17 Mon> -*** TODO complete proprioception based movement lookup in phi-space - SCHEDULED: <2014-03-17 Mon> + SCHEDULED: <2014-03-19 Wed> + *** TODO Collect intro, worm-learn and cortex creation into draft thesis.