view src/clojureDemo/GenesisPlay.clj @ 21:e72220627685 tip

0.002 inch discrepancy with target. going to test anyway
author Robert McIntyre <rlm@mit.edu>
date Mon, 30 Aug 2010 01:19:21 -0400
parents 6d9bdaf919f7
children
line wrap: on
line source
1 (ns clojureDemo.GenesisPlay)
4 (use 'clojure.contrib.import-static)
5 (import '(java.io File))
6 (import '(org.apache.commons.io FileUtils))
7 (import '(javax.imageio ImageIO) )
8 (import '(javax.swing JFrame))
9 (import '(java.awt Color BorderLayout))
10 (import '(ij.plugin PlugIn))
11 (import '(ij ImagePlus IJ))
12 (import '(java.lang Math))
14 (use 'clojureDemo.appeture)
16 (import-static java.lang.Math pow abs)
18 (import '(ij Macro))
20 (import '(java.io BufferedReader InputStreamReader))
21 (import '(java.awt.image BufferedImage))
22 (import '(genesis Genesis))
23 (import '(utils Mark))
24 (import '(capenLow StoryProcessor))
25 (import '(connections Connections WiredBox))
26 (import '(specialBoxes BasicBox MultiFunctionBox))
27 (import '(http Start))
28 (import '(engineering NewHardWiredTranslator))
30 (import '(java.awt Polygon))
31 (import '(java.awt.geom Line2D$Double))
32 (use 'clojure.contrib.str-utils)
35 (use '[clojureDemo.Xuggle :only (video-seq trans-save flash display video-data)])
36 (use 'clojureDemo.MegaDeath)
39 (use 'clojure.contrib.combinatorics)
41 (use 'clojure.contrib.repl-utils)
42 (use ['clojureDemo.Defines
43 :only '(
44 lian look getto human0 blow base app0 app1 app2 app3 app4 app5
45 bounce0 bounce1 bounce2 bounce3 bounce4 bounce5 bounce6
46 collide0 collide1 collide2 collide3 collide4
47 give0 give1 give2 give3 give4 target default)])
50 ;(proxy
56 (defn startInFrame-rm
57 [genesis]
58 (.start genesis)
59 (let [frame (JFrame.)]
60 (doto frame
61 (.setTitle "Genesis")
62 (.setBounds 0 0 1024 768)
63 (doto (.getContentPane)
64 (.setBackground Color/WHITE)
65 (.setLayout (BorderLayout.))
66 (.add genesis))
67 (.setJMenuBar (.getMenuBar genesis))
68 (.setVisible true))
69 frame))
72 (defn run-genesis
73 ([] (startInFrame-rm (Genesis.)))
74 ([genesis] (startInFrame-rm genesis)))
76 (defn lazy->hashMap
77 [lazy]
78 (zipmap (map first lazy) (map last lazy)))
80 (defn make-box
81 "constructs a wired box sutiable for interfacing to Genesis"
82 [name process-fn]
83 (let [box (proxy [BasicBox] [] (getName [] name)
84 (process [obj] (.transmit (Connections/getPorts this) (process-fn obj))))]
85 (.addSignalProcessor (Connections/getPorts box) "process")
86 box))
89 (defn make-generator-box
90 "makes a box which only outputs a constant"
91 [name constant]
92 (let [box (proxy [BasicBox] [] (getName [] name) (process [obj] (.transmit (Connections/getPorts this) constant)))]
93 (.addSignalProcessor (Connections/getPorts box) "process")
94 box))
96 (defn naturals [] (iterate inc 0))
98 ;; ;(defn make-multifn-box [& args]
99 ;; ; (apply hash-map args)
101 ;; ; (map mega-macro naturals )
103 ;; ; )
108 (defmacro function-name
109 [function]
110 (list str (list 'quote function)))
112 (defn make-vision-box
113 "eventually I'll generalize this to arbitary functions and port names, but for now this is good enough"
114 [function1 function2]
115 (let [box (proxy [MultiFunctionBox] [] (getName [] "vision-box")
116 (process1 [obj] (.transmit (Connections/getPorts this) (function1 obj)))
117 (process2 [obj] (.transmit (Connections/getPorts this) (function2 obj))))]
118 (.addSignalProcessor (Connections/getPorts box) "PORT1" "process1")
119 (.addSignalProcessor (Connections/getPorts box) "PORT2" "process2")
120 box))
122 ;; (defn make-box
123 ;; [name & functions]
124 ;; (let [box (proxy [MultiFunctionBox] [] (getName [] name)
125 ;; (for [indexed-fun (clojure.contrib.seq-utils/indexed functions)]
126 ;; ((symbol (str "process" (first indexed-fun)))
127 ;; [obj] (.transmit (Connections/getPorts this) ((last indexed-fun) obj)))))]
129 ;; (for [indexed-fun (clojure.contrib.seq-utils/indexed functions)]
130 ;; (.addSignalProcessor (Connections/getPorts box) (str "PORT" (first indexed-fun)) (str "process" (first indexed-fun))))
131 ;; box))
133 ;; (defmacro proxy-functions
134 ;; [ name & functions]
135 ;; (into
136 ;; (for [indexed-fun (clojure.contrib.seq-utils/indexed functions)]
137 ;; (list (symbol (str "process" (first indexed-fun))) (vector 'obj)
138 ;; (list '.transmit '(Connections/getPorts this) (list (last indexed-fun) 'obj))))
139 ;; (list (list 'getName (vector) name) (vector) (vector MultiFunctionBox) 'proxy)))
143 ;; ((symbol (str "process" (first indexed-fun)))
144 ;; [obj] (.transmit (Connections/getPorts this) ((last indexed-fun) obj)))))
146 ;; (defmacro make-fun2-box
147 ;; [name & functions]
151 ;; (defmacro make-fun-box
152 ;; [name & functions]
153 ;; (let [proxy-functions
154 ;; (for [indexed-fun (clojure.contrib.seq-utils/indexed functions)]
155 ;; ((symbol (str "process" (first indexed-fun)))
156 ;; [`obj#] (.transmit (Connections/getPorts 'this) ((last indexed-fun) `obj#))))]
160 ;; `(let [box# (proxy [MultiFunctionBox] [] (getName [] ~name))]
161 ;; ~proxy-functions
162 ;; box#))
164 ;; (defmacro return
165 ;; [name & functions]
166 ;; (let [out (for [x functions]
167 ;; x)]
168 ;; out))
174 (defn local-genesis
175 "connects the custom vision interperter to genesis"
176 [function1 function2]
177 (let [vision-box (make-vision-box function1 function2) genesis (Genesis.) ]
178 (Connections/wire Start/TRIPLES (.getStartParser genesis) "PORT1" vision-box)
179 (Connections/wire NewHardWiredTranslator/RESULT (.getNewSemanticTranslator genesis) "PORT2" vision-box)
180 genesis))
187 (defn frame-hash
188 "yields a convienent representation for the pixles in an image.
189 Because of the size of the structvre generated, this must only be used
190 in a transient way so that java can do it's garbage collection."
191 [imagePlus]
192 (with-meta
193 (let [buf (.. imagePlus getBufferedImage)
194 color (.getColorModel buf)]
195 (doall (apply hash-map
196 (interleave
197 (doall (for [x (range (.getWidth imagePlus)) y (range (.getHeight imagePlus))]
198 (vector x y)))
199 (doall (for [x (range (.getWidth imagePlus)) y (range (.getHeight imagePlus))]
200 (let [data (.getRGB buf x y)]
201 (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
202 :g (bit-shift-right (bit-and 0x00ff00 data) 8)
203 :b (bit-and 0x0000ff data)))))))))
204 {:width (.getWidth imagePlus) :height (.getHeight imagePlus)}))
208 (defn vid-seq
209 [video]
210 (with-meta (doall (map frame-hash (video-seq video))) (video-data video)))
216 (defn video-hash
217 "turns an entire video into a nice hash-map
218 .... or at least it would, if java didn't suck and only give me
219 2 GB to work with with no way to increase it.
220 linear processing... grumble grumble ....."
221 [video-seq]
222 (apply hash-map
223 (interleave
224 (naturals)
225 (doall (map #(frame-hash %) video-seq)))))
230 (defn frame-hash->bufferedImage
231 [frame-hash]
232 (let [data (meta frame-hash)
233 image (BufferedImage. (:width data) (:height data) BufferedImage/TYPE_INT_BGR)]
235 (doall (for [element frame-hash]
236 (let [coord (key element)
237 rgb (val element)
238 packed-RGB
239 (+ (bit-shift-left (:r rgb) 16)
240 (bit-shift-left (:g rgb) 8)
241 (:b rgb))]
242 (.setRGB image (first coord) (last coord) packed-RGB))))
243 image))
245 (defmethod display
246 clojure.lang.PersistentHashMap [frame-hash]
247 (display (frame-hash->bufferedImage frame-hash)))
249 (defmethod display
250 clojure.lang.PersistentArrayMap [frame-hash]
251 (display (frame-hash->bufferedImage frame-hash)))
253 ;; (defmethod display
254 ;; clojure.lang.LazySeq [frame-hash]
255 ;; (display (frame-hash->bufferedImage frame-hash)))
261 (defn rectangle-window
262 "efficiently grabs a rectangle from the frame-hash.
263 Values that don't exisist in the picture are colored negative green!"
264 [x y l w frame-hash]
265 (let [coords (for [m (range (- x l) (+ 1 x l)) n (range (- y w) ( + 1 y w))] (vector m n))]
267 (with-meta
268 (zipmap
269 coords
270 (map #(frame-hash % {:r 0 :g -500 :b 0}) coords))
271 (meta frame-hash))))
274 (defn sum
275 "squashes all the dinensions of the picture together into a single dimension
276 sutiable for analysis."
277 [window]
278 (zipmap
279 (keys window)
280 (map (fn [rgb] (+ (:r rgb) (:b rgb) (:g rgb))) (vals window))))
282 (defn b&w
283 "turn everything grey"
284 [window]
285 (with-meta
286 (zipmap
287 (keys window)
288 (map (fn [rgb]
289 (let [sum (int (/ (+ (:r rgb) (:b rgb) (:g rgb)) 3))]
290 {:r sum :g sum :b sum })) (vals window))) (meta window)))
292 (defn green-select-x-form
293 "find green things"
294 [window]
295 (with-meta
296 (zipmap
297 (keys window)
298 (map (fn [rgb]
299 (if (and (> (:g rgb) (:b rgb)) (> (:g rgb) (:r rgb)))
300 rgb
301 {:r 0 :g 0 :b 0})) (vals window))) (meta window)))
304 (defn manual-line-detect
305 "Ty as I might, this can never be truly effective until higher level
306 processes contribute to dynamicaly adjusting these paramaters. For
307 now I'll settle with simple manual calibration."
308 [var1 mean1 var2 mean2]
309 (>
310 (if (or (< var1 250) (< var2 250))
311 (abs (int (- mean1 mean2)))
312 0) 55))
313 ;30 looks good
318 (defn frame-windows
319 "analyzes a frame in terms of lots of tiny windows which
320 each try to find some sort of edge."
321 ([ x-form frame]
322 (with-meta
323 (let [width (:width (meta frame) 500)
324 height(:height (meta frame) 500 )]
325 (filter (comp not nil?)
326 (for [x (range 0 width 2) y (range 0 height 2)]
327 (:line (window-line (rectangle-window x y 1 1 frame) (comp sum x-form) manual-line-detect))))) (meta frame)))
328 ([frame] (frame-windows identity frame)))
331 (defn static-segmentation
332 "divides a single picture frame into appropiate objects using a
333 simple watershed method based on sharp color variation.
334 radius: the general size of the window in pixels
335 gradient: threshold for a color gradient to be recognized as a edge"
336 [radius gradient frame]
337 (let [ah (frame-hash frame)]
338 ah))
341 (defn video-parse
342 "this is the equilivalent to the S.T.A.R.T Parser for videos
343 right now it's just a simple blob detector"
344 [video-seq]
346 )
350 (defn overlay-draw
351 [frame-hash overlay]
352 (let [image (frame-hash->bufferedImage frame-hash)
353 g2 (.getGraphics image)]
354 (doall (for [ x overlay]
355 (let [x1 (ffirst x) y1 (second (first x)) x2 (first (last x)) y2 (last (last x))]
356 (.drawLine g2 x1 y1 x2 y2))))
357 image))
361 (defn video-seq->b&w
362 [video-seq]
363 (with-meta
364 (map #(ImagePlus. "B and W" (frame-hash->bufferedImage %))
366 (map (fn [imgPlus]
367 (let [play (frame-hash imgPlus)]
368 (b&w play)))
369 video-seq))
370 (meta video-seq)))
374 (defn vid-save
375 [filename vid-seq]
376 (trans-save filename
377 (with-meta (map (comp #(ImagePlus. "reverse-x-form" %) frame-hash->bufferedImage) vid-seq) (meta vid-seq))))
381 ;(def g0 (video-seq give0))
382 (def gen (proxy [Genesis] [] ))
383 (def short-give (with-meta (take 60 (drop 30 (video-seq give0))) {:fps 30 :width 320 :height 240 }))
385 (def sg short-give)
386 (def g1 (first sg))
387 (def gs sg)
388 (def play (frame-hash (first sg)))
389 (def blank (with-meta (zipmap (keys play) (repeat (count play) {:r 0 :g 0 :b 0})) (meta play)))
391 (def blank (with-meta (zipmap (keys play) (repeat (count play) {:r 0 :g 0 :b 0})) (meta play)))
392 (def b+w-play (b&w play))
393 (def rgb (rectangle-window 50 50 1 1 play))
394 (def invertedPlay (with-meta (zipmap (keys play) (map #(hash-map :r (- 255 (:r %)) :g (- 255 (:g %)) :b (- 255 (:b %))) (vals b+w-play))) (meta play)))
396 (def invertedColorPlay (with-meta (zipmap (keys play) (map #(hash-map :r (- 255 (:r %)) :g (- 255 (:g %)) :b (- 255 (:b %))) (vals play))) (meta play)))
398 (def play1 (with-meta (frame-hash (nth sg 0)) {:width 320 :height 240}))
399 (def play2 (with-meta (frame-hash (nth sg 1)) {:width 320 :height 240}))
400 (def play3 (with-meta (frame-hash (nth sg 2)) {:width 320 :height 240}))
401 (def play4 (with-meta (frame-hash (nth sg 3)) {:width 320 :height 240}))
402 (def play5 (with-meta (frame-hash (nth sg 4)) {:width 320 :height 240}))
429 (comment
430 ok here's the plan--
432 "genesis/language"
433 raw text -> START -> representations/memory -> story tree
435 "genesis/vision"
436 raw video -> blob detector -> representations/memory -> event/structure tree
438 first, we start off with a video.
439 the video get's passed through the blob detector.
441 (blob-detector
442 first-pass- divide up each frame into exasutive polygons. no temporal dependence
443 second-pass- do a pairwise comparison of frames to link the polygons from each frame.
444 polygons can either split apart or merge, but this step establishes their geneology.
445 third-pass- link the polygons together into higher objects using hueristic rules about motion
446 these rules are determined by the language system, but for now they will be hardcoded.
447 the only thing for now is that things that move together are the same object.
448 )
451 so now, we have a temporal history of polygons.
452 the language part of the story may specify that certain characters
453 with certain qualities do certain actions.
455 "Bob is wearing a red shirt. Shirts are big. Bob is a person.
456 Mary is wearing a green shirt.
457 Bob is person-sized.
458 Bob is moving.
459 The green object is a ball.
460 Bob gives the ball to Mary."
462 Now, Genesis can select just the polygons that are important to the story,
463 and it also learns important facts such as the relative size of a person to a ball.
465 The details which are captured in the polygon-transition space are--
466 x (location of the center of each polygon), dx/dt , ((d^2)x)/(dt)^2, color (average), [left|right], polygon area
467 polygon shape
469 This information recurses on every component polygon as well.
471 When genesis want's to learn about verbs in particular,
472 it selects the aproapiate blobs from the linguistic desctiption (in bob's
473 case it's "the big red blob on the left", for example.)
475 after selecting a subset of the blobs, it calculates the angles and distances between
476 those blobs' centers as erll as whether they are touching or overlaping.
478 From this sequence it derives an example of the verb.
480 From other examples it can do arch earning to refine the sequence to its salient features.
481 )
485 (comment (things you can do that will actually work!)
487 (do (use :reload-all 'clojureDemo.GenesisPlay) (in-ns 'clojureDemo.GenesisPlay))
488 ;genesis integration:
489 (def gen5 (make-generator-box "the 5th element" 5))
490 (Connections/wire gen5 (make-box "printer" println))
491 (Connections/viewNetwork)
492 (.process gen5 :ignore) ; causes 5 to be printed
493 (Connections/obliterateNetwork)
494 (.process gen5 :ignore); since the network connections were dissolved, nothing prints.
498 )