Mercurial > cortex

comparison org/self_organizing_touch.clj @ 452:f339e3d5cc8c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
finish draft of chapter 3.
author Robert McIntyre <rlm@mit.edu>
date Wed, 26 Mar 2014 22:17:42 -0400
parents 5205535237fb
children 01934317b25b
comparison
equal deleted inserted replaced
451:0a4362d1f138 452:f339e3d5cc8c
26 (def worm-single-segment-muscle-labels 26 (def worm-single-segment-muscle-labels
27 [:lift-1 :lift-2 :roll-1 :roll-2]) 27 [:lift-1 :lift-2 :roll-1 :roll-2])
28 28
29 (defn touch-kinesthetics [] 29 (defn touch-kinesthetics []
30 [[170 :lift-1 40] 30 [[170 :lift-1 40]
31 [190 :lift-1 20] 31 [190 :lift-1 19]
32 [206 :lift-1 0] 32 [206 :lift-1 0]
33 33
34 [400 :lift-2 40] 34 [400 :lift-2 40]
35 [410 :lift-2 0] 35 [410 :lift-2 0]
36 36
37 [570 :lift-2 40] 37 [570 :lift-2 40]
38 [590 :lift-2 20] 38 [590 :lift-2 21]
39 [606 :lift-2 0] 39 [606 :lift-2 0]
40 40
41 [800 :lift-1 30] 41 [800 :lift-1 30]
42 [809 :lift-1 0] 42 [809 :lift-1 0]
43 43
55 ]) 55 ])
56 56
57 (defn single-worm-segment [] 57 (defn single-worm-segment []
58 (load-blender-model "Models/worm/worm-single-segment.blend")) 58 (load-blender-model "Models/worm/worm-single-segment.blend"))
59 59
60 (defn worm-segment []
61 (let [model (single-worm-segment)]
62 {:body (doto model (body!))
63 :touch (touch! model)
64 :proprioception (proprioception! model)
65 :muscles (movement! model)}))
66
67
60 (defn worm-segment-defaults [] 68 (defn worm-segment-defaults []
61 (let [direct-control (worm-direct-control worm-muscle-labels 40)] 69 (let [direct-control (worm-direct-control worm-muscle-labels 40)]
62 (merge (worm-world-defaults) 70 (merge (worm-world-defaults)
63 {:worm-model single-worm-segment 71 {:worm worm-segment
64 :view single-worm-segment-view 72 :view single-worm-segment-view
65 :experience-watch nil 73 :experience-watch nil
66 :motor-control 74 :motor-control
67 (motor-control-program 75 (motor-control-program
68 worm-single-segment-muscle-labels 76 worm-single-segment-muscle-labels
95 (concat 103 (concat
96 (rect-region [0 15] [7 22]) 104 (rect-region [0 15] [7 22])
97 (rect-region [8 0] [14 29]) 105 (rect-region [8 0] [14 29])
98 (rect-region [15 15] [22 22]))) 106 (rect-region [15 15] [22 22])))
99 107
100 (defn view-touch-region [coords] 108 (defn view-touch-region
101 (let [touched-region 109 ([coords out]
102 (reduce 110 (let [touched-region
103 (fn [m k] 111 (reduce
104 (assoc m k [0.0 0.1])) 112 (fn [m k]
105 (zipmap all-touch-coordinates (repeat [0.1 0.1])) coords) 113 (assoc m k [0.0 0.1]))
106 data 114 (zipmap all-touch-coordinates (repeat [0.1 0.1])) coords)
107 [[(vec (keys touched-region)) (vec (vals touched-region))]] 115 data
108 touch-display (view-touch)] 116 [[(vec (keys touched-region)) (vec (vals touched-region))]]
109 (dorun (repeatedly 5 #(touch-display data))))) 117 touch-display (view-touch)]
118 (touch-display data out)))
119 ([coords] (view-touch-region nil)))
120
110 121
111 (defn learn-touch-regions [] 122 (defn learn-touch-regions []
112 (let [experiences (atom []) 123 (let [experiences (atom [])
113 world (apply-map 124 world (apply-map
114 worm-world 125 worm-world
115 (assoc (worm-segment-defaults) 126 (assoc (worm-segment-defaults)
116 :experiences experiences))] 127 :experiences experiences
128 :record (File. "/home/r/proj/cortex/thesis/video/touch-learn-2/")))]
117 (run-world world) 129 (run-world world)
118 (->> 130 (->>
119 @experiences 131 @experiences
120 (drop 175) 132 (drop 175)
121 ;; access the single segment's touch data 133 ;; access the single segment's touch data
130 (map (partial map first)) 142 (map (partial map first))
131 ;; remove redundant/subset regions 143 ;; remove redundant/subset regions
132 (map set) 144 (map set)
133 remove-similar))) 145 remove-similar)))
134 146
147
148 (def all-touch-coordinates
149 (concat
150 (rect-region [0 15] [7 22])
151 (rect-region [8 0] [14 29])
152 (rect-region [15 15] [22 22])))
153
154 (defn view-touch-region [coords]
155 (let [touched-region
156 (reduce
157 (fn [m k]
158 (assoc m k [0.0 0.1]))
159 (zipmap all-touch-coordinates (repeat [0.1 0.1])) coords)
160 data
161 [[(vec (keys touched-region)) (vec (vals touched-region))]]
162 touch-display (view-touch)]
163 (dorun (repeatedly 5 #(touch-display data)))))
164
135 (defn learn-and-view-touch-regions [] 165 (defn learn-and-view-touch-regions []
136 (map view-touch-region 166 (map view-touch-region
137 (learn-touch-regions))) 167 (learn-touch-regions)))
138 168
139 169