view org/self_organizing_touch.clj @ 486:6d460ac3f5d0

working on user guide.
author Robert McIntyre <rlm@mit.edu>
date Sat, 29 Mar 2014 20:12:52 -0400
parents f339e3d5cc8c
children 01934317b25b
line wrap: on
line source
1 (ns org.aurellem.self-organizing-touch
2 "Using free play to automatically organize touch perception into regions."
3 {:author "Robert McIntyre"}
4 (:use (cortex world util import body sense
5 hearing touch vision proprioception movement
6 test))
7 (:use [clojure set pprint])
8 (:import (com.jme3.math ColorRGBA Vector3f))
9 (:import java.io.File)
10 (:import com.jme3.audio.AudioNode)
11 (:import com.aurellem.capture.RatchetTimer)
12 (:import (com.aurellem.capture Capture IsoTimer))
13 (:import (com.jme3.math Vector3f ColorRGBA)))
15 (use 'org.aurellem.worm-learn)
16 (dorun (cortex.import/mega-import-jme3))
18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
19 ;; A demonstration of self organiging touch maps through experience. ;
20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
22 (def single-worm-segment-view
23 [(Vector3f. 2.0681207, -6.1406755, 1.6106138)
24 (Quaternion. -0.15558705, 0.843615, -0.3428654, -0.38281822)])
26 (def worm-single-segment-muscle-labels
27 [:lift-1 :lift-2 :roll-1 :roll-2])
29 (defn touch-kinesthetics []
30 [[170 :lift-1 40]
31 [190 :lift-1 19]
32 [206 :lift-1 0]
34 [400 :lift-2 40]
35 [410 :lift-2 0]
37 [570 :lift-2 40]
38 [590 :lift-2 21]
39 [606 :lift-2 0]
41 [800 :lift-1 30]
42 [809 :lift-1 0]
44 [900 :roll-2 40]
45 [905 :roll-2 20]
46 [910 :roll-2 0]
48 [1000 :roll-2 40]
49 [1005 :roll-2 20]
50 [1010 :roll-2 0]
52 [1100 :roll-2 40]
53 [1105 :roll-2 20]
54 [1110 :roll-2 0]
55 ])
57 (defn single-worm-segment []
58 (load-blender-model "Models/worm/worm-single-segment.blend"))
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)}))
68 (defn worm-segment-defaults []
69 (let [direct-control (worm-direct-control worm-muscle-labels 40)]
70 (merge (worm-world-defaults)
71 {:worm worm-segment
72 :view single-worm-segment-view
73 :experience-watch nil
74 :motor-control
75 (motor-control-program
76 worm-single-segment-muscle-labels
77 (touch-kinesthetics))
78 :end-frame 1200})))
80 (def full-contact [(float 0.0) (float 0.1)])
82 (defn pure-touch?
83 "This is worm specific code to determine if a large region of touch
84 sensors is either all on or all off."
85 [[coords touch :as touch-data]]
86 (= (set (map first touch)) (set full-contact)))
88 (defn remove-similar
89 [coll]
90 (loop [result () coll (sort-by (comp - count) coll)]
91 (if (empty? coll) result
92 (let [[x & xs] coll
93 c (count x)]
94 (if (some
95 (fn [other-set]
96 (let [oc (count other-set)]
97 (< (- (count (union other-set x)) c) (* oc 0.1))))
98 xs)
99 (recur result xs)
100 (recur (cons x result) xs))))))
102 (def all-touch-coordinates
103 (concat
104 (rect-region [0 15] [7 22])
105 (rect-region [8 0] [14 29])
106 (rect-region [15 15] [22 22])))
108 (defn view-touch-region
109 ([coords out]
110 (let [touched-region
111 (reduce
112 (fn [m k]
113 (assoc m k [0.0 0.1]))
114 (zipmap all-touch-coordinates (repeat [0.1 0.1])) coords)
115 data
116 [[(vec (keys touched-region)) (vec (vals touched-region))]]
117 touch-display (view-touch)]
118 (touch-display data out)))
119 ([coords] (view-touch-region nil)))
122 (defn learn-touch-regions []
123 (let [experiences (atom [])
124 world (apply-map
125 worm-world
126 (assoc (worm-segment-defaults)
127 :experiences experiences
128 :record (File. "/home/r/proj/cortex/thesis/video/touch-learn-2/")))]
129 (run-world world)
130 (->>
131 @experiences
132 (drop 175)
133 ;; access the single segment's touch data
134 (map (comp first :touch))
135 ;; only deal with "pure" touch data to determine surfaces
136 (filter pure-touch?)
137 ;; associate coordinates with touch values
138 (map (partial apply zipmap))
139 ;; select those regions where contact is being made
140 (map (partial group-by second))
141 (map #(get % full-contact))
142 (map (partial map first))
143 ;; remove redundant/subset regions
144 (map set)
145 remove-similar)))
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])))
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)))))
165 (defn learn-and-view-touch-regions []
166 (map view-touch-region
167 (learn-touch-regions)))