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 & xs] coll

    84                c (count x)]

    85           (if (some

    86                (fn [other-set]

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

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

    89                xs)

    90             (recur result xs)

    91             (recur (cons x result) xs))))))

    92 

    93 (def all-touch-coordinates

    94   (concat

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

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

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

    98 

    99 (defn view-touch-region [coords]

   100   (let [touched-region

   101         (reduce

   102          (fn [m k]

   103            (assoc m k [0.0 0.1]))

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

   105         data

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

   107         touch-display (view-touch)]

   108     (dorun (repeatedly 5 #(touch-display data)))))

   109 

   110 (defn learn-touch-regions []

   111   (let [experiences (atom [])

   112         world (apply-map

   113                worm-world

   114                (assoc (worm-segment-defaults)

   115                  :experiences experiences))]

   116     (run-world world)

   117     (->>

   118      @experiences

   119      (drop 175)

   120      ;; access the single segment's touch data

   121      (map (comp first :touch))

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

   123      (filter pure-touch?)

   124      ;; associate coordinates with touch values

   125      (map (partial apply zipmap))

   126      ;; select those regions where contact is being made

   127      (map (partial group-by second))

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

   129      (map (partial map first))

   130      ;; remove redundant/subset regions

   131      (map set)

   132      remove-similar)))

   133 

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

   135   (map view-touch-region

   136        (learn-touch-regions)))

   137 

   138
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 21 Mar 2014 20:56:56 -0400
parents	cc9957241076
children	5205535237fb