1.1 --- a/org/worm_learn.clj	Tue Mar 18 21:44:15 2014 -0400
     1.2 +++ b/org/worm_learn.clj	Tue Mar 18 22:29:03 2014 -0400
     1.3 @@ -196,9 +196,8 @@
     1.4       :worm-model worm-model
     1.5       :end-frame nil}))
     1.6  
     1.7 -
     1.8  (defn dir! [file]
     1.9 -  (if (not (.exists file))
    1.10 +  (if-not (.exists file)
    1.11      (.mkdir file))
    1.12    file)
    1.13  
    1.14 @@ -238,7 +237,7 @@
    1.15           (speed-up world)
    1.16           (light-up-everything world))
    1.17         (fn [world tpf]
    1.18 -         (if (> (.getTime timer) end-frame)
    1.19 +         (if (and end-frame (> (.getTime timer) end-frame))
    1.20             (.stop world))
    1.21           (let [muscle-data (motor-control muscles)
    1.22                 proprioception-data (prop)
    1.23 @@ -266,130 +265,4 @@
    1.24              (if record (dir! (File. record "touch")))))))))
    1.25  
    1.26  
    1.27 -;; A demonstration of self organiging touch maps through experience. 
    1.28  
    1.29 -(def single-worm-segment-view
    1.30 -  [(Vector3f. 2.0681207, -6.1406755, 1.6106138)
    1.31 -   (Quaternion. -0.15558705, 0.843615, -0.3428654, -0.38281822)])
    1.32 -
    1.33 -(def worm-single-segment-muscle-labels
    1.34 -  [:lift-1 :lift-2 :roll-1 :roll-2])
    1.35 -
    1.36 -(defn touch-kinesthetics []
    1.37 -  [[170 :lift-1 40]
    1.38 -   [190 :lift-1 20]
    1.39 -   [206 :lift-1  0]
    1.40 -
    1.41 -   [400 :lift-2 40]
    1.42 -   [410 :lift-2  0]
    1.43 -
    1.44 -   [570 :lift-2 40]
    1.45 -   [590 :lift-2 20]
    1.46 -   [606 :lift-2  0]
    1.47 -
    1.48 -   [800 :lift-1 30]
    1.49 -   [809 :lift-1 0]
    1.50 -
    1.51 -   [900 :roll-2 40]
    1.52 -   [905 :roll-2 20]
    1.53 -   [910 :roll-2  0]
    1.54 -
    1.55 -   [1000 :roll-2 40]
    1.56 -   [1005 :roll-2 20]
    1.57 -   [1010 :roll-2  0]
    1.58 -   
    1.59 -   [1100 :roll-2 40]
    1.60 -   [1105 :roll-2 20]
    1.61 -   [1110 :roll-2  0]
    1.62 -   ])
    1.63 -
    1.64 -(defn single-worm-segment []
    1.65 -  (load-blender-model "Models/worm/worm-single-segment.blend"))
    1.66 -
    1.67 -(defn worm-segment-defaults []
    1.68 -  (let [direct-control (worm-direct-control worm-muscle-labels 40)]
    1.69 -    (merge (worm-world-defaults)
    1.70 -           {:worm-model single-worm-segment
    1.71 -            :view single-worm-segment-view
    1.72 -            :motor-control
    1.73 -            (motor-control-program
    1.74 -             worm-single-segment-muscle-labels
    1.75 -             (touch-kinesthetics))
    1.76 -            :end-frame 1200})))
    1.77 -
    1.78 -(def full-contact [(float 0.0) (float 0.1)])
    1.79 -
    1.80 -(defn pure-touch?
    1.81 -  "This is worm specific code to determine if a large region of touch
    1.82 -   sensors is either all on or all off."
    1.83 -  [[coords touch :as touch-data]]
    1.84 -  (= (set (map first touch)) (set full-contact)))
    1.85 -
    1.86 -(defn remove-similar
    1.87 -  [coll]
    1.88 -  (loop [result () coll (sort-by (comp - count) coll)]
    1.89 -    (if (empty? coll) result
    1.90 -        (let  [x  (first coll)
    1.91 -               xs (rest coll)
    1.92 -               c (count x)]
    1.93 -          (if (some
    1.94 -               (fn [other-set]
    1.95 -                 (let [oc (count other-set)]
    1.96 -                   (< (- (count (union other-set x)) c) (* oc 0.1))))
    1.97 -               xs)
    1.98 -            (recur result xs)
    1.99 -            (recur (cons x result) xs))))))
   1.100 -
   1.101 -
   1.102 -(defn rect-region [[x0 y0] [x1 y1]]
   1.103 -  (vec
   1.104 -   (for [x (range x0 (inc x1))
   1.105 -         y (range y0 (inc y1))]
   1.106 -     [x y])))
   1.107 -
   1.108 -(def all-touch-coordinates
   1.109 -  (concat
   1.110 -   (rect-region [0  15] [7  22])
   1.111 -   (rect-region [8   0] [14 29])
   1.112 -   (rect-region [15 15] [22 22])))
   1.113 -
   1.114 -(defn view-touch-region [coords]
   1.115 -  (let [touched-region
   1.116 -        (reduce
   1.117 -         (fn [m k]
   1.118 -           (assoc m k [0.0 0.1]))
   1.119 -         (zipmap all-touch-coordinates (repeat [0.1 0.1])) coords)
   1.120 -        data
   1.121 -        [[(vec (keys touched-region)) (vec (vals touched-region))]]
   1.122 -        touch-display (view-touch)]
   1.123 -    (touch-display data)
   1.124 -    (touch-display data)))
   1.125 -
   1.126 -(defn learn-touch-regions []
   1.127 -  (let [experiences (atom [])
   1.128 -        world (apply-map
   1.129 -               worm-world
   1.130 -               (assoc (worm-segment-defaults)
   1.131 -                 :experiences experiences))]
   1.132 -    (run-world world)
   1.133 -    (->>
   1.134 -     @experiences
   1.135 -     (drop 175)
   1.136 -     ;; access the single segment's touch data
   1.137 -     (map (comp first :touch))
   1.138 -     ;; only deal with "pure" touch data to determine surfaces
   1.139 -     (filter pure-touch?)
   1.140 -     ;; associate coordinates with touch values
   1.141 -     (map (partial apply zipmap))
   1.142 -     ;; select those regions where contact is being made
   1.143 -     (map (partial group-by second))
   1.144 -     (map #(get % full-contact))
   1.145 -     (map (partial map first))
   1.146 -     ;; remove redundant/subset regions
   1.147 -     (map set)
   1.148 -     remove-similar)))
   1.149 -
   1.150 -(defn learn-and-view-touch-regions []
   1.151 -  (map view-touch-region
   1.152 -       (learn-touch-regions)))
   1.153 -