cortex: org/worm_learn.clj comparison

comparison org/worm_learn.clj @ 407:bd6d03596ea8

add worm segment to demonstrate self-organizing touch maps.

author	Robert McIntyre <rlm@mit.edu>
date	Tue, 18 Mar 2014 19:53:42 -0400
parents	40b67bb71430
children	3b4012b42611

comparison

equal deleted inserted replaced

-:40b67bb71430
+:bd6d03596ea8
 (subvec v (- c n) c))))
 (defn touch-average [[coords touch]]
 (/ (average (map first touch)) (average (map second touch))))
+(def worm-segment-touch-bottom
+[[8 15] [8 16] [8 17] [8 18] [8 19] [8 20] [8 21] [8 22] [9 15]
+[9 16] [9 17] [9 18] [9 19] [9 20] [9 21] [9 22] [10 15] [10 16]
+[10 17] [10 18] [10 19] [10 20] [10 21] [10 22] [11 15] [11 16]
+[11 17] [11 18] [11 19] [11 20] [11 21] [11 22] [12 15] [12 16]
+[12 17] [12 18] [12 19] [12 20] [12 21] [12 22] [13 15] [13 16]
+[13 17] [13 18] [13 19] [13 20] [13 21] [13 22] [14 15] [14 16]
+[14 17] [14 18] [14 19] [14 20] [14 21] [14 22]])
 (defn floor-contact [[coords contact :as touch]]
 (let [raw-average
 (average
 (map
 first
 (vals
 (select-keys
 (zipmap coords contact)
-[[8 15] [8 16] [8 17] [8 18] [8 19] [8 20] [8 21] [8 22] [9 15]
+))))]
-[9 16] [9 17] [9 18] [9 19] [9 20] [9 21] [9 22] [10 15] [10 16]
-[10 17] [10 18] [10 19] [10 20] [10 21] [10 22] [11 15] [11 16]
-[11 17] [11 18] [11 19] [11 20] [11 21] [11 22] [12 15] [12 16]
-[12 17] [12 18] [12 19] [12 20] [12 21] [12 22] [13 15] [13 16]
-[13 17] [13 18] [13 19] [13 20] [13 21] [13 22] [14 15] [14 16]
-[14 17] [14 18] [14 19] [14 20] [14 21] [14 22]]))))]
 (Math/abs (- 1. (* 10 raw-average)))))
 (defn wiggling?
 "Is the worm wiggling?"
 (let [direct-control (worm-direct-control worm-muscle-labels 40)]
 {:view worm-side-view
 :motor-control (:motor-control direct-control)
 :keybindings (:keybindings direct-control)
 :record nil
-:experiences nil}))
+:experiences nil
+:worm-model worm-model
+:end-frame nil}))
 (defn dir! [file]
 (if (not (.exists file))
 (.mkdir file))
 file)
 (defn record-experience! [experiences data]
 (swap! experiences #(conj % data)))
 (defn worm-world
-[& {:keys [record motor-control keybindings view experiences] :as settings}]
+[& {:keys [record motor-control keybindings view experiences
-(let [{:keys [record motor-control keybindings view]}
+worm-model end-frame] :as settings}]
+(let [{:keys [record motor-control keybindings view experiences
+worm-model end-frame]}
 (merge (worm-world-defaults) settings)
 worm (doto (worm-model) (body!))
 touch   (touch! worm)
 prop    (proprioception! worm)
 muscles (movement! worm)
 touch-display  (view-touch)
 prop-display   (view-proprioception)
 muscle-display (view-movement)
 floor (box 10 1 10 :position (Vector3f. 0 -10 0)
-:color ColorRGBA/Gray :mass 0)]
+:color ColorRGBA/Gray :mass 0)
+timer (IsoTimer. 60)]
 (world
 (nodify [worm floor])
 (merge standard-debug-controls keybindings)
 (fn [world]
 (position-camera world view)
-(let [timer (IsoTimer. 60)]
+(.setTimer world timer)
-(.setTimer world timer)
+(display-dilated-time world timer)
-(display-dilated-time world timer))
 (if record
 (Capture/captureVideo
 world
 (dir! (File. record "main-view"))))
 (speed-up world)
 (light-up-everything world))
 (fn [world tpf]
+(if (> (.getTime timer) end-frame)
+(.stop world))
 (let [muscle-data (motor-control muscles)
 proprioception-data (prop)
 touch-data (map #(% (.getRootNode world)) touch)]
 (when experiences
 (record-experience!
 experiences {:touch touch-data
 :proprioception proprioception-data
 :muscle muscle-data})
 (if (curled? @experiences) (println "Curled"))
 ;;(if (straight? @experiences)    (println "Straight"))
-(println-repl
+;; (println-repl
-(apply format "%.2f %.2f %.2f %.2f %.2f\n"
+;;  (apply format "%.2f %.2f %.2f %.2f %.2f\n"
-(map floor-contact touch-data)))
+;;         (map floor-contact touch-data)))
 )
 (muscle-display
 muscle-data
 (if record (dir! (File. record "muscle"))))
 (prop-display
 proprioception-data
 (if record (dir! (File. record "proprio"))))
 (touch-display
 touch-data
 (if record (dir! (File. record "touch")))))))))
+;; A demonstration of self organiging touch maps through experience.
+(def single-worm-segment-view
+[(Vector3f. 2.0681207, -6.1406755, 1.6106138)
+(Quaternion. -0.15558705, 0.843615, -0.3428654, -0.38281822)])
+(def worm-single-segment-muscle-labels
+[:lift-1 :lift-2 :roll-1 :roll-2])
+(defn touch-kinesthetics []
+[[170 :lift-1 40]
+[190 :lift-1 20]
+[206 :lift-1  0]
+[400 :lift-2 40]
+[410 :lift-2  0]
+[570 :lift-2 40]
+[590 :lift-2 20]
+[606 :lift-2  0]
+[800 :lift-1 40]
+[809 :lift-1 0]
+[900 :roll-2 40]
+[905 :roll-2 20]
+[910 :roll-2  0]
+[1000 :roll-2 40]
+[1005 :roll-2 20]
+[1010 :roll-2  0]
+[1100 :roll-2 40]
+[1105 :roll-2 20]
+[1110 :roll-2  0]
+])
+(defn worm-segment-defaults []
+(let [direct-control (worm-direct-control worm-muscle-labels 40)]
+(merge (worm-world-defaults)
+{:worm-model single-worm-segment
+:view single-worm-segment-view
+:motor-control
+(motor-control-program
+worm-single-segment-muscle-labels
+(touch-kinesthetics))})))
+(defn single-worm-segment []
+(load-blender-model "Models/worm/worm-single-segment.blend"))
+(defn pure-touch?
+"This is worm specific code to determine if a large region of touch
+sensors is either all on or all off."
+[[coords touch :as touch-data]]
+(= (set (map first touch)) #{(float 0.1)  (float 0.0)}))

Mercurial > cortex

comparison org/worm_learn.clj @ 407:bd6d03596ea8