view src/clojureDemo/ArchLearning.clj @ 1:6d9bdaf919f7

added clojureDemo source
author Robert McIntyre <rlm@mit.edu>
date Fri, 20 Aug 2010 00:32:44 -0400
parents
children
line wrap: on
line source
1 (ns clojureDemo.ArchLearning
2 (:gen-class
3 :implements [connections.WiredBox]
4 :methods [ [process [Object] void] [setFile [Object] void] ]
5 :post-init register))
7 (use 'clojure.contrib.import-static)
8 (import '(java.io File))
9 (import '(org.apache.commons.io FileUtils))
10 (import '(javax.imageio ImageIO) )
11 (import '(javax.swing JFrame))
12 (import '(java.awt Color BorderLayout))
13 (import '(ij.plugin PlugIn))
14 (import '(ij ImagePlus IJ))
15 (import '(java.lang Math))
16 (import '(java.awt Polygon))
17 (import '(java.awt.geom Line2D$Double))
19 (use 'clojureDemo.appeture)
21 (import-static java.lang.Math pow abs)
23 (import '(ij Macro))
25 (import '(java.io BufferedReader InputStreamReader))
26 (import '(java.awt.image BufferedImage))
27 (import '(genesis Genesis))
28 (import '(utils Mark))
29 (import '(capenLow StoryProcessor))
30 (import '(connections Connections WiredBox))
31 (import '(specialBoxes BasicBox MultiFunctionBox))
32 (import '(engineering NewHardWiredTranslator))
34 (import '(java.awt Polygon))
35 (import '(java.awt.geom Line2D$Double))
36 (use 'clojure.contrib.str-utils)
39 ;genesis imports
40 (import '(http Start))
43 (use '[clojureDemo.Xuggle :only (video-seq trans-save flash display video-data)])
44 (use 'clojureDemo.MegaDeath)
47 (use 'clojure.contrib.combinatorics)
49 (use 'clojure.contrib.repl-utils)
51 (use 'clojureDemo.GenesisPlay)
53 (use ['clojureDemo.Defines
54 :only '(
55 lian look getto human0 blow base app0 app1 app2 app3 app4 app5
56 bounce0 bounce1 bounce2 bounce3 bounce4 bounce5 bounce6
57 collide0 collide1 collide2 collide3 collide4
58 give0 give1 give2 give3 give4 target default)])
60 (defn -register
61 "equivalent to Connections.getPorts(this).addSignalProcessor(\"process\"); in Java"
62 [this]
63 (println "ClojureBox (register) : Register is run
64 only when the object is created, as if it were a constructor.")
65 (. (connections.Connections/getPorts this) addSignalProcessor "process"))
67 (defn -process [ this obj ]
68 (println "ClojureBox (process) : This is a LISP function,
69 being called through Java, through the wiredBox metaphor.")
70 (.transmit (Connections/getPorts this) obj))
72 (defn -getName
73 "the [_] means that the function gets an explicit 'this'
74 argument, just like python. In this case we don't care about it."
75 [_] "ArchLearning")
81 (def output-base (File. "/home/r/Desktop/output-vision"))
82 (def rsgs (with-meta (take 10 gs) (meta gs)))
83 (def rrsgs (with-meta (take 3 rsgs) (meta gs)))
84 ; a concept is going to be derived from Genesis' own xml based representations.
85 ; this is an form of archlearning which figures out a function that representes
86 ; the concepts.
89 (def black {:r 0 :g 0 :b 0})
90 (def white {:r 255 :g 255 :b 255})
93 (defn window-frame
94 "analyzes a frame in terms of lots of tiny windows which
95 each try to find some sort of edge. keeps coordinates."
96 ([x-form frame]
97 (let [lines (frame-windows x-form frame)]
98 (zipmap (for [x lines] (first (rest x)))
99 lines)))
100 ([frame]
101 (window-frame identity frame)))
104 (defn intense-select-x-form
105 "discard silly gray things"
106 [window]
107 (with-meta
108 (zipmap
109 (keys window)
110 (map (fn [rgb]
111 (let [spread (- (max (:r rgb) (:g rgb) (:b rgb)) (min (:r rgb) (:g rgb) (:b rgb)))]
112 (if (> spread 45)
113 rgb
114 {:r 0 :g 0 :b 0}))) (vals window))) (meta window)))
116 (defn edges-x-form
117 [window]
118 (frame-hash (ImagePlus. "sad :(" (overlay-draw blank (frame-windows window)))))
122 (defn rgb-max
123 [rgb1 rgb2]
124 {:r (max (:r rgb1) (:r rgb2))
125 :g (max (:g rgb1) (:g rgb2))
126 :b (max (:b rgb1) (:b rgb2))})
128 (defn frame-hash-add
129 [frame1 frame2]
130 (with-meta
131 (let [indexes (apply hash-set (concat (keys frame1) (keys frame2)))]
132 (zipmap indexes (for [x indexes] (rgb-max (frame1 x black) (frame2 x black))))) (meta frame1)))
136 (defn vid-seq-add
137 "for black and white video-sequences. Just adds them together into one image sequence"
138 [vid-seq1 vid-seq2]
139 (with-meta
140 (map #(ImagePlus. "ADD B&W" (frame-hash->bufferedImage %)) (map frame-hash-add (map frame-hash vid-seq1) (map frame-hash vid-seq2)))
141 (meta vid-seq1)))
143 (defn edges-center-draw
144 ([base edges]
145 (frame-hash-add
146 base
147 (zipmap (keys edges) (repeat white))))
148 ([edges]
149 (edges-center-draw blank edges)))
151 (defn edge-dot-x-form
152 "gives a new frame-hash with only the edge points, all white."
153 [frame]
154 (edges-center-draw (window-frame frame)))
157 (defn rgb-euclidian
158 [{r1 :r g1 :g b1 :b} {r2 :r g2 :g b2 :b} ]
159 (pow (+ (pow (- r1 r2) 2)
160 (pow (- g1 g2) 2)
161 (pow (- b1 b2) 2)) 0.5))
163 (defn rgb-sub
164 [tolerance rgb1 rgb2]
165 (if (< (rgb-euclidian rgb1 rgb2) tolerance) black white))
169 (defn frame-subtract
170 [tolerance frame1 frame2]
171 (with-meta
172 (let [indexes (apply hash-set (concat (keys frame1) (keys frame2)))]
173 (zipmap indexes (for [x indexes] (rgb-sub tolerance (frame1 x) (frame2 x))))) (meta frame1)))
176 (defn image-subtract
177 [tolerance [img1 img2]]
178 (frame-subtract tolerance (frame-hash img1) (frame-hash img2)))
181 (defn motion-detect
182 ([tolerance video-seq]
183 (with-meta
184 (map (partial image-subtract tolerance) (partition 2 1 video-seq)) (meta video-seq)))
185 ([video-seq]
186 (motion-detect 40 video-seq)))
188 (defn motion-x-form
189 ([tolerance video-seq]
190 (with-meta
191 (map #(ImagePlus. "motion-detect!" (frame-hash->bufferedImage %)) (motion-detect tolerance video-seq))
192 (meta video-seq)))
193 ([video-seq]
194 (motion-x-form 40 video-seq)))
195 ;the edge detector is what finds objects.
196 ;movement disambiguates between different ways of interperting what objects are there
197 ;color / other qualifiers enable focus on a subset of objects, and can give objects names.
203 (defn find-an-object
204 "tries to find a single object from the current sensory-buffer, which
205 is a video-seq for now. My idea here is for this to feed-back on itself,
206 adjusting parameters till it can find it's target, and then using those
207 to construct an representation of the object in terms of how to find it using
208 other visual routines paramaters."
209 [video-seq])
213 (defn transform
214 [x-form video-seq]
215 (with-meta
216 (map (fn [imgPlus]
217 (let [play (frame-hash imgPlus)]
218 (x-form play)))
219 video-seq)
220 (meta video-seq)))
223 (defn apply-x-form
224 [x-form video-seq]
225 (with-meta
226 (map #(ImagePlus. "transformed!" (frame-hash->bufferedImage %))
227 (map (fn [imgPlus]
228 (let [play (frame-hash imgPlus)]
229 (x-form play)))
230 video-seq))
231 (meta video-seq)))
235 (defn only-white
236 "reduce the image to only its white points"
237 [window]
238 (with-meta
239 (let [new-keys
240 (filter #(= white (window %)) (keys window))]
241 (zipmap new-keys (map window new-keys))) (meta window)))
246 (defn white-sum
247 [& rgbs]
248 (let[ wht-map {white 1}]
249 (reduce + (map #(wht-map % 0) rgbs))))
251 (defn island?
252 "return false if there's nothing around it within a certain radius"
253 [window [x y]]
254 (let [radius 3]
255 (<= (apply white-sum (vals (rectangle-window x y radius radius window))) 1)))
257 (defn white-border
258 "anything that relies on a hack like this to work is wrong"
259 [window]
260 (with-meta
261 (let [info (meta window)]
262 (into window
263 (zipmap
264 (for [x (range (:width info)) y (range (:height info))
265 :when (or (= (-(:width info) 1) x) (= (- (:height info) 1) y) (= 0 y) (= 0 x))] [x y])
266 (repeat white))))(meta window)))
268 (defn polygonize
269 "for each edge-point, try to connect it with all the edge points around it,
270 or obliterate it if it doesn't have any edge points close by."
271 [window]
272 (with-meta
273 (let [edges (only-white window)]
274 (let [new-keys
275 (filter (comp not (partial island? window)) (keys window))]
276 (let [ready-points (zipmap new-keys (map window new-keys))]
277 (meta window))))))
280 (defn connect-the-dots
281 [radius window]
282 (let [edge-points (white-border (only-white window))
283 image (frame-hash->bufferedImage window)
284 g2 (.getGraphics image)]
285 (doall
286 (for [[x y] (keys edge-points)]
288 (let [points (apply cartesian-product (repeat 2 (keys (only-white (rectangle-window x y radius radius edge-points)))))]
289 (if (not (empty? points))
290 (doall
291 (for [[[x1 y1][x2 y2]] points]
292 (.drawLine g2 x1 y1 x2 y2)))))))
293 (frame-hash (ImagePlus. "stupid..." image))))
296 (defn blob-x-form
297 [window]
298 (with-meta
299 ((comp (partial connect-the-dots 4) edge-dot-x-form) window)
300 (meta window)))
305 (defn connect-points
306 [frame-hash overlay]
307 (let [image (frame-hash->bufferedImage frame-hash)
308 g2 (.getGraphics image)]
309 (doall (for [ x overlay]
310 (let [x1 (ffirst x) y1 (second (first x)) x2 (first (last x)) y2 (last (last x))]
311 (.drawLine g2 x1 y1 x2 y2))))
312 image))
315 (defn disambiguate-edges
316 "Like in project Prakesh, the thing that lets you discern shapes
317 is watching them *move* coherently. After many months of this
318 motion-boosting, the edge-detector itself becomes good enogh to
319 analyze static pictures without motion. This function takes edges
320 and tries to combine them into lines, dividing the world into
321 polygonal regions. Motion is used to associate two regions together.
322 associated with those points, that information is also used."
323 [edges motion]
324 )
327 (defn triple-seq
328 [triple]
329 (list (.getFirst triple) (.getSecond triple) (.getThird triple)))
331 (defn contains-word?
332 [word triple]
333 (contains? (set (map (fn [s] (re-sub #"-\d+" "" s)) (triple-seq triple))) word))
336 (defn write
337 [reference]
338 (fn [x] (dosync
339 (println "wrote " " to " "ref.")
340 (ref-set reference x))))
343 ;; (defn join-point-lists
344 ;; [pointlist1 pointlist2]
345 ;; (for [x :while (not(= x 5))] x)))
347 (defn extract-single-blob
348 "find the biggest blob in an image and return it"
349 [window]
350 ;we're assuming that there are only blobs left -- funning this on an unprocessed
351 ;image will just return the entire image
352 (map list window))
357 (def gen-out (ref nil))
358 (def triple (ref nil))
362 (def gen1 (ref ()))
363 (def gen2 (ref ()))
364 (def gen3 (ref ()))
365 (def gen4 (ref ()))
366 (def gen5 (ref ()))
367 (def gen6 (ref ()))
368 (def gen7 (ref ()))
369 (def gen8 (ref ()))
372 (defn make-color-generator
373 []
374 (let [r (java.util.Random. 58)
375 g (java.util.Random. 125)
376 b (java.util.Random. 8)]
377 #(hash-map :r (.nextInt r 255) :g (.nextInt r 255) :b (.nextInt r 255))))
380 ;a blob is a collection of:
381 ;points, colors
382 ;other blobs
383 ;so, a window is a blob too.
390 ;; (defn blob-color-absob
391 ;; [blob1 blob2]
392 ;; (if (and (< (rgb-euclidian (color-avg blob1) (color-avg blob2)) 20) (close-together blob1 blob2))
393 ;; (combine blob1 blob2)
394 ;; '(blob1 blob2)))
397 (defn make-test-box
398 "stupid."
399 []
400 (let [box (proxy [MultiFunctionBox] [] (getName [] "test-box [clojure]")
401 (process1 [obj] ((write gen1) obj))
402 (process2 [obj] ((write gen2) obj))
403 (process3 [obj] ((write gen3) obj))
404 (process4 [obj] ((write gen4) obj))
405 (process5 [obj] ((write gen5) obj))
406 (process6 [obj] ((write gen6) obj))
407 (process7 [obj] ((write gen7) obj))
408 (process8 [obj] ((write gen8) obj)))]
410 (.addSignalProcessor (Connections/getPorts box) "PORT1" "process1")
411 (.addSignalProcessor (Connections/getPorts box) "PORT2" "process2")
412 (.addSignalProcessor (Connections/getPorts box) "PORT3" "process3")
413 (.addSignalProcessor (Connections/getPorts box) "PORT4" "process4")
414 (.addSignalProcessor (Connections/getPorts box) "PORT5" "process5")
415 (.addSignalProcessor (Connections/getPorts box) "PORT6" "process6")
416 (.addSignalProcessor (Connections/getPorts box) "PORT7" "process7")
417 (.addSignalProcessor (Connections/getPorts box) "PORT8" "process8")
418 box))
422 (defn writer-box
423 [reference]
424 (let [box (proxy [MultiFunctionBox] []
425 (getName [] "ref-set\n [clojure]")
426 (process1 [obj] ((write reference) obj)))]
427 (.addSignalProcessor (Connections/getPorts box) "process1")
428 box))
433 (def triples (ref ()))
434 (def parse (ref ()))
435 (def raw (ref ()))
436 (def idioms (ref ()))
437 (def yes-no (ref ()))
438 (def imagine (ref ()))
439 (def traj (ref ()))
440 (def action (ref ()))
441 (def transfer (ref ()))
442 (def pix (ref ()))
443 (def property (ref ()))
445 (use 'clojure.contrib.str-utils)
447 (defn process-video-and-subtitles
448 [this file]
449 ;we're looking for a text file of the same name as the video file.
450 (let [subtitles (File. (.getParent file) (str (last (first (re-seq #"(^.*)\.avi$" (.getName file)))) ".txt"))]
451 (dorun
452 (for [line (re-split #"\n" (slurp (str subtitles)))]
453 (do (println line)
454 (.transmit (Connections/getPorts this) line)))))
455 (display (first (video-seq file))))
457 (defn process-triple
458 [this triple]
459 (println "RLM [vision-box]: " triple))
461 (defn visionBox
462 []
463 (let [box (proxy [MultiFunctionBox] []
464 (getName [] "VisionBox \n [clojure]")
465 (process1 [obj] (process-video-and-subtitles this obj))
466 (process2 [obj] (process-triple this obj)))]
467 (.addSignalProcessor (Connections/getPorts box) "video-in" "process1")
468 (.addSignalProcessor (Connections/getPorts box) "triple-in" "process2")
470 (println "the good box")
471 box))
477 (defn custom-genesis
478 "connects the writer boxes to genesis"
479 []
480 (Connections/obliterateNetwork)
481 (let [stupid-box (make-test-box) genesis (Genesis.) vis-box (visionBox) ]
482 (Connections/wire "tripple port" (.getStartParser genesis) (writer-box triples))
483 (Connections/wire "parse" (.getStartParser genesis) (writer-box parse))
484 (Connections/wire "result" (.getNewSemanticTranslator genesis) (writer-box raw))
485 (Connections/wire (.getIdiomExpert genesis) (writer-box idioms))
486 (Connections/wire "yes-no question" (.getCommandExpert genesis) (writer-box yes-no))
487 (Connections/wire "imagine" (.getCommandExpert genesis) (writer-box imagine))
488 (Connections/wire "viewer" (.getTrajectoryExpert genesis) (writer-box traj))
489 (Connections/wire "viewer" (.getActionExpert genesis) (writer-box action))
490 (Connections/wire "next" (.getTransferExpert genesis) (writer-box transfer))
491 (Connections/wire (.getRachelsPictureFinder genesis) (writer-box pix))
492 (Connections/wire "viewer" (.getPropertyExpert genesis) (writer-box property))
493 (Connections/wire "tripple port" (.getStartParser genesis) "triple-in" vis-box)
496 (Connections/wire (.getArchLearning genesis) "video-in" vis-box)
497 (Connections/wire vis-box "sentence" (.getStartParser genesis))
499 genesis))
502 (use 'clojure.contrib.def)
504 (defvar learning-hash {}
505 "Right now this serves as the visual memory.
506 It's full of verbs/objects and the programs
507 that find them.")
509 (def green {:r 0 :g 200 :b 0})
510 (def blue {:r 0 :g 0 :b 255})
511 (def red {:r 255 :g 0 :b 0})
514 (defn color-similar?
515 [threshold window color coord]
516 (< (rgb-euclidian (window coord) color) threshold))
517 ;should also have the same "shape" here
519 (defn color-select
520 [threshold color window]
521 (with-meta
522 (let [new-keys
523 (filter (partial color-similar? threshold window color) (keys window))]
524 (zipmap new-keys (map window new-keys)))
525 (meta window)))
529 (defn object-sequence
530 "get's the largest blob of the given color from a video sequence."
531 [color video-seq]
532 (apply-x-form (comp (partial color-select 135 color) intense-select-x-form) rrsgs))
534 (defn -setFile
535 [this file]
536 (println "file is " file)
537 (.process this file))
542 (comment (things you can do that will actually work!)
544 (do (use :reload-all 'clojureDemo.ArchLearning) (in-ns 'clojureDemo.ArchLearning))
546 (display (overlay-draw (green-select-x-form play) (frame-windows green-select-x-form play )))
548 ;vision stuff
550 (def edgesD (transform window-frame rrsgs))
552 (doall
553 (def edgesI (apply-x-form edges-x-form rrsgs))
554 (display (rectangle-window 50 50 50 50 (frame-hash (nth edgesI 1))))
555 )
557 (def polyjuice (white-border (only-white (edge-dot-x-form play))))
559 (count (color-select 135 red (intense-select-x-form (frame-hash (last sg)))))
560 (trans-save (File. output-base "only-red.avi")(apply-x-form (comp (partial color-select 135 red) intense-select-x-form) rrsgs))
561 )