annotate src/clojureDemo/GenesisPlay.clj @ 1:6d9bdaf919f7

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