1.1 --- a/org/self_organizing_touch.clj	Wed Mar 26 20:38:17 2014 -0400
     1.2 +++ b/org/self_organizing_touch.clj	Wed Mar 26 22:17:42 2014 -0400
     1.3 @@ -28,14 +28,14 @@
     1.4  
     1.5  (defn touch-kinesthetics []
     1.6    [[170 :lift-1 40]
     1.7 -   [190 :lift-1 20]
     1.8 +   [190 :lift-1 19]
     1.9     [206 :lift-1  0]
    1.10  
    1.11     [400 :lift-2 40]
    1.12     [410 :lift-2  0]
    1.13  
    1.14     [570 :lift-2 40]
    1.15 -   [590 :lift-2 20]
    1.16 +   [590 :lift-2 21]
    1.17     [606 :lift-2  0]
    1.18  
    1.19     [800 :lift-1 30]
    1.20 @@ -57,10 +57,18 @@
    1.21  (defn single-worm-segment []
    1.22    (load-blender-model "Models/worm/worm-single-segment.blend"))
    1.23  
    1.24 +(defn worm-segment []
    1.25 +  (let [model (single-worm-segment)]
    1.26 +    {:body (doto model (body!))
    1.27 +     :touch (touch! model)
    1.28 +     :proprioception (proprioception! model)
    1.29 +     :muscles (movement! model)}))
    1.30 +
    1.31 +
    1.32  (defn worm-segment-defaults []
    1.33    (let [direct-control (worm-direct-control worm-muscle-labels 40)]
    1.34      (merge (worm-world-defaults)
    1.35 -           {:worm-model single-worm-segment
    1.36 +           {:worm worm-segment
    1.37              :view single-worm-segment-view
    1.38              :experience-watch nil
    1.39              :motor-control
    1.40 @@ -97,23 +105,27 @@
    1.41     (rect-region [8   0] [14 29])
    1.42     (rect-region [15 15] [22 22])))
    1.43  
    1.44 -(defn view-touch-region [coords]
    1.45 -  (let [touched-region
    1.46 -        (reduce
    1.47 -         (fn [m k]
    1.48 -           (assoc m k [0.0 0.1]))
    1.49 -         (zipmap all-touch-coordinates (repeat [0.1 0.1])) coords)
    1.50 -        data
    1.51 -        [[(vec (keys touched-region)) (vec (vals touched-region))]]
    1.52 -        touch-display (view-touch)]
    1.53 -    (dorun (repeatedly 5 #(touch-display data)))))
    1.54 +(defn view-touch-region
    1.55 +  ([coords out]
    1.56 +     (let [touched-region
    1.57 +           (reduce
    1.58 +            (fn [m k]
    1.59 +              (assoc m k [0.0 0.1]))
    1.60 +            (zipmap all-touch-coordinates (repeat [0.1 0.1])) coords)
    1.61 +           data
    1.62 +           [[(vec (keys touched-region)) (vec (vals touched-region))]]
    1.63 +           touch-display (view-touch)]
    1.64 +       (touch-display data out)))
    1.65 +  ([coords] (view-touch-region nil)))
    1.66 +
    1.67  
    1.68  (defn learn-touch-regions []
    1.69    (let [experiences (atom [])
    1.70          world (apply-map
    1.71                 worm-world
    1.72                 (assoc (worm-segment-defaults)
    1.73 -                 :experiences experiences))]
    1.74 +                 :experiences experiences
    1.75 +                 :record (File. "/home/r/proj/cortex/thesis/video/touch-learn-2/")))]
    1.76      (run-world world)
    1.77      (->>
    1.78       @experiences
    1.79 @@ -132,6 +144,24 @@
    1.80       (map set)
    1.81       remove-similar)))
    1.82  
    1.83 +
    1.84 +(def all-touch-coordinates
    1.85 +  (concat
    1.86 +   (rect-region [0  15] [7  22])
    1.87 +   (rect-region [8   0] [14 29])
    1.88 +   (rect-region [15 15] [22 22])))
    1.89 +
    1.90 +(defn view-touch-region [coords]
    1.91 +  (let [touched-region
    1.92 +        (reduce
    1.93 +         (fn [m k]
    1.94 +           (assoc m k [0.0 0.1]))
    1.95 +         (zipmap all-touch-coordinates (repeat [0.1 0.1])) coords)
    1.96 +        data
    1.97 +        [[(vec (keys touched-region)) (vec (vals touched-region))]]
    1.98 +        touch-display (view-touch)]
    1.99 +    (dorun (repeatedly 5 #(touch-display data)))))
   1.100 +
   1.101  (defn learn-and-view-touch-regions []
   1.102    (map view-touch-region
   1.103         (learn-touch-regions)))