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             :experience-watch nil

    66             :motor-control

    67             (motor-control-program

    68              worm-single-segment-muscle-labels

    69              (touch-kinesthetics))

    70             :end-frame 1200})))

    71 

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

    73 

    74 (defn pure-touch?

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

    76    sensors is either all on or all off."

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

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

    79 

    80 (defn remove-similar

    81   [coll]

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

    83     (if (empty? coll) result

    84         (let  [[x & xs] 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 (def all-touch-coordinates

    95   (concat

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

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

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

    99 

   100 (defn view-touch-region [coords]

   101   (let [touched-region

   102         (reduce

   103          (fn [m k]

   104            (assoc m k [0.0 0.1]))

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

   106         data

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

   108         touch-display (view-touch)]

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

   110 

   111 (defn learn-touch-regions []

   112   (let [experiences (atom [])

   113         world (apply-map

   114                worm-world

   115                (assoc (worm-segment-defaults)

   116                  :experiences experiences))]

   117     (run-world world)

   118     (->>

   119      @experiences

   120      (drop 175)

   121      ;; access the single segment's touch data

   122      (map (comp first :touch))

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

   124      (filter pure-touch?)

   125      ;; associate coordinates with touch values

   126      (map (partial apply zipmap))

   127      ;; select those regions where contact is being made

   128      (map (partial group-by second))

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

   130      (map (partial map first))

   131      ;; remove redundant/subset regions

   132      (map set)

   133      remove-similar)))

   134 

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

   136   (map view-touch-region

   137        (learn-touch-regions)))

   138 

   139
author	Robert McIntyre <rlm@mit.edu>
date	Wed, 26 Mar 2014 20:38:17 -0400
parents	5205535237fb
children	f339e3d5cc8c