Mercurial > lasercutter
view src/clojureDemo/GenesisPlay.clj @ 4:6533b4ef83ad
added hash-map filters :)
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Fri, 20 Aug 2010 01:30:12 -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.Defines43 :only '(44 lian look getto human0 blow base app0 app1 app2 app3 app4 app545 bounce0 bounce1 bounce2 bounce3 bounce4 bounce5 bounce646 collide0 collide1 collide2 collide3 collide447 give0 give1 give2 give3 give4 target default)])50 ;(proxy56 (defn startInFrame-rm57 [genesis]58 (.start genesis)59 (let [frame (JFrame.)]60 (doto frame61 (.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-genesis73 ([] (startInFrame-rm (Genesis.)))74 ([genesis] (startInFrame-rm genesis)))76 (defn lazy->hashMap77 [lazy]78 (zipmap (map first lazy) (map last lazy)))80 (defn make-box81 "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-box90 "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-name109 [function]110 (list str (list 'quote function)))112 (defn make-vision-box113 "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-box123 ;; [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-functions134 ;; [ name & functions]135 ;; (into136 ;; (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-box147 ;; [name & functions]151 ;; (defmacro make-fun-box152 ;; [name & functions]153 ;; (let [proxy-functions154 ;; (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-functions162 ;; box#))164 ;; (defmacro return165 ;; [name & functions]166 ;; (let [out (for [x functions]167 ;; x)]168 ;; out))174 (defn local-genesis175 "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-hash188 "yields a convienent representation for the pixles in an image.189 Because of the size of the structvre generated, this must only be used190 in a transient way so that java can do it's garbage collection."191 [imagePlus]192 (with-meta193 (let [buf (.. imagePlus getBufferedImage)194 color (.getColorModel buf)]195 (doall (apply hash-map196 (interleave197 (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-seq209 [video]210 (with-meta (doall (map frame-hash (video-seq video))) (video-data video)))216 (defn video-hash217 "turns an entire video into a nice hash-map218 .... or at least it would, if java didn't suck and only give me219 2 GB to work with with no way to increase it.220 linear processing... grumble grumble ....."221 [video-seq]222 (apply hash-map223 (interleave224 (naturals)225 (doall (map #(frame-hash %) video-seq)))))230 (defn frame-hash->bufferedImage231 [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-RGB239 (+ (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 display246 clojure.lang.PersistentHashMap [frame-hash]247 (display (frame-hash->bufferedImage frame-hash)))249 (defmethod display250 clojure.lang.PersistentArrayMap [frame-hash]251 (display (frame-hash->bufferedImage frame-hash)))253 ;; (defmethod display254 ;; clojure.lang.LazySeq [frame-hash]255 ;; (display (frame-hash->bufferedImage frame-hash)))261 (defn rectangle-window262 "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-meta268 (zipmap269 coords270 (map #(frame-hash % {:r 0 :g -500 :b 0}) coords))271 (meta frame-hash))))274 (defn sum275 "squashes all the dinensions of the picture together into a single dimension276 sutiable for analysis."277 [window]278 (zipmap279 (keys window)280 (map (fn [rgb] (+ (:r rgb) (:b rgb) (:g rgb))) (vals window))))282 (defn b&w283 "turn everything grey"284 [window]285 (with-meta286 (zipmap287 (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-form293 "find green things"294 [window]295 (with-meta296 (zipmap297 (keys window)298 (map (fn [rgb]299 (if (and (> (:g rgb) (:b rgb)) (> (:g rgb) (:r rgb)))300 rgb301 {:r 0 :g 0 :b 0})) (vals window))) (meta window)))304 (defn manual-line-detect305 "Ty as I might, this can never be truly effective until higher level306 processes contribute to dynamicaly adjusting these paramaters. For307 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 good318 (defn frame-windows319 "analyzes a frame in terms of lots of tiny windows which320 each try to find some sort of edge."321 ([ x-form frame]322 (with-meta323 (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-segmentation332 "divides a single picture frame into appropiate objects using a333 simple watershed method based on sharp color variation.334 radius: the general size of the window in pixels335 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-parse342 "this is the equilivalent to the S.T.A.R.T Parser for videos343 right now it's just a simple blob detector"344 [video-seq]346 )350 (defn overlay-draw351 [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&w362 [video-seq]363 (with-meta364 (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-save375 [filename vid-seq]376 (trans-save filename377 (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 (comment430 ok here's the plan--432 "genesis/language"433 raw text -> START -> representations/memory -> story tree435 "genesis/vision"436 raw video -> blob detector -> representations/memory -> event/structure tree438 first, we start off with a video.439 the video get's passed through the blob detector.441 (blob-detector442 first-pass- divide up each frame into exasutive polygons. no temporal dependence443 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 motion446 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 characters453 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 area467 polygon shape469 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's473 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 between476 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 printed493 (Connections/obliterateNetwork)494 (.process gen5 :ignore); since the network connections were dissolved, nothing prints.498 )