1.1 --- a/org/worm_learn.clj	Wed Mar 19 15:59:46 2014 -0400
     1.2 +++ b/org/worm_learn.clj	Wed Mar 19 21:46:58 2014 -0400
     1.3 @@ -81,8 +81,8 @@
     1.4  ;; motions that causes the worm to form a circle.
     1.5  
     1.6  (def curl-script
     1.7 -  [[370 :d-flex 40]
     1.8 -   [600 :d-flex 0]])
     1.9 +  [[150 :d-flex 40]
    1.10 +   [250 :d-flex 0]])
    1.11  
    1.12  (def period 18)
    1.13  
    1.14 @@ -106,6 +106,17 @@
    1.15                       (range 100 1000000 (+ 3 (* period 2)))))
    1.16  
    1.17  
    1.18 +(defn shift-script [shift script]
    1.19 +  (map (fn [[time label power]] [(+ time shift) label power])
    1.20 +       script))
    1.21 +
    1.22 +(def do-all-the-things 
    1.23 +  (concat
    1.24 +   curl-script
    1.25 +   [[300 :d-ex 40]
    1.26 +    [320 :d-ex 0]]
    1.27 +   (shift-script 280 (take 16 wiggle-script))))
    1.28 +
    1.29  ;; Normally, we'd use unsupervised/supervised machine learning to pick
    1.30  ;; out the defining features of the different actions available to the
    1.31  ;; worm. For this project, I am going to explicitely define functions
    1.32 @@ -118,13 +129,9 @@
    1.33  ;; thesis.
    1.34  
    1.35  
    1.36 -(defn straight?
    1.37 -  "Is the worm straight?"
    1.38 -  [experiences]
    1.39 -  (every?
    1.40 -   (fn [[_ _ bend]]
    1.41 -     (< (Math/sin bend) 0.05))
    1.42 -   (:proprioception (peek experiences))))
    1.43 +;; curled? relies on proprioception, resting? relies on touch,
    1.44 +;; wiggling? relies on a fourier analysis of muscle contraction, and
    1.45 +;; grand-circle? relies on touch and reuses curled? as a gaurd.
    1.46  
    1.47  (defn curled?
    1.48    "Is the worm curled up?"
    1.49 @@ -134,17 +141,6 @@
    1.50       (> (Math/sin bend) 0.64))
    1.51     (:proprioception (peek experiences))))
    1.52  
    1.53 -(defn grand-circle?
    1.54 -  "Does the worm form a majestic circle (one end touching the other)?"
    1.55 -  [experiences]
    1.56 -  (and (curled? experiences)
    1.57 -       true)) ;; TODO: add code here.
    1.58 -
    1.59 -(defn vector:last-n [v n]
    1.60 -  (let [c (count v)]
    1.61 -    (if (< c n) v
    1.62 -        (subvec v (- c n) c))))
    1.63 -
    1.64  (defn touch-average [[coords touch]]
    1.65    (/ (average (map first touch)) (average (map second touch))))
    1.66  
    1.67 @@ -154,15 +150,15 @@
    1.68           y (range y0 (inc y1))]
    1.69       [x y])))
    1.70  
    1.71 -(def worm-segment-touch-bottom (rect-region [8 15] [14 22]))
    1.72 +(def worm-segment-bottom (rect-region [8 15] [14 22]))
    1.73  
    1.74  (defn contact
    1.75    "Determine how much contact a particular worm segment has with
    1.76     other objects. Returns a value between 0 and 1, where 1 is full
    1.77     contact and 0 is no contact."
    1.78 -  [[coords contact :as touch]]
    1.79 +  [touch-region [coords contact :as touch]]
    1.80    (-> (zipmap coords contact)
    1.81 -      (select-keys worm-segment-touch-bottom)
    1.82 +      (select-keys touch-region)
    1.83        (vals)
    1.84        (#(map first %))
    1.85        (average)
    1.86 @@ -170,6 +166,19 @@
    1.87        (- 1)
    1.88        (Math/abs)))
    1.89  
    1.90 +(defn resting?
    1.91 +  "Is the worm straight?"
    1.92 +  [experiences]
    1.93 +  (every?
    1.94 +   (fn [touch-data]
    1.95 +     (< 0.9 (contact worm-segment-bottom touch-data)))
    1.96 +   (:touch (peek experiences))))
    1.97 +
    1.98 +(defn vector:last-n [v n]
    1.99 +  (let [c (count v)]
   1.100 +    (if (< c n) v
   1.101 +        (subvec v (- c n) c))))
   1.102 +
   1.103  (defn fft [nums]
   1.104    (map
   1.105     #(.getReal %)
   1.106 @@ -182,7 +191,6 @@
   1.107  (defn max-indexed [s]
   1.108    (first (sort-by (comp - second) (indexed s))))
   1.109  
   1.110 -
   1.111  (defn wiggling?
   1.112    "Is the worm wiggling?"
   1.113    [experiences]
   1.114 @@ -196,24 +204,23 @@
   1.115              (map #(- (% a-flex) (% a-ex)) muscle-activity)]
   1.116          (= 2
   1.117             (first
   1.118 -            (max-indexed (map #(Math/abs %) (take 20 (fft base-activity))))))))))
   1.119 +            (max-indexed
   1.120 +             (map #(Math/abs %)
   1.121 +                  (take 20 (fft base-activity))))))))))
   1.122  
   1.123 -        ;; (println-repl
   1.124 -        ;;  (apply format "%d  %.2f"
   1.125 -        ;;         (first (sort-by
   1.126 -        ;;                 (comp -  second)
   1.127 -        ;;                 (indexed (take 20 ))))))))))
   1.128 +(def worm-segment-bottom-tip (rect-region [15 15] [22 22]))
   1.129  
   1.130 -    ;;     (println-repl
   1.131 -    ;;      (apply
   1.132 -    ;;       format
   1.133 -    ;;       (apply str (repeat analysis-interval "%5.1f"))
   1.134 -    ;;       (fft base-activity)))
   1.135 +(def worm-segment-top-tip (rect-region [0 15] [7 22]))
   1.136  
   1.137 -    ;; ;;(println-repl (last base-activity)) 
   1.138 -    ;;   )))
   1.139 -
   1.140 -
   1.141 +(defn grand-circle?
   1.142 +  "Does the worm form a majestic circle (one end touching the other)?"
   1.143 +  [experiences]
   1.144 +  (and true;; (curled? experiences)
   1.145 +       (let [worm-touch (:touch (peek experiences))
   1.146 +             tail-touch (worm-touch 0)
   1.147 +             head-touch (worm-touch 4)]
   1.148 +         (and (< 0.55 (contact worm-segment-bottom-tip tail-touch))
   1.149 +              (< 0.55 (contact worm-segment-top-tip    head-touch))))))
   1.150  
   1.151  (def standard-world-view
   1.152    [(Vector3f. 4.207176, -3.7366982, 3.0816958)
   1.153 @@ -245,6 +252,50 @@
   1.154  (defn record-experience! [experiences data]
   1.155    (swap! experiences #(conj % data)))
   1.156  
   1.157 +
   1.158 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.159 +;;;;;;;;   Phi-Space   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.160 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.161 +
   1.162 +(defn generate-phi-space []
   1.163 +  (let [experiences (atom [])]
   1.164 +    (run-world
   1.165 +     (apply-map 
   1.166 +      worm-world
   1.167 +      (merge
   1.168 +       (worm-world-defaults)
   1.169 +       {:end-frame 700
   1.170 +        :motor-control
   1.171 +        (motor-control-program worm-muscle-labels do-all-the-things)
   1.172 +        :experiences experiences})))
   1.173 +    @experiences))
   1.174 +  
   1.175 +
   1.176 +(defn bin [digits]
   1.177 +  (fn [angles]
   1.178 +    (->> angles
   1.179 +         (flatten)
   1.180 +         (map (juxt #(Math/sin %) #(Math/cos %)))
   1.181 +         (flatten)
   1.182 +         (mapv #(Math/round (* % (Math/pow 10 (dec digits))))))))
   1.183 +
   1.184 +;; k-nearest neighbors with spatial binning.
   1.185 +(defn gen-phi-scan [phi-space]
   1.186 +  (let [bin-keys (reverse (map bin (range 4)))
   1.187 +        bin-maps
   1.188 +        (map (fn [bin-key phi-space]
   1.189 +               (group-by (comp bin-key :proprioception) phi-space))
   1.190 +             bin-keys (repeat phi-space))
   1.191 +        lookups (map (fn [bin-key bin-map]
   1.192 +                      (fn [proprio] (bin-map (bin-key proprio))))
   1.193 +                    bin-keys bin-maps)]
   1.194 +    (fn lookup [proprio-data]
   1.195 +      (some #(% proprio-data) lookups))))
   1.196 +
   1.197 +
   1.198 +
   1.199 +
   1.200 +
   1.201  (defn worm-world
   1.202    [& {:keys [record motor-control keybindings view experiences
   1.203               worm-model end-frame] :as settings}]
   1.204 @@ -282,18 +333,17 @@
   1.205             (.stop world))
   1.206           (let [muscle-data (vec (motor-control muscles))
   1.207                 proprioception-data (prop)
   1.208 -               touch-data (map #(% (.getRootNode world)) touch)]
   1.209 +               touch-data (mapv #(% (.getRootNode world)) touch)]
   1.210             (when experiences
   1.211               (record-experience!
   1.212                experiences {:touch touch-data
   1.213                             :proprioception proprioception-data
   1.214                             :muscle muscle-data})
   1.215 -             ;;(if (curled? @experiences) (println "Curled"))
   1.216 -             ;;(if (straight? @experiences)    (println "Straight"))
   1.217 -             ;; (println-repl
   1.218 -             ;;  (apply format "%.2f %.2f %.2f %.2f %.2f\n"
   1.219 -             ;;         (map contact touch-data)))
   1.220 -             (wiggling? @experiences)
   1.221 +             (cond
   1.222 +              (grand-circle? @experiences) (println "Grand Circle")
   1.223 +              (curled? @experiences)       (println "Curled")
   1.224 +              (wiggling? @experiences)     (println "Wiggling")
   1.225 +              (resting? @experiences)      (println "Resting"))
   1.226               )
   1.227             (muscle-display
   1.228              muscle-data