Mercurial > lasercutter
view src/clojureDemo/ArchLearning.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.ArchLearning2 (:gen-class3 :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 imports40 (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.Defines54 :only '(55 lian look getto human0 blow base app0 app1 app2 app3 app4 app556 bounce0 bounce1 bounce2 bounce3 bounce4 bounce5 bounce657 collide0 collide1 collide2 collide3 collide458 give0 give1 give2 give3 give4 target default)])60 (defn -register61 "equivalent to Connections.getPorts(this).addSignalProcessor(\"process\"); in Java"62 [this]63 (println "ClojureBox (register) : Register is run64 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 -getName73 "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 representes86 ; the concepts.89 (def black {:r 0 :g 0 :b 0})90 (def white {:r 255 :g 255 :b 255})93 (defn window-frame94 "analyzes a frame in terms of lots of tiny windows which95 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-form105 "discard silly gray things"106 [window]107 (with-meta108 (zipmap109 (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 rgb114 {:r 0 :g 0 :b 0}))) (vals window))) (meta window)))116 (defn edges-x-form117 [window]118 (frame-hash (ImagePlus. "sad :(" (overlay-draw blank (frame-windows window)))))122 (defn rgb-max123 [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-add129 [frame1 frame2]130 (with-meta131 (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-add137 "for black and white video-sequences. Just adds them together into one image sequence"138 [vid-seq1 vid-seq2]139 (with-meta140 (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-draw144 ([base edges]145 (frame-hash-add146 base147 (zipmap (keys edges) (repeat white))))148 ([edges]149 (edges-center-draw blank edges)))151 (defn edge-dot-x-form152 "gives a new frame-hash with only the edge points, all white."153 [frame]154 (edges-center-draw (window-frame frame)))157 (defn rgb-euclidian158 [{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-sub164 [tolerance rgb1 rgb2]165 (if (< (rgb-euclidian rgb1 rgb2) tolerance) black white))169 (defn frame-subtract170 [tolerance frame1 frame2]171 (with-meta172 (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-subtract177 [tolerance [img1 img2]]178 (frame-subtract tolerance (frame-hash img1) (frame-hash img2)))181 (defn motion-detect182 ([tolerance video-seq]183 (with-meta184 (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-form189 ([tolerance video-seq]190 (with-meta191 (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 there197 ;color / other qualifiers enable focus on a subset of objects, and can give objects names.203 (defn find-an-object204 "tries to find a single object from the current sensory-buffer, which205 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 those207 to construct an representation of the object in terms of how to find it using208 other visual routines paramaters."209 [video-seq])213 (defn transform214 [x-form video-seq]215 (with-meta216 (map (fn [imgPlus]217 (let [play (frame-hash imgPlus)]218 (x-form play)))219 video-seq)220 (meta video-seq)))223 (defn apply-x-form224 [x-form video-seq]225 (with-meta226 (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-white236 "reduce the image to only its white points"237 [window]238 (with-meta239 (let [new-keys240 (filter #(= white (window %)) (keys window))]241 (zipmap new-keys (map window new-keys))) (meta window)))246 (defn white-sum247 [& 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-border258 "anything that relies on a hack like this to work is wrong"259 [window]260 (with-meta261 (let [info (meta window)]262 (into window263 (zipmap264 (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 polygonize269 "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-meta273 (let [edges (only-white window)]274 (let [new-keys275 (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-dots281 [radius window]282 (let [edge-points (white-border (only-white window))283 image (frame-hash->bufferedImage window)284 g2 (.getGraphics image)]285 (doall286 (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 (doall291 (for [[[x1 y1][x2 y2]] points]292 (.drawLine g2 x1 y1 x2 y2)))))))293 (frame-hash (ImagePlus. "stupid..." image))))296 (defn blob-x-form297 [window]298 (with-meta299 ((comp (partial connect-the-dots 4) edge-dot-x-form) window)300 (meta window)))305 (defn connect-points306 [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-edges316 "Like in project Prakesh, the thing that lets you discern shapes317 is watching them *move* coherently. After many months of this318 motion-boosting, the edge-detector itself becomes good enogh to319 analyze static pictures without motion. This function takes edges320 and tries to combine them into lines, dividing the world into321 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-seq328 [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 write337 [reference]338 (fn [x] (dosync339 (println "wrote " " to " "ref.")340 (ref-set reference x))))343 ;; (defn join-point-lists344 ;; [pointlist1 pointlist2]345 ;; (for [x :while (not(= x 5))] x)))347 (defn extract-single-blob348 "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 unprocessed351 ;image will just return the entire image352 (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-generator373 []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, colors382 ;other blobs383 ;so, a window is a blob too.390 ;; (defn blob-color-absob391 ;; [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-box398 "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-box423 [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-subtitles448 [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 (dorun452 (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-triple458 [this triple]459 (println "RLM [vision-box]: " triple))461 (defn visionBox462 []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-genesis478 "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 programs507 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" here519 (defn color-select520 [threshold color window]521 (with-meta522 (let [new-keys523 (filter (partial color-similar? threshold window color) (keys window))]524 (zipmap new-keys (map window new-keys)))525 (meta window)))529 (defn object-sequence530 "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 -setFile535 [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 stuff550 (def edgesD (transform window-frame rrsgs))552 (doall553 (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 )