Mercurial > cortex

annotate org/worm_learn.clj @ 405:9b4a4da08b78

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
worming on stream predicates.
author Robert McIntyre <rlm@mit.edu>
date Mon, 17 Mar 2014 20:52:16 -0400
parents 939bcc5950b2
children 40b67bb71430
rev   line source
rlm@394 1 (ns org.aurellem.worm-learn
rlm@394 2 "General worm creation framework."
rlm@394 3 {:author "Robert McIntyre"}
rlm@394 4 (:use (cortex world util import body sense
rlm@394 5 hearing touch vision proprioception movement))
rlm@394 6 (:import (com.jme3.math ColorRGBA Vector3f))
rlm@394 7 (:import java.io.File)
rlm@394 8 (:import com.jme3.audio.AudioNode)
rlm@397 9 (:import com.aurellem.capture.RatchetTimer)
rlm@397 10 (:import (com.aurellem.capture Capture IsoTimer))
rlm@397 11 (:import (com.jme3.math Vector3f ColorRGBA)))
rlm@397 12
rlm@394 13
rlm@394 14 (dorun (cortex.import/mega-import-jme3))
rlm@394 15 (rlm.rlm-commands/help)
rlm@394 16
rlm@400 17 (load-bullet)
rlm@394 18
rlm@399 19 (def hand "Models/test-creature/hand.blend")
rlm@394 20
rlm@399 21 (defn worm-model []
rlm@399 22 (load-blender-model "Models/worm/worm.blend"))
rlm@394 23
rlm@400 24 (def output-base (File. "/home/r/proj/cortex/render/worm-learn/curl"))
rlm@394 25
rlm@397 26
rlm@399 27 (defn motor-control-program
rlm@399 28 "Create a function which will execute the motor script"
rlm@399 29 [muscle-positions
rlm@399 30 script]
rlm@399 31 (let [current-frame (atom -1)
rlm@399 32 keyed-script (group-by first script)
rlm@399 33 current-forces (atom {}) ]
rlm@399 34 (fn [effectors]
rlm@399 35 (let [indexed-effectors (vec effectors)]
rlm@399 36 (dorun
rlm@399 37 (for [[_ part force] (keyed-script (swap! current-frame inc))]
rlm@399 38 (swap! current-forces (fn [m] (assoc m part force)))))
rlm@399 39 (doall (map (fn [effector power]
rlm@399 40 (effector (int power)))
rlm@399 41 effectors
rlm@399 42 (map #(@current-forces % 0) muscle-positions)))))))
rlm@397 43
rlm@404 44 (defn worm-direct-control
rlm@404 45 "Create keybindings and a muscle control program that will enable
rlm@404 46 the user to control the worm via the keyboard."
rlm@404 47 [muscle-labels activation-strength]
rlm@404 48 (let [strengths (mapv (fn [_] (atom 0)) muscle-labels)
rlm@404 49 activator
rlm@404 50 (fn [n]
rlm@404 51 (fn [world pressed?]
rlm@404 52 (let [strength (if pressed? activation-strength 0)]
rlm@404 53 (swap! (nth strengths n) (constantly strength)))))
rlm@404 54 activators
rlm@404 55 (map activator (range (count muscle-labels)))
rlm@404 56 worm-keys
rlm@404 57 ["key-f" "key-r"
rlm@404 58 "key-g" "key-t"
rlm@404 59 "key-y" "key-h"
rlm@404 60 "key-j" "key-u"
rlm@404 61 "key-i" "key-k"
rlm@404 62 "key-o" "key-l"]]
rlm@404 63 {:motor-control
rlm@404 64 (fn [effectors]
rlm@404 65 (doall
rlm@404 66 (map (fn [strength effector]
rlm@404 67 (effector (deref strength)))
rlm@404 68 strengths effectors)))
rlm@404 69 :keybindings
rlm@404 70 ;; assume muscles are listed in pairs and map them to keys.
rlm@404 71 (zipmap worm-keys activators)}))
rlm@400 72
rlm@400 73 ;; These are scripts that direct the worm to move in two radically
rlm@400 74 ;; different patterns -- a sinusoidal wiggling motion, and a curling
rlm@400 75 ;; motions that causes the worm to form a circle.
rlm@400 76
rlm@400 77 (def curl-script
rlm@400 78 [[370 :d-up 40]
rlm@400 79 [600 :d-up 0]])
rlm@400 80
rlm@400 81 (def period 18)
rlm@400 82
rlm@404 83 (def worm-muscle-labels
rlm@399 84 [:base-up :base-down
rlm@404 85 :a-down :a-up
rlm@399 86 :b-up :b-down
rlm@404 87 :c-down :c-up
rlm@400 88 :d-up :d-down])
rlm@399 89
rlm@399 90 (defn gen-wiggle [[flexor extensor :as muscle-pair] time-base]
rlm@399 91 (let [period period
rlm@399 92 power 45]
rlm@399 93 [[time-base flexor power]
rlm@399 94 [(+ time-base period) flexor 0]
rlm@399 95 [(+ time-base period 1) extensor power]
rlm@399 96 [(+ time-base (+ (* 2 period) 2)) extensor 0]]))
rlm@399 97
rlm@399 98 (def wiggle-script
rlm@399 99 (mapcat gen-wiggle (repeat 40 [:a-down :a-up])
rlm@399 100 (range 100 10000 (+ 3 (* period 2)))))
rlm@399 101
rlm@399 102
rlm@400 103 ;; Normally, we'd use unsupervised/supervised machine learning to pick
rlm@400 104 ;; out the defining features of the different actions available to the
rlm@400 105 ;; worm. For this project, I am going to explicitely define functions
rlm@400 106 ;; that recognize curling and wiggling respectively. These functions
rlm@400 107 ;; are defined using all the information available from an embodied
rlm@400 108 ;; simulation of the action. Note how much easier they are to define
rlm@400 109 ;; than if I only had vision to work with. Things like scale/position
rlm@400 110 ;; invariance are complete non-issues here. This is the advantage of
rlm@400 111 ;; body-centered action recognition and what I hope to show with this
rlm@400 112 ;; thesis.
rlm@400 113
rlm@405 114
rlm@405 115 (defn straight?
rlm@405 116 "Is the worm straight?"
rlm@405 117 [experiences]
rlm@405 118 (every?
rlm@405 119 (fn [[_ _ bend]]
rlm@405 120 (< (Math/sin bend) 0.05))
rlm@405 121 (:proprioception (peek experiences))))
rlm@405 122
rlm@405 123 (defn curled?
rlm@405 124 "Is the worm curled up?"
rlm@405 125 [experiences]
rlm@405 126 (every?
rlm@405 127 (fn [[_ _ bend]]
rlm@405 128 (> (Math/sin bend) 0.64))
rlm@405 129 (:proprioception (peek experiences))))
rlm@405 130
rlm@405 131 (defn grand-circle?
rlm@405 132 "Does the worm form a majestic circle (one end touching the other)?"
rlm@405 133 [experiences]
rlm@405 134 (and (curled? experiences)
rlm@405 135 true))
rlm@405 136
rlm@405 137 (defn vector:last-n [v n]
rlm@405 138 (let [c (count v)]
rlm@405 139 (if (< c n) v
rlm@405 140 (subvec v (- c n) c))))
rlm@400 141
rlm@400 142 (defn wiggling?
rlm@405 143 "Is the worm wiggling?"
rlm@405 144 [experiences]
rlm@405 145 (vector:last-n
rlm@405 146
rlm@400 147
rlm@400 148 ))
rlm@400 149
rlm@405 150
rlm@405 151
rlm@405 152
rlm@400 153
rlm@400 154 (defn resting?
rlm@400 155 "Is the worm on the ground in a neutral position?"
rlm@400 156 [])
rlm@400 157
rlm@400 158 (def standard-world-view
rlm@400 159 [(Vector3f. 4.207176, -3.7366982, 3.0816958)
rlm@400 160 (Quaternion. 0.11118768, 0.87678415, 0.24434438, -0.3989771)])
rlm@400 161
rlm@400 162 (def worm-side-view
rlm@400 163 [(Vector3f. 4.207176, -3.7366982, 3.0816958)
rlm@400 164 (Quaternion. -0.11555642, 0.88188726, -0.2854942, -0.3569518)])
rlm@400 165
rlm@400 166 (def degenerate-worm-view
rlm@400 167 [(Vector3f. -0.0708936, -8.570261, 2.6487997)
rlm@400 168 (Quaternion. -2.318909E-4, 0.9985348, 0.053941682, 0.004291452)])
rlm@399 169
rlm@404 170 (defn worm-world-defaults []
rlm@404 171 (let [direct-control (worm-direct-control worm-muscle-labels 40)]
rlm@404 172 {:view worm-side-view
rlm@404 173 :motor-control (:motor-control direct-control)
rlm@404 174 :keybindings (:keybindings direct-control)
rlm@405 175 :record nil
rlm@405 176 :experiences nil}))
rlm@404 177
rlm@404 178 (defn dir! [file]
rlm@404 179 (if (not (.exists file))
rlm@404 180 (.mkdir file))
rlm@404 181 file)
rlm@405 182
rlm@405 183 (defn record-experience! [experiences data]
rlm@405 184 (swap! experiences #(conj % data)))
rlm@405 185
rlm@399 186 (defn worm-world
rlm@405 187 [& {:keys [record motor-control keybindings view experiences] :as settings}]
rlm@404 188 (let [{:keys [record motor-control keybindings view]}
rlm@404 189 (merge (worm-world-defaults) settings)
rlm@404 190 worm (doto (worm-model) (body!))
rlm@404 191 touch (touch! worm)
rlm@404 192 prop (proprioception! worm)
rlm@404 193 muscles (movement! worm)
rlm@404 194
rlm@404 195 touch-display (view-touch)
rlm@404 196 prop-display (view-proprioception)
rlm@404 197 muscle-display (view-movement)
rlm@404 198
rlm@404 199 floor (box 10 1 10 :position (Vector3f. 0 -10 0)
rlm@404 200 :color ColorRGBA/Gray :mass 0)]
rlm@399 201
rlm@404 202 (world
rlm@404 203 (nodify [worm floor])
rlm@404 204 (merge standard-debug-controls keybindings)
rlm@404 205 (fn [world]
rlm@404 206 (position-camera world view)
rlm@404 207 (let [timer (IsoTimer. 60)]
rlm@404 208 (.setTimer world timer)
rlm@404 209 (display-dilated-time world timer))
rlm@404 210 (if record
rlm@404 211 (Capture/captureVideo
rlm@404 212 world
rlm@404 213 (dir! (File. record "main-view"))))
rlm@404 214 (speed-up world)
rlm@404 215 (light-up-everything world))
rlm@404 216 (fn [world tpf]
rlm@405 217 (let [muscle-data (motor-control muscles)
rlm@405 218 proprioception-data (prop)
rlm@405 219 touch-data (map #(% (.getRootNode world)) touch)]
rlm@405 220 (when experiences
rlm@405 221 (record-experience!
rlm@405 222 experiences {:touch touch-data
rlm@405 223 :proprioception proprioception-data
rlm@405 224 :muscle muscle-data})
rlm@405 225 (if (curled? @experiences) (println "Curled"))
rlm@405 226 (if (straight? @experiences) (println "Straight"))
rlm@405 227 )
rlm@404 228 (muscle-display
rlm@405 229 muscle-data
rlm@405 230 (if record (dir! (File. record "muscle"))))
rlm@405 231 (prop-display
rlm@405 232 proprioception-data
rlm@405 233 (if record (dir! (File. record "proprio"))))
rlm@405 234 (touch-display
rlm@405 235 touch-data
rlm@405 236 (if record (dir! (File. record "touch")))))))))