Mercurial > cortex
view org/self_organizing_touch.clj @ 485:ac953b562eab
completed first draft.
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 29 Mar 2014 16:22:49 -0400 |
parents | f339e3d5cc8c |
children | 01934317b25b |
line wrap: on
line source
1 (ns org.aurellem.self-organizing-touch2 "Using free play to automatically organize touch perception into regions."3 {:author "Robert McIntyre"}4 (:use (cortex world util import body sense5 hearing touch vision proprioception movement6 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)))15 (use 'org.aurellem.worm-learn)16 (dorun (cortex.import/mega-import-jme3))18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;19 ;; A demonstration of self organiging touch maps through experience. ;20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;22 (def single-worm-segment-view23 [(Vector3f. 2.0681207, -6.1406755, 1.6106138)24 (Quaternion. -0.15558705, 0.843615, -0.3428654, -0.38281822)])26 (def worm-single-segment-muscle-labels27 [:lift-1 :lift-2 :roll-1 :roll-2])29 (defn touch-kinesthetics []30 [[170 :lift-1 40]31 [190 :lift-1 19]32 [206 :lift-1 0]34 [400 :lift-2 40]35 [410 :lift-2 0]37 [570 :lift-2 40]38 [590 :lift-2 21]39 [606 :lift-2 0]41 [800 :lift-1 30]42 [809 :lift-1 0]44 [900 :roll-2 40]45 [905 :roll-2 20]46 [910 :roll-2 0]48 [1000 :roll-2 40]49 [1005 :roll-2 20]50 [1010 :roll-2 0]52 [1100 :roll-2 40]53 [1105 :roll-2 20]54 [1110 :roll-2 0]55 ])57 (defn single-worm-segment []58 (load-blender-model "Models/worm/worm-single-segment.blend"))60 (defn worm-segment []61 (let [model (single-worm-segment)]62 {:body (doto model (body!))63 :touch (touch! model)64 :proprioception (proprioception! model)65 :muscles (movement! model)}))68 (defn worm-segment-defaults []69 (let [direct-control (worm-direct-control worm-muscle-labels 40)]70 (merge (worm-world-defaults)71 {:worm worm-segment72 :view single-worm-segment-view73 :experience-watch nil74 :motor-control75 (motor-control-program76 worm-single-segment-muscle-labels77 (touch-kinesthetics))78 :end-frame 1200})))80 (def full-contact [(float 0.0) (float 0.1)])82 (defn pure-touch?83 "This is worm specific code to determine if a large region of touch84 sensors is either all on or all off."85 [[coords touch :as touch-data]]86 (= (set (map first touch)) (set full-contact)))88 (defn remove-similar89 [coll]90 (loop [result () coll (sort-by (comp - count) coll)]91 (if (empty? coll) result92 (let [[x & xs] coll93 c (count x)]94 (if (some95 (fn [other-set]96 (let [oc (count other-set)]97 (< (- (count (union other-set x)) c) (* oc 0.1))))98 xs)99 (recur result xs)100 (recur (cons x result) xs))))))102 (def all-touch-coordinates103 (concat104 (rect-region [0 15] [7 22])105 (rect-region [8 0] [14 29])106 (rect-region [15 15] [22 22])))108 (defn view-touch-region109 ([coords out]110 (let [touched-region111 (reduce112 (fn [m k]113 (assoc m k [0.0 0.1]))114 (zipmap all-touch-coordinates (repeat [0.1 0.1])) coords)115 data116 [[(vec (keys touched-region)) (vec (vals touched-region))]]117 touch-display (view-touch)]118 (touch-display data out)))119 ([coords] (view-touch-region nil)))122 (defn learn-touch-regions []123 (let [experiences (atom [])124 world (apply-map125 worm-world126 (assoc (worm-segment-defaults)127 :experiences experiences128 :record (File. "/home/r/proj/cortex/thesis/video/touch-learn-2/")))]129 (run-world world)130 (->>131 @experiences132 (drop 175)133 ;; access the single segment's touch data134 (map (comp first :touch))135 ;; only deal with "pure" touch data to determine surfaces136 (filter pure-touch?)137 ;; associate coordinates with touch values138 (map (partial apply zipmap))139 ;; select those regions where contact is being made140 (map (partial group-by second))141 (map #(get % full-contact))142 (map (partial map first))143 ;; remove redundant/subset regions144 (map set)145 remove-similar)))148 (def all-touch-coordinates149 (concat150 (rect-region [0 15] [7 22])151 (rect-region [8 0] [14 29])152 (rect-region [15 15] [22 22])))154 (defn view-touch-region [coords]155 (let [touched-region156 (reduce157 (fn [m k]158 (assoc m k [0.0 0.1]))159 (zipmap all-touch-coordinates (repeat [0.1 0.1])) coords)160 data161 [[(vec (keys touched-region)) (vec (vals touched-region))]]162 touch-display (view-touch)]163 (dorun (repeatedly 5 #(touch-display data)))))165 (defn learn-and-view-touch-regions []166 (map view-touch-region167 (learn-touch-regions)))