Mercurial > cortex
comparison org/worm_learn.clj @ 418:027707c75f39
saving progress for the night.
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Thu, 20 Mar 2014 00:24:46 -0400 |
parents | f689967c2545 |
children | dd40244255d4 |
comparison
equal
deleted
inserted
replaced
417:f689967c2545 | 418:027707c75f39 |
---|---|
220 tail-touch (worm-touch 0) | 220 tail-touch (worm-touch 0) |
221 head-touch (worm-touch 4)] | 221 head-touch (worm-touch 4)] |
222 (and (< 0.55 (contact worm-segment-bottom-tip tail-touch)) | 222 (and (< 0.55 (contact worm-segment-bottom-tip tail-touch)) |
223 (< 0.55 (contact worm-segment-top-tip head-touch)))))) | 223 (< 0.55 (contact worm-segment-top-tip head-touch)))))) |
224 | 224 |
225 | |
226 (declare phi-space phi-scan) | |
227 | |
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 | |
238 [experiences] | |
239 (cond | |
240 (grand-circle? experiences) (println "Grand Circle") | |
241 (curled? experiences) (println "Curled") | |
242 (wiggling? experiences) (println "Wiggling") | |
243 (resting? experiences) (println "Resting"))) | |
244 | |
245 | |
246 (defn debug-experience | |
247 [experiences] | |
248 ;; (println-repl | |
249 ;; (count (next-phi-states (:proprioception (peek experiences)) | |
250 ;; phi-space phi-scan))) | |
251 (cond | |
252 (grand-circle? experiences) (println "Grand Circle") | |
253 (curled? experiences) (println "Curled") | |
254 (wiggling? experiences) (println "Wiggling") | |
255 (resting? experiences) (println "Resting")) | |
256 ) | |
257 | |
258 | |
259 | |
260 | |
261 | |
225 (def standard-world-view | 262 (def standard-world-view |
226 [(Vector3f. 4.207176, -3.7366982, 3.0816958) | 263 [(Vector3f. 4.207176, -3.7366982, 3.0816958) |
227 (Quaternion. 0.11118768, 0.87678415, 0.24434438, -0.3989771)]) | 264 (Quaternion. 0.11118768, 0.87678415, 0.24434438, -0.3989771)]) |
228 | 265 |
229 (def worm-side-view | 266 (def worm-side-view |
238 (let [direct-control (worm-direct-control worm-muscle-labels 40)] | 275 (let [direct-control (worm-direct-control worm-muscle-labels 40)] |
239 {:view worm-side-view | 276 {:view worm-side-view |
240 :motor-control (:motor-control direct-control) | 277 :motor-control (:motor-control direct-control) |
241 :keybindings (:keybindings direct-control) | 278 :keybindings (:keybindings direct-control) |
242 :record nil | 279 :record nil |
243 :experiences nil | 280 :experiences (atom []) |
281 :experience-watch debug-experience | |
244 :worm-model worm-model | 282 :worm-model worm-model |
245 :end-frame nil})) | 283 :end-frame nil})) |
246 | 284 |
247 (defn dir! [file] | 285 (defn dir! [file] |
248 (if-not (.exists file) | 286 (if-not (.exists file) |
250 file) | 288 file) |
251 | 289 |
252 (defn record-experience! [experiences data] | 290 (defn record-experience! [experiences data] |
253 (swap! experiences #(conj % data))) | 291 (swap! experiences #(conj % data))) |
254 | 292 |
255 | |
256 | |
257 (declare phi-space phi-scan) | |
258 | |
259 (defn worm-world | 293 (defn worm-world |
260 [& {:keys [record motor-control keybindings view experiences | 294 [& {:keys [record motor-control keybindings view experiences |
261 worm-model end-frame] :as settings}] | 295 worm-model end-frame experience-watch] :as settings}] |
262 (let [{:keys [record motor-control keybindings view experiences | 296 (let [{:keys [record motor-control keybindings view experiences |
263 worm-model end-frame]} | 297 worm-model end-frame experience-watch]} |
264 (merge (worm-world-defaults) settings) | 298 (merge (worm-world-defaults) settings) |
265 worm (doto (worm-model) (body!)) | 299 worm (doto (worm-model) (body!)) |
266 touch (touch! worm) | 300 touch (touch! worm) |
267 prop (proprioception! worm) | 301 prop (proprioception! worm) |
268 muscles (movement! worm) | 302 muscles (movement! worm) |
296 touch-data (mapv #(% (.getRootNode world)) touch)] | 330 touch-data (mapv #(% (.getRootNode world)) touch)] |
297 (when experiences | 331 (when experiences |
298 (record-experience! | 332 (record-experience! |
299 experiences {:touch touch-data | 333 experiences {:touch touch-data |
300 :proprioception proprioception-data | 334 :proprioception proprioception-data |
301 :muscle muscle-data}) | 335 :muscle muscle-data})) |
302 (cond | 336 (when experience-watch |
303 (grand-circle? @experiences) (println "Grand Circle") | 337 (experience-watch @experiences)) |
304 (curled? @experiences) (println "Curled") | |
305 (wiggling? @experiences) (println "Wiggling") | |
306 (resting? @experiences) (println "Resting")) | |
307 ) | |
308 (muscle-display | 338 (muscle-display |
309 muscle-data | 339 muscle-data |
310 (if record (dir! (File. record "muscle")))) | 340 (if record (dir! (File. record "muscle")))) |
311 (prop-display | 341 (prop-display |
312 proprioception-data | 342 proprioception-data |
331 {:end-frame 700 | 361 {:end-frame 700 |
332 :motor-control | 362 :motor-control |
333 (motor-control-program worm-muscle-labels do-all-the-things) | 363 (motor-control-program worm-muscle-labels do-all-the-things) |
334 :experiences experiences}))) | 364 :experiences experiences}))) |
335 @experiences)) | 365 @experiences)) |
336 | |
337 | 366 |
338 (defn bin [digits] | 367 (defn bin [digits] |
339 (fn [angles] | 368 (fn [angles] |
340 (->> angles | 369 (->> angles |
341 (flatten) | 370 (flatten) |
342 (map (juxt #(Math/sin %) #(Math/cos %))) | 371 (map (juxt #(Math/sin %) #(Math/cos %))) |
343 (flatten) | 372 (flatten) |
344 (mapv #(Math/round (* % (Math/pow 10 (dec digits)))))))) | 373 (mapv #(Math/round (* % (Math/pow 10 (dec digits)))))))) |
345 | 374 |
346 ;; k-nearest neighbors with spatial binning. | 375 ;; k-nearest neighbors with spatial binning. Only returns a result if |
376 ;; the propriceptive data is within 10% of a previously recorded | |
377 ;; result in all dimensions. | |
347 (defn gen-phi-scan [phi-space] | 378 (defn gen-phi-scan [phi-space] |
348 (let [bin-keys (map bin [3 2 1]) | 379 (let [bin-keys (map bin [3 2 1]) |
349 bin-maps | 380 bin-maps |
350 (map (fn [bin-key] | 381 (map (fn [bin-key] |
351 (group-by | 382 (group-by |
355 (fn [proprio] (bin-map (bin-key proprio)))) | 386 (fn [proprio] (bin-map (bin-key proprio)))) |
356 bin-keys bin-maps)] | 387 bin-keys bin-maps)] |
357 (fn lookup [proprio-data] | 388 (fn lookup [proprio-data] |
358 (some #(% proprio-data) lookups)))) | 389 (some #(% proprio-data) lookups)))) |
359 | 390 |
360 ;; (defn gen-phi-scan [phi-space] | |
361 ;; (let [bin-keys (map bin [3 2 1]) | |
362 ;; bin-maps | |
363 ;; (map (fn [bin-key phi-space] | |
364 ;; (group-by (comp bin-key :proprioception) phi-space)) | |
365 ;; bin-keys (repeat phi-space)) | |
366 ;; lookups (map (fn [bin-key bin-map] | |
367 ;; (fn [proprio] (bin-map (bin-key proprio)))) | |
368 ;; bin-keys bin-maps)] | |
369 ;; (fn lookup [proprio-data] | |
370 ;; (some #(% proprio-data) lookups)))) | |
371 | |
372 (defn init [] | 391 (defn init [] |
373 (def phi-space (generate-phi-space)) | 392 (def phi-space (generate-phi-space)) |
374 (def phi-scan (gen-phi-scan phi-space)) | 393 (def phi-scan (gen-phi-scan phi-space)) |
375 ) | 394 ) |
395 |