comparison org/worm_learn.clj @ 430:5205535237fb

fix skew in self-organizing-touch, work on thesis.
author Robert McIntyre <rlm@mit.edu>
date Sat, 22 Mar 2014 16:10:34 -0400
parents 7f3581dc58ff
children d3c5f9b70574
comparison
equal deleted inserted replaced
429:b5d0f0adf19f 430:5205535237fb
139 (every? 139 (every?
140 (fn [[_ _ bend]] 140 (fn [[_ _ bend]]
141 (> (Math/sin bend) 0.64)) 141 (> (Math/sin bend) 0.64))
142 (:proprioception (peek experiences)))) 142 (:proprioception (peek experiences))))
143 143
144 (defn touch-average [[coords touch]]
145 (/ (average (map first touch)) (average (map second touch))))
146
147 (defn rect-region [[x0 y0] [x1 y1]] 144 (defn rect-region [[x0 y0] [x1 y1]]
148 (vec 145 (vec
149 (for [x (range x0 (inc x1)) 146 (for [x (range x0 (inc x1))
150 y (range y0 (inc y1))] 147 y (range y0 (inc y1))]
151 [x y]))) 148 [x y])))
223 (< 0.55 (contact worm-segment-top-tip head-touch)))))) 220 (< 0.55 (contact worm-segment-top-tip head-touch))))))
224 221
225 222
226 (declare phi-space phi-scan) 223 (declare phi-space phi-scan)
227 224
228 (defn next-phi-states
229 "Given proprioception data, determine the most likely next sensory
230 pattern from previous experience."
231 [proprio phi-space phi-scan]
232 (if-let [results (phi-scan proprio)]
233 (mapv phi-space
234 (filter (partial > (count phi-space))
235 (map inc results)))))
236
237 (defn debug-experience 225 (defn debug-experience
238 [experiences] 226 [experiences]
239 (cond 227 (cond
240 (grand-circle? experiences) (println "Grand Circle") 228 (grand-circle? experiences) (println "Grand Circle")
241 (curled? experiences) (println "Curled") 229 (curled? experiences) (println "Curled")
255 [(Vector3f. -0.0708936, -8.570261, 2.6487997) 243 [(Vector3f. -0.0708936, -8.570261, 2.6487997)
256 (Quaternion. -2.318909E-4, 0.9985348, 0.053941682, 0.004291452)]) 244 (Quaternion. -2.318909E-4, 0.9985348, 0.053941682, 0.004291452)])
257 245
258 (defn worm-world-defaults [] 246 (defn worm-world-defaults []
259 (let [direct-control (worm-direct-control worm-muscle-labels 40)] 247 (let [direct-control (worm-direct-control worm-muscle-labels 40)]
260 {:view worm-side-view 248 (merge direct-control
261 :motor-control (:motor-control direct-control) 249 {:view worm-side-view
262 :keybindings (:keybindings direct-control) 250 :record nil
263 :record nil 251 :experiences (atom [])
264 :experiences (atom []) 252 :experience-watch debug-experience
265 :experience-watch debug-experience 253 :worm-model worm-model
266 :worm-model worm-model 254 :end-frame nil})))
267 :end-frame nil}))
268 255
269 (defn dir! [file] 256 (defn dir! [file]
270 (if-not (.exists file) 257 (if-not (.exists file)
271 (.mkdir file)) 258 (.mkdir file))
272 file) 259 file)
298 (merge standard-debug-controls keybindings) 285 (merge standard-debug-controls keybindings)
299 (fn [world] 286 (fn [world]
300 (position-camera world view) 287 (position-camera world view)
301 (.setTimer world timer) 288 (.setTimer world timer)
302 (display-dilated-time world timer) 289 (display-dilated-time world timer)
303 (if record 290 (when record
304 (Capture/captureVideo 291 (Capture/captureVideo
305 world 292 world
306 (dir! (File. record "main-view")))) 293 (dir! (File. record "main-view"))))
307 (speed-up world) 294 (speed-up world)
308 (light-up-everything world)) 295 (light-up-everything world))
319 :muscle muscle-data})) 306 :muscle muscle-data}))
320 (when experience-watch 307 (when experience-watch
321 (experience-watch @experiences)) 308 (experience-watch @experiences))
322 (muscle-display 309 (muscle-display
323 muscle-data 310 muscle-data
324 (if record (dir! (File. record "muscle")))) 311 (when record (dir! (File. record "muscle"))))
325 (prop-display 312 (prop-display
326 proprioception-data 313 proprioception-data
327 (if record (dir! (File. record "proprio")))) 314 (when record (dir! (File. record "proprio"))))
328 (touch-display 315 (touch-display
329 touch-data 316 touch-data
330 (if record (dir! (File. record "touch"))))))))) 317 (when record (dir! (File. record "touch")))))))))
331 318
332 319
333 320
334 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 321 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
335 ;;;;;;;; Phi-Space ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 322 ;;;;;;;; Phi-Space ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
404 (defn init [] 391 (defn init []
405 (def phi-space (generate-phi-space)) 392 (def phi-space (generate-phi-space))
406 (def phi-scan (gen-phi-scan phi-space)) 393 (def phi-scan (gen-phi-scan phi-space))
407 ) 394 )
408 395
409 396 ;; (defn infer-nils-dyl [s]
410 397 ;; (loop [closed ()
398 ;; open s
399 ;; anchor 0]
400 ;; (if-not (empty? open)
401 ;; (recur (conj closed
402 ;; (or (peek open)
403 ;; anchor))
404 ;; (pop open)
405 ;; (or (peek open) anchor))
406 ;; closed)))
407
408 ;; (defn infer-nils [s]
409 ;; (for [i (range (count s))]
410 ;; (or (get s i)
411 ;; (some (comp not nil?) (vector:last-n (- (count s) i)))
412 ;; 0)))
411 413
412 414
413 (defn infer-nils 415 (defn infer-nils
414 "Replace nils with the next available non-nil element in the 416 "Replace nils with the next available non-nil element in the
415 sequence, or barring that, 0." 417 sequence, or barring that, 0."
416 [s] 418 [s]
417 (loop [i (dec (count s)) v (transient s)] 419 (loop [i (dec (count s))
418 (if (= i 0) (persistent! v) 420 v (transient s)]
419 (let [cur (v i)] 421 (if (zero? i) (persistent! v)
420 (if cur 422 (if-let [cur (v i)]
421 (if (get v (dec i) 0) 423 (if (get v (dec i) 0)
422 (recur (dec i) v) 424 (recur (dec i) v)
423 (recur (dec i) (assoc! v (dec i) cur))) 425 (recur (dec i) (assoc! v (dec i) cur)))
424 (recur i (assoc! v i 0))))))) 426 (recur i (assoc! v i 0))))))
425 427
426 ;; tests 428 ;; tests
427 429
428 ;;(infer-nils [1 nil 1 1]) [1 1 1 1] 430 ;;(infer-nils [1 nil 1 1]) [1 1 1 1]
429 ;;(infer-nils [1 1 1 nil]) [1 1 1 0] 431 ;;(infer-nils [1 1 1 nil]) [1 1 1 0]