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@408
|
5 hearing touch vision proprioception movement
|
rlm@408
|
6 test))
|
rlm@394
|
7 (:import (com.jme3.math ColorRGBA Vector3f))
|
rlm@394
|
8 (:import java.io.File)
|
rlm@394
|
9 (:import com.jme3.audio.AudioNode)
|
rlm@397
|
10 (:import com.aurellem.capture.RatchetTimer)
|
rlm@397
|
11 (:import (com.aurellem.capture Capture IsoTimer))
|
rlm@397
|
12 (:import (com.jme3.math Vector3f ColorRGBA)))
|
rlm@406
|
13
|
rlm@413
|
14 (import org.apache.commons.math3.transform.TransformType)
|
rlm@413
|
15 (import org.apache.commons.math3.transform.FastFourierTransformer)
|
rlm@413
|
16 (import org.apache.commons.math3.transform.DftNormalization)
|
rlm@413
|
17
|
rlm@406
|
18 (use 'clojure.pprint)
|
rlm@408
|
19 (use 'clojure.set)
|
rlm@394
|
20 (dorun (cortex.import/mega-import-jme3))
|
rlm@394
|
21 (rlm.rlm-commands/help)
|
rlm@394
|
22
|
rlm@400
|
23 (load-bullet)
|
rlm@394
|
24
|
rlm@399
|
25 (def hand "Models/test-creature/hand.blend")
|
rlm@394
|
26
|
rlm@399
|
27 (defn worm-model []
|
rlm@399
|
28 (load-blender-model "Models/worm/worm.blend"))
|
rlm@394
|
29
|
rlm@449
|
30 (defn worm []
|
rlm@449
|
31 (let [model (load-blender-model "Models/worm/worm.blend")]
|
rlm@449
|
32 {:body (doto model (body!))
|
rlm@449
|
33 :touch (touch! model)
|
rlm@449
|
34 :proprioception (proprioception! model)
|
rlm@449
|
35 :muscles (movement! model)}))
|
rlm@449
|
36
|
rlm@400
|
37 (def output-base (File. "/home/r/proj/cortex/render/worm-learn/curl"))
|
rlm@394
|
38
|
rlm@397
|
39
|
rlm@399
|
40 (defn motor-control-program
|
rlm@399
|
41 "Create a function which will execute the motor script"
|
rlm@406
|
42 [muscle-labels
|
rlm@399
|
43 script]
|
rlm@399
|
44 (let [current-frame (atom -1)
|
rlm@399
|
45 keyed-script (group-by first script)
|
rlm@399
|
46 current-forces (atom {}) ]
|
rlm@399
|
47 (fn [effectors]
|
rlm@399
|
48 (let [indexed-effectors (vec effectors)]
|
rlm@399
|
49 (dorun
|
rlm@399
|
50 (for [[_ part force] (keyed-script (swap! current-frame inc))]
|
rlm@399
|
51 (swap! current-forces (fn [m] (assoc m part force)))))
|
rlm@399
|
52 (doall (map (fn [effector power]
|
rlm@399
|
53 (effector (int power)))
|
rlm@399
|
54 effectors
|
rlm@406
|
55 (map #(@current-forces % 0) muscle-labels)))))))
|
rlm@397
|
56
|
rlm@404
|
57 (defn worm-direct-control
|
rlm@404
|
58 "Create keybindings and a muscle control program that will enable
|
rlm@404
|
59 the user to control the worm via the keyboard."
|
rlm@404
|
60 [muscle-labels activation-strength]
|
rlm@404
|
61 (let [strengths (mapv (fn [_] (atom 0)) muscle-labels)
|
rlm@404
|
62 activator
|
rlm@404
|
63 (fn [n]
|
rlm@404
|
64 (fn [world pressed?]
|
rlm@404
|
65 (let [strength (if pressed? activation-strength 0)]
|
rlm@404
|
66 (swap! (nth strengths n) (constantly strength)))))
|
rlm@404
|
67 activators
|
rlm@404
|
68 (map activator (range (count muscle-labels)))
|
rlm@404
|
69 worm-keys
|
rlm@404
|
70 ["key-f" "key-r"
|
rlm@404
|
71 "key-g" "key-t"
|
rlm@413
|
72 "key-h" "key-y"
|
rlm@404
|
73 "key-j" "key-u"
|
rlm@413
|
74 "key-k" "key-i"
|
rlm@413
|
75 "key-l" "key-o"]]
|
rlm@404
|
76 {:motor-control
|
rlm@404
|
77 (fn [effectors]
|
rlm@404
|
78 (doall
|
rlm@404
|
79 (map (fn [strength effector]
|
rlm@404
|
80 (effector (deref strength)))
|
rlm@404
|
81 strengths effectors)))
|
rlm@404
|
82 :keybindings
|
rlm@404
|
83 ;; assume muscles are listed in pairs and map them to keys.
|
rlm@404
|
84 (zipmap worm-keys activators)}))
|
rlm@400
|
85
|
rlm@400
|
86 ;; These are scripts that direct the worm to move in two radically
|
rlm@400
|
87 ;; different patterns -- a sinusoidal wiggling motion, and a curling
|
rlm@400
|
88 ;; motions that causes the worm to form a circle.
|
rlm@400
|
89
|
rlm@400
|
90 (def curl-script
|
rlm@415
|
91 [[150 :d-flex 40]
|
rlm@415
|
92 [250 :d-flex 0]])
|
rlm@400
|
93
|
rlm@400
|
94 (def period 18)
|
rlm@400
|
95
|
rlm@404
|
96 (def worm-muscle-labels
|
rlm@414
|
97 [:base-ex :base-flex
|
rlm@414
|
98 :a-ex :a-flex
|
rlm@414
|
99 :b-ex :b-flex
|
rlm@414
|
100 :c-ex :c-flex
|
rlm@414
|
101 :d-ex :d-flex])
|
rlm@399
|
102
|
rlm@399
|
103 (defn gen-wiggle [[flexor extensor :as muscle-pair] time-base]
|
rlm@399
|
104 (let [period period
|
rlm@399
|
105 power 45]
|
rlm@399
|
106 [[time-base flexor power]
|
rlm@399
|
107 [(+ time-base period) flexor 0]
|
rlm@399
|
108 [(+ time-base period 1) extensor power]
|
rlm@399
|
109 [(+ time-base (+ (* 2 period) 2)) extensor 0]]))
|
rlm@399
|
110
|
rlm@399
|
111 (def wiggle-script
|
rlm@414
|
112 (mapcat gen-wiggle (repeat 4000 [:a-ex :a-flex])
|
rlm@406
|
113 (range 100 1000000 (+ 3 (* period 2)))))
|
rlm@399
|
114
|
rlm@399
|
115
|
rlm@415
|
116 (defn shift-script [shift script]
|
rlm@415
|
117 (map (fn [[time label power]] [(+ time shift) label power])
|
rlm@415
|
118 script))
|
rlm@415
|
119
|
rlm@415
|
120 (def do-all-the-things
|
rlm@415
|
121 (concat
|
rlm@415
|
122 curl-script
|
rlm@415
|
123 [[300 :d-ex 40]
|
rlm@415
|
124 [320 :d-ex 0]]
|
rlm@415
|
125 (shift-script 280 (take 16 wiggle-script))))
|
rlm@415
|
126
|
rlm@400
|
127 ;; Normally, we'd use unsupervised/supervised machine learning to pick
|
rlm@400
|
128 ;; out the defining features of the different actions available to the
|
rlm@400
|
129 ;; worm. For this project, I am going to explicitely define functions
|
rlm@400
|
130 ;; that recognize curling and wiggling respectively. These functions
|
rlm@400
|
131 ;; are defined using all the information available from an embodied
|
rlm@400
|
132 ;; simulation of the action. Note how much easier they are to define
|
rlm@400
|
133 ;; than if I only had vision to work with. Things like scale/position
|
rlm@400
|
134 ;; invariance are complete non-issues here. This is the advantage of
|
rlm@400
|
135 ;; body-centered action recognition and what I hope to show with this
|
rlm@400
|
136 ;; thesis.
|
rlm@400
|
137
|
rlm@405
|
138
|
rlm@415
|
139 ;; curled? relies on proprioception, resting? relies on touch,
|
rlm@415
|
140 ;; wiggling? relies on a fourier analysis of muscle contraction, and
|
rlm@415
|
141 ;; grand-circle? relies on touch and reuses curled? as a gaurd.
|
rlm@405
|
142
|
rlm@405
|
143 (defn curled?
|
rlm@405
|
144 "Is the worm curled up?"
|
rlm@405
|
145 [experiences]
|
rlm@405
|
146 (every?
|
rlm@405
|
147 (fn [[_ _ bend]]
|
rlm@405
|
148 (> (Math/sin bend) 0.64))
|
rlm@405
|
149 (:proprioception (peek experiences))))
|
rlm@405
|
150
|
rlm@411
|
151 (defn rect-region [[x0 y0] [x1 y1]]
|
rlm@411
|
152 (vec
|
rlm@411
|
153 (for [x (range x0 (inc x1))
|
rlm@411
|
154 y (range y0 (inc y1))]
|
rlm@411
|
155 [x y])))
|
rlm@407
|
156
|
rlm@415
|
157 (def worm-segment-bottom (rect-region [8 15] [14 22]))
|
rlm@407
|
158
|
rlm@411
|
159 (defn contact
|
rlm@411
|
160 "Determine how much contact a particular worm segment has with
|
rlm@411
|
161 other objects. Returns a value between 0 and 1, where 1 is full
|
rlm@411
|
162 contact and 0 is no contact."
|
rlm@415
|
163 [touch-region [coords contact :as touch]]
|
rlm@411
|
164 (-> (zipmap coords contact)
|
rlm@415
|
165 (select-keys touch-region)
|
rlm@411
|
166 (vals)
|
rlm@411
|
167 (#(map first %))
|
rlm@411
|
168 (average)
|
rlm@411
|
169 (* 10)
|
rlm@411
|
170 (- 1)
|
rlm@411
|
171 (Math/abs)))
|
rlm@406
|
172
|
rlm@415
|
173 (defn resting?
|
rlm@443
|
174 "Is the worm resting on the ground?"
|
rlm@415
|
175 [experiences]
|
rlm@415
|
176 (every?
|
rlm@415
|
177 (fn [touch-data]
|
rlm@415
|
178 (< 0.9 (contact worm-segment-bottom touch-data)))
|
rlm@415
|
179 (:touch (peek experiences))))
|
rlm@415
|
180
|
rlm@415
|
181 (defn vector:last-n [v n]
|
rlm@415
|
182 (let [c (count v)]
|
rlm@415
|
183 (if (< c n) v
|
rlm@415
|
184 (subvec v (- c n) c))))
|
rlm@415
|
185
|
rlm@413
|
186 (defn fft [nums]
|
rlm@414
|
187 (map
|
rlm@414
|
188 #(.getReal %)
|
rlm@414
|
189 (.transform
|
rlm@414
|
190 (FastFourierTransformer. DftNormalization/STANDARD)
|
rlm@414
|
191 (double-array nums) TransformType/FORWARD)))
|
rlm@413
|
192
|
rlm@413
|
193 (def indexed (partial map-indexed vector))
|
rlm@413
|
194
|
rlm@414
|
195 (defn max-indexed [s]
|
rlm@414
|
196 (first (sort-by (comp - second) (indexed s))))
|
rlm@414
|
197
|
rlm@400
|
198 (defn wiggling?
|
rlm@405
|
199 "Is the worm wiggling?"
|
rlm@405
|
200 [experiences]
|
rlm@414
|
201 (let [analysis-interval 0x40]
|
rlm@414
|
202 (when (> (count experiences) analysis-interval)
|
rlm@414
|
203 (let [a-flex 3
|
rlm@414
|
204 a-ex 2
|
rlm@414
|
205 muscle-activity
|
rlm@414
|
206 (map :muscle (vector:last-n experiences analysis-interval))
|
rlm@414
|
207 base-activity
|
rlm@414
|
208 (map #(- (% a-flex) (% a-ex)) muscle-activity)]
|
rlm@414
|
209 (= 2
|
rlm@414
|
210 (first
|
rlm@415
|
211 (max-indexed
|
rlm@415
|
212 (map #(Math/abs %)
|
rlm@415
|
213 (take 20 (fft base-activity))))))))))
|
rlm@414
|
214
|
rlm@415
|
215 (def worm-segment-bottom-tip (rect-region [15 15] [22 22]))
|
rlm@414
|
216
|
rlm@415
|
217 (def worm-segment-top-tip (rect-region [0 15] [7 22]))
|
rlm@414
|
218
|
rlm@415
|
219 (defn grand-circle?
|
rlm@415
|
220 "Does the worm form a majestic circle (one end touching the other)?"
|
rlm@415
|
221 [experiences]
|
rlm@420
|
222 (and (curled? experiences)
|
rlm@415
|
223 (let [worm-touch (:touch (peek experiences))
|
rlm@415
|
224 tail-touch (worm-touch 0)
|
rlm@415
|
225 head-touch (worm-touch 4)]
|
rlm@415
|
226 (and (< 0.55 (contact worm-segment-bottom-tip tail-touch))
|
rlm@415
|
227 (< 0.55 (contact worm-segment-top-tip head-touch))))))
|
rlm@400
|
228
|
rlm@418
|
229
|
rlm@449
|
230 (declare phi-space phi-scan debug-experience)
|
rlm@418
|
231
|
rlm@418
|
232
|
rlm@418
|
233
|
rlm@400
|
234 (def standard-world-view
|
rlm@400
|
235 [(Vector3f. 4.207176, -3.7366982, 3.0816958)
|
rlm@400
|
236 (Quaternion. 0.11118768, 0.87678415, 0.24434438, -0.3989771)])
|
rlm@400
|
237
|
rlm@400
|
238 (def worm-side-view
|
rlm@400
|
239 [(Vector3f. 4.207176, -3.7366982, 3.0816958)
|
rlm@400
|
240 (Quaternion. -0.11555642, 0.88188726, -0.2854942, -0.3569518)])
|
rlm@400
|
241
|
rlm@400
|
242 (def degenerate-worm-view
|
rlm@400
|
243 [(Vector3f. -0.0708936, -8.570261, 2.6487997)
|
rlm@400
|
244 (Quaternion. -2.318909E-4, 0.9985348, 0.053941682, 0.004291452)])
|
rlm@399
|
245
|
rlm@404
|
246 (defn worm-world-defaults []
|
rlm@404
|
247 (let [direct-control (worm-direct-control worm-muscle-labels 40)]
|
rlm@430
|
248 (merge direct-control
|
rlm@430
|
249 {:view worm-side-view
|
rlm@430
|
250 :record nil
|
rlm@430
|
251 :experiences (atom [])
|
rlm@430
|
252 :experience-watch debug-experience
|
rlm@430
|
253 :worm-model worm-model
|
rlm@430
|
254 :end-frame nil})))
|
rlm@407
|
255
|
rlm@404
|
256 (defn dir! [file]
|
rlm@410
|
257 (if-not (.exists file)
|
rlm@404
|
258 (.mkdir file))
|
rlm@404
|
259 file)
|
rlm@405
|
260
|
rlm@405
|
261 (defn record-experience! [experiences data]
|
rlm@405
|
262 (swap! experiences #(conj % data)))
|
rlm@405
|
263
|
rlm@444
|
264 (defn enable-shadows [world]
|
rlm@444
|
265 (let [bsr (doto
|
rlm@444
|
266 (BasicShadowRenderer. (asset-manager) 512)
|
rlm@444
|
267 (.setDirection (.normalizeLocal (Vector3f. 1 -1 -1))))]
|
rlm@444
|
268 (.addProcessor (.getViewPort world) bsr)))
|
rlm@443
|
269
|
rlm@444
|
270 (defn enable-good-shadows [world]
|
rlm@444
|
271 (let [pssm
|
rlm@444
|
272 (doto (PssmShadowRenderer. (asset-manager) 1024 3)
|
rlm@444
|
273 (.setDirection (.normalizeLocal (Vector3f. -1 -3 -1)))
|
rlm@444
|
274 (.setLambda (float 0.55))
|
rlm@444
|
275 (.setShadowIntensity (float 0.6))
|
rlm@444
|
276 (.setCompareMode PssmShadowRenderer$CompareMode/Software)
|
rlm@444
|
277 (.setFilterMode PssmShadowRenderer$FilterMode/Bilinear))]
|
rlm@444
|
278 (.addProcessor (.getViewPort world) pssm)))
|
rlm@444
|
279
|
rlm@449
|
280 (defn debug-experience
|
rlm@449
|
281 [experiences text]
|
rlm@449
|
282 (cond
|
rlm@449
|
283 (grand-circle? experiences) (.setText text "Grand Circle")
|
rlm@449
|
284 (curled? experiences) (.setText text "Curled")
|
rlm@449
|
285 (wiggling? experiences) (.setText text "Wiggling")
|
rlm@449
|
286 (resting? experiences) (.setText text "Resting")))
|
rlm@443
|
287
|
rlm@445
|
288
|
rlm@399
|
289 (defn worm-world
|
rlm@407
|
290 [& {:keys [record motor-control keybindings view experiences
|
rlm@418
|
291 worm-model end-frame experience-watch] :as settings}]
|
rlm@407
|
292 (let [{:keys [record motor-control keybindings view experiences
|
rlm@418
|
293 worm-model end-frame experience-watch]}
|
rlm@404
|
294 (merge (worm-world-defaults) settings)
|
rlm@449
|
295
|
rlm@404
|
296 touch-display (view-touch)
|
rlm@404
|
297 prop-display (view-proprioception)
|
rlm@404
|
298 muscle-display (view-movement)
|
rlm@449
|
299 {:keys [proprioception touch muscles body]} (worm)
|
rlm@404
|
300
|
rlm@444
|
301 floor
|
rlm@444
|
302 (box 5 1 5 :position (Vector3f. 0 -10 0)
|
rlm@444
|
303 :mass 0
|
rlm@444
|
304 :texture "Textures/aurellem.png"
|
rlm@444
|
305 :material "Common/MatDefs/Misc/Unshaded.j3md")
|
rlm@445
|
306 timer (IsoTimer. 60)
|
rlm@445
|
307
|
rlm@445
|
308 font (.loadFont (asset-manager) "Interface/Fonts/Console.fnt")
|
rlm@445
|
309 worm-action (doto (BitmapText. font false)
|
rlm@445
|
310 (.setSize 35)
|
rlm@445
|
311 (.setColor (ColorRGBA/Black)))]
|
rlm@399
|
312
|
rlm@404
|
313 (world
|
rlm@449
|
314 (nodify [body floor])
|
rlm@404
|
315 (merge standard-debug-controls keybindings)
|
rlm@404
|
316 (fn [world]
|
rlm@445
|
317 (.setLocalTranslation
|
rlm@445
|
318 worm-action 20 470 0)
|
rlm@445
|
319 (.attachChild (.getGuiNode world) worm-action)
|
rlm@445
|
320
|
rlm@444
|
321 (enable-good-shadows world)
|
rlm@449
|
322 (.setShadowMode body RenderQueue$ShadowMode/CastAndReceive)
|
rlm@444
|
323 (.setShadowMode floor RenderQueue$ShadowMode/Receive)
|
rlm@444
|
324
|
rlm@444
|
325 (.setBackgroundColor (.getViewPort world) (ColorRGBA/White))
|
rlm@443
|
326 (.setDisplayStatView world false)
|
rlm@443
|
327 (.setDisplayFps world false)
|
rlm@404
|
328 (position-camera world view)
|
rlm@407
|
329 (.setTimer world timer)
|
rlm@449
|
330 ;;(display-dilated-time world timer)
|
rlm@430
|
331 (when record
|
rlm@445
|
332 (dir! record)
|
rlm@404
|
333 (Capture/captureVideo
|
rlm@404
|
334 world
|
rlm@404
|
335 (dir! (File. record "main-view"))))
|
rlm@404
|
336 (speed-up world)
|
rlm@444
|
337 ;;(light-up-everything world)
|
rlm@444
|
338 )
|
rlm@404
|
339 (fn [world tpf]
|
rlm@410
|
340 (if (and end-frame (> (.getTime timer) end-frame))
|
rlm@407
|
341 (.stop world))
|
rlm@414
|
342 (let [muscle-data (vec (motor-control muscles))
|
rlm@449
|
343 proprioception-data (proprioception)
|
rlm@415
|
344 touch-data (mapv #(% (.getRootNode world)) touch)]
|
rlm@405
|
345 (when experiences
|
rlm@405
|
346 (record-experience!
|
rlm@405
|
347 experiences {:touch touch-data
|
rlm@405
|
348 :proprioception proprioception-data
|
rlm@418
|
349 :muscle muscle-data}))
|
rlm@418
|
350 (when experience-watch
|
rlm@445
|
351 (experience-watch @experiences worm-action))
|
rlm@404
|
352 (muscle-display
|
rlm@405
|
353 muscle-data
|
rlm@430
|
354 (when record (dir! (File. record "muscle"))))
|
rlm@405
|
355 (prop-display
|
rlm@405
|
356 proprioception-data
|
rlm@430
|
357 (when record (dir! (File. record "proprio"))))
|
rlm@405
|
358 (touch-display
|
rlm@405
|
359 touch-data
|
rlm@430
|
360 (when record (dir! (File. record "touch")))))))))
|
rlm@407
|
361
|
rlm@407
|
362
|
rlm@407
|
363
|
rlm@416
|
364 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@416
|
365 ;;;;;;;; Phi-Space ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@416
|
366 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
rlm@416
|
367
|
rlm@416
|
368 (defn generate-phi-space []
|
rlm@416
|
369 (let [experiences (atom [])]
|
rlm@416
|
370 (run-world
|
rlm@416
|
371 (apply-map
|
rlm@416
|
372 worm-world
|
rlm@416
|
373 (merge
|
rlm@416
|
374 (worm-world-defaults)
|
rlm@416
|
375 {:end-frame 700
|
rlm@416
|
376 :motor-control
|
rlm@416
|
377 (motor-control-program worm-muscle-labels do-all-the-things)
|
rlm@416
|
378 :experiences experiences})))
|
rlm@416
|
379 @experiences))
|
rlm@416
|
380
|
rlm@416
|
381 (defn bin [digits]
|
rlm@416
|
382 (fn [angles]
|
rlm@416
|
383 (->> angles
|
rlm@416
|
384 (flatten)
|
rlm@416
|
385 (map (juxt #(Math/sin %) #(Math/cos %)))
|
rlm@416
|
386 (flatten)
|
rlm@416
|
387 (mapv #(Math/round (* % (Math/pow 10 (dec digits))))))))
|
rlm@416
|
388
|
rlm@418
|
389 ;; k-nearest neighbors with spatial binning. Only returns a result if
|
rlm@418
|
390 ;; the propriceptive data is within 10% of a previously recorded
|
rlm@418
|
391 ;; result in all dimensions.
|
rlm@416
|
392 (defn gen-phi-scan [phi-space]
|
rlm@416
|
393 (let [bin-keys (map bin [3 2 1])
|
rlm@416
|
394 bin-maps
|
rlm@417
|
395 (map (fn [bin-key]
|
rlm@417
|
396 (group-by
|
rlm@417
|
397 (comp bin-key :proprioception phi-space)
|
rlm@417
|
398 (range (count phi-space)))) bin-keys)
|
rlm@416
|
399 lookups (map (fn [bin-key bin-map]
|
rlm@416
|
400 (fn [proprio] (bin-map (bin-key proprio))))
|
rlm@416
|
401 bin-keys bin-maps)]
|
rlm@416
|
402 (fn lookup [proprio-data]
|
rlm@419
|
403 (set (some #(% proprio-data) lookups)))))
|
rlm@419
|
404
|
rlm@419
|
405
|
rlm@419
|
406 (defn longest-thread
|
rlm@419
|
407 "Find the longest thread from phi-index-sets. The index sets should
|
rlm@419
|
408 be ordered from most recent to least recent."
|
rlm@419
|
409 [phi-index-sets]
|
rlm@419
|
410 (loop [result '()
|
rlm@419
|
411 [thread-bases & remaining :as phi-index-sets] phi-index-sets]
|
rlm@419
|
412 (if (empty? phi-index-sets)
|
rlm@420
|
413 (vec result)
|
rlm@419
|
414 (let [threads
|
rlm@419
|
415 (for [thread-base thread-bases]
|
rlm@419
|
416 (loop [thread (list thread-base)
|
rlm@419
|
417 remaining remaining]
|
rlm@419
|
418 (let [next-index (dec (first thread))]
|
rlm@419
|
419 (cond (empty? remaining) thread
|
rlm@419
|
420 (contains? (first remaining) next-index)
|
rlm@419
|
421 (recur
|
rlm@419
|
422 (cons next-index thread) (rest remaining))
|
rlm@419
|
423 :else thread))))
|
rlm@419
|
424 longest-thread
|
rlm@419
|
425 (reduce (fn [thread-a thread-b]
|
rlm@419
|
426 (if (> (count thread-a) (count thread-b))
|
rlm@419
|
427 thread-a thread-b))
|
rlm@419
|
428 '(nil)
|
rlm@419
|
429 threads)]
|
rlm@419
|
430 (recur (concat longest-thread result)
|
rlm@419
|
431 (drop (count longest-thread) phi-index-sets))))))
|
rlm@419
|
432
|
rlm@416
|
433
|
rlm@416
|
434 (defn init []
|
rlm@416
|
435 (def phi-space (generate-phi-space))
|
rlm@416
|
436 (def phi-scan (gen-phi-scan phi-space))
|
rlm@416
|
437 )
|
rlm@418
|
438
|
rlm@430
|
439 ;; (defn infer-nils-dyl [s]
|
rlm@430
|
440 ;; (loop [closed ()
|
rlm@430
|
441 ;; open s
|
rlm@430
|
442 ;; anchor 0]
|
rlm@430
|
443 ;; (if-not (empty? open)
|
rlm@430
|
444 ;; (recur (conj closed
|
rlm@430
|
445 ;; (or (peek open)
|
rlm@430
|
446 ;; anchor))
|
rlm@430
|
447 ;; (pop open)
|
rlm@430
|
448 ;; (or (peek open) anchor))
|
rlm@430
|
449 ;; closed)))
|
rlm@430
|
450
|
rlm@430
|
451 ;; (defn infer-nils [s]
|
rlm@430
|
452 ;; (for [i (range (count s))]
|
rlm@430
|
453 ;; (or (get s i)
|
rlm@430
|
454 ;; (some (comp not nil?) (vector:last-n (- (count s) i)))
|
rlm@430
|
455 ;; 0)))
|
rlm@420
|
456
|
rlm@420
|
457
|
rlm@420
|
458 (defn infer-nils
|
rlm@420
|
459 "Replace nils with the next available non-nil element in the
|
rlm@420
|
460 sequence, or barring that, 0."
|
rlm@420
|
461 [s]
|
rlm@430
|
462 (loop [i (dec (count s))
|
rlm@430
|
463 v (transient s)]
|
rlm@430
|
464 (if (zero? i) (persistent! v)
|
rlm@430
|
465 (if-let [cur (v i)]
|
rlm@430
|
466 (if (get v (dec i) 0)
|
rlm@430
|
467 (recur (dec i) v)
|
rlm@430
|
468 (recur (dec i) (assoc! v (dec i) cur)))
|
rlm@430
|
469 (recur i (assoc! v i 0))))))
|
rlm@420
|
470
|
rlm@420
|
471 ;; tests
|
rlm@420
|
472
|
rlm@420
|
473 ;;(infer-nils [1 nil 1 1]) [1 1 1 1]
|
rlm@420
|
474 ;;(infer-nils [1 1 1 nil]) [1 1 1 0]
|
rlm@420
|
475 ;;(infer-nils [nil 2 1 1]) [2 2 1 1]
|
rlm@420
|
476
|
rlm@420
|
477
|
rlm@420
|
478 (defn debug-experience-phi []
|
rlm@420
|
479 (let [proprio (atom ())]
|
rlm@420
|
480 (fn
|
rlm@420
|
481 [experiences]
|
rlm@420
|
482 (let [phi-indices (phi-scan (:proprioception (peek experiences)))]
|
rlm@420
|
483 (swap! proprio (partial cons phi-indices))
|
rlm@420
|
484 (let [exp-thread (longest-thread (take 300 @proprio))
|
rlm@420
|
485 phi-loop (mapv phi-space (infer-nils exp-thread))]
|
rlm@420
|
486 (println-repl (vector:last-n exp-thread 22))
|
rlm@420
|
487 (cond
|
rlm@420
|
488 (grand-circle? phi-loop) (println "Grand Circle")
|
rlm@420
|
489 (curled? phi-loop) (println "Curled")
|
rlm@420
|
490 (wiggling? phi-loop) (println "Wiggling")
|
rlm@420
|
491 (resting? phi-loop) (println "Resting")
|
rlm@420
|
492 :else (println "Unknown")))))))
|
rlm@420
|
493
|
rlm@420
|
494
|
rlm@420
|
495 (defn init-interactive []
|
rlm@420
|
496 (def phi-space
|
rlm@420
|
497 (let [experiences (atom [])]
|
rlm@420
|
498 (run-world
|
rlm@420
|
499 (apply-map
|
rlm@420
|
500 worm-world
|
rlm@420
|
501 (merge
|
rlm@420
|
502 (worm-world-defaults)
|
rlm@420
|
503 {:experiences experiences})))
|
rlm@420
|
504 @experiences))
|
rlm@420
|
505 (def phi-scan (gen-phi-scan phi-space)))
|
rlm@420
|
506
|
rlm@420
|
507
|
rlm@420
|
508 (defn run-experiment-1 []
|
rlm@420
|
509 (.start (worm-world :experience-watch (debug-experience-phi)))) |