Mercurial > cortex

comparison org/worm_learn.clj @ 408:3b4012b42611

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
completed demonstration showing automatic partitioning of touch space based on experience.
author Robert McIntyre <rlm@mit.edu>
date Tue, 18 Mar 2014 21:28:04 -0400
parents bd6d03596ea8
children e6a7e80f885a
comparison
equal deleted inserted replaced
407:bd6d03596ea8 408:3b4012b42611
1 (ns org.aurellem.worm-learn 1 (ns org.aurellem.worm-learn
2 "General worm creation framework." 2 "General worm creation framework."
3 {:author "Robert McIntyre"} 3 {:author "Robert McIntyre"}
4 (:use (cortex world util import body sense 4 (:use (cortex world util import body sense
5 hearing touch vision proprioception movement)) 5 hearing touch vision proprioception movement
6 test))
6 (:import (com.jme3.math ColorRGBA Vector3f)) 7 (:import (com.jme3.math ColorRGBA Vector3f))
7 (:import java.io.File) 8 (:import java.io.File)
8 (:import com.jme3.audio.AudioNode) 9 (:import com.jme3.audio.AudioNode)
9 (:import com.aurellem.capture.RatchetTimer) 10 (:import com.aurellem.capture.RatchetTimer)
10 (:import (com.aurellem.capture Capture IsoTimer)) 11 (:import (com.aurellem.capture Capture IsoTimer))
11 (:import (com.jme3.math Vector3f ColorRGBA))) 12 (:import (com.jme3.math Vector3f ColorRGBA)))
12 13
13 (use 'clojure.pprint) 14 (use 'clojure.pprint)
14 15 (use 'clojure.set)
15 (dorun (cortex.import/mega-import-jme3)) 16 (dorun (cortex.import/mega-import-jme3))
16 (rlm.rlm-commands/help) 17 (rlm.rlm-commands/help)
17 18
18 (load-bullet) 19 (load-bullet)
19 20
245 (when experiences 246 (when experiences
246 (record-experience! 247 (record-experience!
247 experiences {:touch touch-data 248 experiences {:touch touch-data
248 :proprioception proprioception-data 249 :proprioception proprioception-data
249 :muscle muscle-data}) 250 :muscle muscle-data})
250 (if (curled? @experiences) (println "Curled")) 251 ;;(if (curled? @experiences) (println "Curled"))
251 ;;(if (straight? @experiences) (println "Straight")) 252 ;;(if (straight? @experiences) (println "Straight"))
252 ;; (println-repl 253 ;; (println-repl
253 ;; (apply format "%.2f %.2f %.2f %.2f %.2f\n" 254 ;; (apply format "%.2f %.2f %.2f %.2f %.2f\n"
254 ;; (map floor-contact touch-data))) 255 ;; (map floor-contact touch-data)))
255 256
284 285
285 [570 :lift-2 40] 286 [570 :lift-2 40]
286 [590 :lift-2 20] 287 [590 :lift-2 20]
287 [606 :lift-2 0] 288 [606 :lift-2 0]
288 289
289 [800 :lift-1 40] 290 [800 :lift-1 30]
290 [809 :lift-1 0] 291 [809 :lift-1 0]
291 292
292 [900 :roll-2 40] 293 [900 :roll-2 40]
293 [905 :roll-2 20] 294 [905 :roll-2 20]
294 [910 :roll-2 0] 295 [910 :roll-2 0]
300 [1100 :roll-2 40] 301 [1100 :roll-2 40]
301 [1105 :roll-2 20] 302 [1105 :roll-2 20]
302 [1110 :roll-2 0] 303 [1110 :roll-2 0]
303 ]) 304 ])
304 305
306 (defn single-worm-segment []
307 (load-blender-model "Models/worm/worm-single-segment.blend"))
308
305 (defn worm-segment-defaults [] 309 (defn worm-segment-defaults []
306 (let [direct-control (worm-direct-control worm-muscle-labels 40)] 310 (let [direct-control (worm-direct-control worm-muscle-labels 40)]
307 (merge (worm-world-defaults) 311 (merge (worm-world-defaults)
308 {:worm-model single-worm-segment 312 {:worm-model single-worm-segment
309 :view single-worm-segment-view 313 :view single-worm-segment-view
310 :motor-control 314 :motor-control
311 (motor-control-program 315 (motor-control-program
312 worm-single-segment-muscle-labels 316 worm-single-segment-muscle-labels
313 (touch-kinesthetics))}))) 317 (touch-kinesthetics))
314 318 :end-frame 1200})))
315 (defn single-worm-segment [] 319
316 (load-blender-model "Models/worm/worm-single-segment.blend")) 320 (def full-contact [(float 0.0) (float 0.1)])
317
318 321
319 (defn pure-touch? 322 (defn pure-touch?
320 "This is worm specific code to determine if a large region of touch 323 "This is worm specific code to determine if a large region of touch
321 sensors is either all on or all off." 324 sensors is either all on or all off."
322 [[coords touch :as touch-data]] 325 [[coords touch :as touch-data]]
323 (= (set (map first touch)) #{(float 0.1) (float 0.0)})) 326 (= (set (map first touch)) (set full-contact)))
327
328 (defn remove-similar
329 [coll]
330 (loop [result () coll (sort-by (comp - count) coll)]
331 (if (empty? coll) result
332 (let [x (first coll)
333 xs (rest coll)
334 c (count x)]
335 (if (some
336 (fn [other-set]
337 (let [oc (count other-set)]
338 (< (- (count (union other-set x)) c) (* oc 0.1))))
339 xs)
340 (recur result xs)
341 (recur (cons x result) xs))))))
342
343
344 (defn rect-region [[x0 y0] [x1 y1]]
345 (vec
346 (for [x (range x0 (inc x1))
347 y (range y0 (inc y1))]
348 [x y])))
349
350 (def all-touch-coordinates
351 (concat
352 (rect-region [0 15] [7 22])
353 (rect-region [8 0] [14 29])
354 (rect-region [15 15] [22 22])))
355
356 (defn view-touch-region [coords]
357 (let [touched-region
358 (reduce
359 (fn [m k]
360 (assoc m k [0.0 0.1]))
361 (zipmap all-touch-coordinates (repeat [0.1 0.1])) coords)
362 data
363 [[(vec (keys touched-region)) (vec (vals touched-region))]]
364 touch-display (view-touch)]
365 (touch-display data)
366 (touch-display data)))
367
368 (defn learn-touch-regions []
369 (let [experiences (atom [])
370 world (apply-map
371 worm-world
372 (assoc (worm-segment-defaults)
373 :experiences experiences))]
374 (run-world world)
375 (->>
376 @experiences
377 (drop 175)
378 ;; access the single segment's touch data
379 (map (comp first :touch))
380 ;; only deal with "pure" touch data to determine surfaces
381 (filter pure-touch?)
382 ;; associate coordinates with touch values
383 (map (partial apply zipmap))
384 ;; select those regions where contact is being made
385 (map (partial group-by second))
386 (map #(get % full-contact))
387 (map (partial map first))
388 ;; remove redundant/subset regions
389 (map set)
390 remove-similar)))
391
392 (defn learn-and-view-touch-regions []
393 (map view-touch-region
394 (learn-touch-regions)))
395