1.1 --- a/org/worm_learn.clj	Tue Mar 18 18:34:10 2014 -0400
     1.2 +++ b/org/worm_learn.clj	Tue Mar 18 19:53:42 2014 -0400
     1.3 @@ -143,6 +143,17 @@
     1.4  (defn touch-average [[coords touch]]
     1.5    (/ (average (map first touch)) (average (map second touch))))
     1.6  
     1.7 +(def worm-segment-touch-bottom
     1.8 +  [[8 15] [8 16] [8 17] [8 18] [8 19] [8 20] [8 21] [8 22] [9 15]
     1.9 +   [9 16] [9 17] [9 18] [9 19] [9 20] [9 21] [9 22] [10 15] [10 16]
    1.10 +   [10 17] [10 18] [10 19] [10 20] [10 21] [10 22] [11 15] [11 16]
    1.11 +   [11 17] [11 18] [11 19] [11 20] [11 21] [11 22] [12 15] [12 16]
    1.12 +   [12 17] [12 18] [12 19] [12 20] [12 21] [12 22] [13 15] [13 16]
    1.13 +   [13 17] [13 18] [13 19] [13 20] [13 21] [13 22] [14 15] [14 16]
    1.14 +   [14 17] [14 18] [14 19] [14 20] [14 21] [14 22]])
    1.15 +
    1.16 +
    1.17 +
    1.18  (defn floor-contact [[coords contact :as touch]]
    1.19    (let [raw-average
    1.20          (average
    1.21 @@ -151,13 +162,7 @@
    1.22            (vals
    1.23             (select-keys
    1.24              (zipmap coords contact)
    1.25 -            [[8 15] [8 16] [8 17] [8 18] [8 19] [8 20] [8 21] [8 22] [9 15]
    1.26 -             [9 16] [9 17] [9 18] [9 19] [9 20] [9 21] [9 22] [10 15] [10 16]
    1.27 -             [10 17] [10 18] [10 19] [10 20] [10 21] [10 22] [11 15] [11 16]
    1.28 -             [11 17] [11 18] [11 19] [11 20] [11 21] [11 22] [12 15] [12 16]
    1.29 -             [12 17] [12 18] [12 19] [12 20] [12 21] [12 22] [13 15] [13 16]
    1.30 -             [13 17] [13 18] [13 19] [13 20] [13 21] [13 22] [14 15] [14 16]
    1.31 -             [14 17] [14 18] [14 19] [14 20] [14 21] [14 22]]))))]
    1.32 +            ))))]
    1.33      (Math/abs (- 1. (* 10 raw-average)))))
    1.34  
    1.35  
    1.36 @@ -186,7 +191,10 @@
    1.37       :motor-control (:motor-control direct-control)
    1.38       :keybindings (:keybindings direct-control)
    1.39       :record nil
    1.40 -     :experiences nil}))
    1.41 +     :experiences nil
    1.42 +     :worm-model worm-model
    1.43 +     :end-frame nil}))
    1.44 +
    1.45  
    1.46  (defn dir! [file]
    1.47    (if (not (.exists file))
    1.48 @@ -197,8 +205,10 @@
    1.49    (swap! experiences #(conj % data)))
    1.50  
    1.51  (defn worm-world
    1.52 -  [& {:keys [record motor-control keybindings view experiences] :as settings}]
    1.53 -  (let [{:keys [record motor-control keybindings view]}
    1.54 +  [& {:keys [record motor-control keybindings view experiences
    1.55 +             worm-model end-frame] :as settings}]
    1.56 +  (let [{:keys [record motor-control keybindings view experiences
    1.57 +                worm-model end-frame]}
    1.58          (merge (worm-world-defaults) settings)
    1.59          worm (doto (worm-model) (body!))
    1.60          touch   (touch! worm)
    1.61 @@ -210,16 +220,16 @@
    1.62          muscle-display (view-movement)
    1.63          
    1.64          floor (box 10 1 10 :position (Vector3f. 0 -10 0)
    1.65 -                   :color ColorRGBA/Gray :mass 0)]
    1.66 +                   :color ColorRGBA/Gray :mass 0)
    1.67 +        timer (IsoTimer. 60)]
    1.68  
    1.69      (world
    1.70         (nodify [worm floor])
    1.71         (merge standard-debug-controls keybindings)
    1.72         (fn [world]
    1.73           (position-camera world view)
    1.74 -         (let [timer (IsoTimer. 60)]
    1.75 -           (.setTimer world timer)
    1.76 -           (display-dilated-time world timer))
    1.77 +         (.setTimer world timer)
    1.78 +         (display-dilated-time world timer)
    1.79           (if record
    1.80             (Capture/captureVideo
    1.81              world
    1.82 @@ -227,6 +237,8 @@
    1.83           (speed-up world)
    1.84           (light-up-everything world))
    1.85         (fn [world tpf]
    1.86 +         (if (> (.getTime timer) end-frame)
    1.87 +           (.stop world))
    1.88           (let [muscle-data (motor-control muscles)
    1.89                 proprioception-data (prop)
    1.90                 touch-data (map #(% (.getRootNode world)) touch)]
    1.91 @@ -237,10 +249,10 @@
    1.92                             :muscle muscle-data})
    1.93               (if (curled? @experiences) (println "Curled"))
    1.94               ;;(if (straight? @experiences)    (println "Straight"))
    1.95 -             (println-repl
    1.96 -              (apply format "%.2f %.2f %.2f %.2f %.2f\n"
    1.97 -                     (map floor-contact touch-data)))
    1.98 -
    1.99 +             ;; (println-repl
   1.100 +             ;;  (apply format "%.2f %.2f %.2f %.2f %.2f\n"
   1.101 +             ;;         (map floor-contact touch-data)))
   1.102 +             
   1.103               )
   1.104             (muscle-display
   1.105              muscle-data
   1.106 @@ -251,3 +263,61 @@
   1.107             (touch-display 
   1.108              touch-data
   1.109              (if record (dir! (File. record "touch")))))))))
   1.110 +
   1.111 +
   1.112 +;; A demonstration of self organiging touch maps through experience. 
   1.113 +
   1.114 +(def single-worm-segment-view
   1.115 +  [(Vector3f. 2.0681207, -6.1406755, 1.6106138)
   1.116 +   (Quaternion. -0.15558705, 0.843615, -0.3428654, -0.38281822)])
   1.117 +
   1.118 +(def worm-single-segment-muscle-labels
   1.119 +  [:lift-1 :lift-2 :roll-1 :roll-2])
   1.120 +
   1.121 +(defn touch-kinesthetics []
   1.122 +  [[170 :lift-1 40]
   1.123 +   [190 :lift-1 20]
   1.124 +   [206 :lift-1  0]
   1.125 +
   1.126 +   [400 :lift-2 40]
   1.127 +   [410 :lift-2  0]
   1.128 +
   1.129 +   [570 :lift-2 40]
   1.130 +   [590 :lift-2 20]
   1.131 +   [606 :lift-2  0]
   1.132 +
   1.133 +   [800 :lift-1 40]
   1.134 +   [809 :lift-1 0]
   1.135 +
   1.136 +   [900 :roll-2 40]
   1.137 +   [905 :roll-2 20]
   1.138 +   [910 :roll-2  0]
   1.139 +
   1.140 +   [1000 :roll-2 40]
   1.141 +   [1005 :roll-2 20]
   1.142 +   [1010 :roll-2  0]
   1.143 +   
   1.144 +   [1100 :roll-2 40]
   1.145 +   [1105 :roll-2 20]
   1.146 +   [1110 :roll-2  0]
   1.147 +   ])
   1.148 +
   1.149 +(defn worm-segment-defaults []
   1.150 +  (let [direct-control (worm-direct-control worm-muscle-labels 40)]
   1.151 +    (merge (worm-world-defaults)
   1.152 +           {:worm-model single-worm-segment
   1.153 +            :view single-worm-segment-view
   1.154 +            :motor-control
   1.155 +            (motor-control-program
   1.156 +             worm-single-segment-muscle-labels
   1.157 +             (touch-kinesthetics))})))
   1.158 +
   1.159 +(defn single-worm-segment []
   1.160 +  (load-blender-model "Models/worm/worm-single-segment.blend"))
   1.161 +
   1.162 +
   1.163 +(defn pure-touch?
   1.164 +  "This is worm specific code to determine if a large region of touch
   1.165 +   sensors is either all on or all off."
   1.166 +  [[coords touch :as touch-data]]
   1.167 +  (= (set (map first touch)) #{(float 0.1)  (float 0.0)}))
   1.168 \ No newline at end of file