view org/worm_learn.clj @ 405:9b4a4da08b78

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