Mercurial > cortex

comparison org/worm_learn.clj @ 416:9e52b6730fd0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
phi-space lookup works!
author Robert McIntyre <rlm@mit.edu>
date Wed, 19 Mar 2014 22:02:06 -0400
parents af7945c27474
children f689967c2545
comparison
equal deleted inserted replaced
415:af7945c27474 416:9e52b6730fd0
251 251
252 (defn record-experience! [experiences data] 252 (defn record-experience! [experiences data]
253 (swap! experiences #(conj % data))) 253 (swap! experiences #(conj % data)))
254 254
255 255
256 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 256
257 ;;;;;;;; Phi-Space ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 257 (declare phi-space phi-scan)
258 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
259
260 (defn generate-phi-space []
261 (let [experiences (atom [])]
262 (run-world
263 (apply-map
264 worm-world
265 (merge
266 (worm-world-defaults)
267 {:end-frame 700
268 :motor-control
269 (motor-control-program worm-muscle-labels do-all-the-things)
270 :experiences experiences})))
271 @experiences))
272
273
274 (defn bin [digits]
275 (fn [angles]
276 (->> angles
277 (flatten)
278 (map (juxt #(Math/sin %) #(Math/cos %)))
279 (flatten)
280 (mapv #(Math/round (* % (Math/pow 10 (dec digits))))))))
281
282 ;; k-nearest neighbors with spatial binning.
283 (defn gen-phi-scan [phi-space]
284 (let [bin-keys (reverse (map bin (range 4)))
285 bin-maps
286 (map (fn [bin-key phi-space]
287 (group-by (comp bin-key :proprioception) phi-space))
288 bin-keys (repeat phi-space))
289 lookups (map (fn [bin-key bin-map]
290 (fn [proprio] (bin-map (bin-key proprio))))
291 bin-keys bin-maps)]
292 (fn lookup [proprio-data]
293 (some #(% proprio-data) lookups))))
294
295
296
297
298 258
299 (defn worm-world 259 (defn worm-world
300 [& {:keys [record motor-control keybindings view experiences 260 [& {:keys [record motor-control keybindings view experiences
301 worm-model end-frame] :as settings}] 261 worm-model end-frame] :as settings}]
302 (let [{:keys [record motor-control keybindings view experiences 262 (let [{:keys [record motor-control keybindings view experiences
337 (when experiences 297 (when experiences
338 (record-experience! 298 (record-experience!
339 experiences {:touch touch-data 299 experiences {:touch touch-data
340 :proprioception proprioception-data 300 :proprioception proprioception-data
341 :muscle muscle-data}) 301 :muscle muscle-data})
302 (if-let [res (phi-scan proprioception-data)]
303 (println-repl "lookup successful --" (count res))
304 (println-repl "lookup failed"))
342 (cond 305 (cond
343 (grand-circle? @experiences) (println "Grand Circle") 306 (grand-circle? @experiences) (println "Grand Circle")
344 (curled? @experiences) (println "Curled") 307 (curled? @experiences) (println "Curled")
345 (wiggling? @experiences) (println "Wiggling") 308 (wiggling? @experiences) (println "Wiggling")
346 (resting? @experiences) (println "Resting")) 309 (resting? @experiences) (println "Resting"))
355 touch-data 318 touch-data
356 (if record (dir! (File. record "touch"))))))))) 319 (if record (dir! (File. record "touch")))))))))
357 320
358 321
359 322
323 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
324 ;;;;;;;; Phi-Space ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
325 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
326
327 (defn generate-phi-space []
328 (let [experiences (atom [])]
329 (run-world
330 (apply-map
331 worm-world
332 (merge
333 (worm-world-defaults)
334 {:end-frame 700
335 :motor-control
336 (motor-control-program worm-muscle-labels do-all-the-things)
337 :experiences experiences})))
338 @experiences))
339
340
341 (defn bin [digits]
342 (fn [angles]
343 (->> angles
344 (flatten)
345 (map (juxt #(Math/sin %) #(Math/cos %)))
346 (flatten)
347 (mapv #(Math/round (* % (Math/pow 10 (dec digits))))))))
348
349 ;; k-nearest neighbors with spatial binning.
350 (defn gen-phi-scan [phi-space]
351 (let [bin-keys (map bin [3 2 1])
352 bin-maps
353 (map (fn [bin-key phi-space]
354 (group-by (comp bin-key :proprioception) phi-space))
355 bin-keys (repeat phi-space))
356 lookups (map (fn [bin-key bin-map]
357 (fn [proprio] (bin-map (bin-key proprio))))
358 bin-keys bin-maps)]
359 (fn lookup [proprio-data]
360 (some #(% proprio-data) lookups))))
361
362 (defn init []
363 (def phi-space (generate-phi-space))
364 (def phi-scan (gen-phi-scan phi-space))
365 )