Mercurial > cortex

     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)))

    14 

    15 (use 'org.aurellem.worm-learn)

    16 (dorun (cortex.import/mega-import-jme3))

    17 

    18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    19 ;; A demonstration of self organiging touch maps through experience. ;

    20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    21 

    22 (def single-worm-segment-view

    23   [(Vector3f. 2.0681207, -6.1406755, 1.6106138)

    24    (Quaternion. -0.15558705, 0.843615, -0.3428654, -0.38281822)])

    25 

    26 (def worm-single-segment-muscle-labels

    27   [:lift-1 :lift-2 :roll-1 :roll-2])

    28 

    29 (defn touch-kinesthetics []

    30   [[170 :lift-1 40]

    31    [190 :lift-1 20]

    32    [206 :lift-1  0]

    33 

    34    [400 :lift-2 40]

    35    [410 :lift-2  0]

    36 

    37    [570 :lift-2 40]

    38    [590 :lift-2 20]

    39    [606 :lift-2  0]

    40 

    41    [800 :lift-1 30]

    42    [809 :lift-1 0]

    43 

    44    [900 :roll-2 40]

    45    [905 :roll-2 20]

    46    [910 :roll-2  0]

    47 

    48    [1000 :roll-2 40]

    49    [1005 :roll-2 20]

    50    [1010 :roll-2  0]

    51    

    52    [1100 :roll-2 40]

    53    [1105 :roll-2 20]

    54    [1110 :roll-2  0]

    55    ])

    56 

    57 (defn single-worm-segment []

    58   (load-blender-model "Models/worm/worm-single-segment.blend"))

    59 

    60 (defn worm-segment-defaults []

    61   (let [direct-control (worm-direct-control worm-muscle-labels 40)]

    62     (merge (worm-world-defaults)

    63            {:worm-model single-worm-segment

    64             :view single-worm-segment-view

    65             :motor-control

    66             (motor-control-program

    67              worm-single-segment-muscle-labels

    68              (touch-kinesthetics))

    69             :end-frame 1200})))

    70 

    71 (def full-contact [(float 0.0) (float 0.1)])

    72 

    73 (defn pure-touch?

    74   "This is worm specific code to determine if a large region of touch

    75    sensors is either all on or all off."

    76   [[coords touch :as touch-data]]

    77   (= (set (map first touch)) (set full-contact)))

    78 

    79 (defn remove-similar

    80   [coll]

    81   (loop [result () coll (sort-by (comp - count) coll)]

    82     (if (empty? coll) result

    83         (let  [x  (first coll)

    84                xs (rest coll)

    85                c (count x)]

    86           (if (some

    87                (fn [other-set]

    88                  (let [oc (count other-set)]

    89                    (< (- (count (union other-set x)) c) (* oc 0.1))))

    90                xs)

    91             (recur result xs)

    92             (recur (cons x result) xs))))))

    93 

    94 (defn rect-region [[x0 y0] [x1 y1]]

    95   (vec

    96    (for [x (range x0 (inc x1))

    97          y (range y0 (inc y1))]

    98      [x y])))

    99 

   100 (def all-touch-coordinates

   101   (concat

   102    (rect-region [0  15] [7  22])

   103    (rect-region [8   0] [14 29])

   104    (rect-region [15 15] [22 22])))

   105 

   106 (defn view-touch-region [coords]

   107   (let [touched-region

   108         (reduce

   109          (fn [m k]

   110            (assoc m k [0.0 0.1]))

   111          (zipmap all-touch-coordinates (repeat [0.1 0.1])) coords)

   112         data

   113         [[(vec (keys touched-region)) (vec (vals touched-region))]]

   114         touch-display (view-touch)]

   115     (touch-display data)

   116     (touch-display data)))

   117 

   118 (defn learn-touch-regions []

   119   (let [experiences (atom [])

   120         world (apply-map

   121                worm-world

   122                (assoc (worm-segment-defaults)

   123                  :experiences experiences))]

   124     (run-world world)

   125     (->>

   126      @experiences

   127      (drop 175)

   128      ;; access the single segment's touch data

   129      (map (comp first :touch))

   130      ;; only deal with "pure" touch data to determine surfaces

   131      (filter pure-touch?)

   132      ;; associate coordinates with touch values

   133      (map (partial apply zipmap))

   134      ;; select those regions where contact is being made

   135      (map (partial group-by second))

   136      (map #(get % full-contact))

   137      (map (partial map first))

   138      ;; remove redundant/subset regions

   139      (map set)

   140      remove-similar)))

   141 

   142 (defn learn-and-view-touch-regions []

   143   (map view-touch-region

   144        (learn-touch-regions)))

   145 

   146
author	Robert McIntyre <rlm@mit.edu>
date	Tue, 18 Mar 2014 22:29:03 -0400
parents
children	a331d5ff73e0