lasercutter: src/clojureDemo/ArchLearning.clj comparison

comparison 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

comparison

equal deleted inserted replaced

-:163bf9b2fd13
+:6d9bdaf919f7
+(ns clojureDemo.ArchLearning
+(:gen-class
+:implements [connections.WiredBox]
+:methods [ [process [Object] void] [setFile [Object] void] ]
+:post-init register))
+(use 'clojure.contrib.import-static)
+(import '(java.io File))
+(import '(org.apache.commons.io FileUtils))
+(import '(javax.imageio ImageIO) )
+(import '(javax.swing JFrame))
+(import '(java.awt Color BorderLayout))
+(import '(ij.plugin PlugIn))
+(import '(ij ImagePlus IJ))
+(import '(java.lang Math))
+(import '(java.awt Polygon))
+(import '(java.awt.geom Line2D$Double))
+(use 'clojureDemo.appeture)
+(import-static java.lang.Math pow abs)
+(import '(ij Macro))
+(import '(java.io BufferedReader InputStreamReader))
+(import '(java.awt.image BufferedImage))
+(import '(genesis Genesis))
+(import '(utils Mark))
+(import '(capenLow StoryProcessor))
+(import '(connections Connections WiredBox))
+(import '(specialBoxes BasicBox MultiFunctionBox))
+(import '(engineering NewHardWiredTranslator))
+(import '(java.awt Polygon))
+(import '(java.awt.geom Line2D$Double))
+(use 'clojure.contrib.str-utils)
+;genesis imports
+(import '(http Start))
+(use '[clojureDemo.Xuggle :only (video-seq trans-save flash display video-data)])
+(use 'clojureDemo.MegaDeath)
+(use 'clojure.contrib.combinatorics)
+(use 'clojure.contrib.repl-utils)
+(use 'clojureDemo.GenesisPlay)
+(use ['clojureDemo.Defines
+:only '(
+	     lian look getto human0 blow base app0 app1 app2 app3 app4 app5
+		  bounce0 bounce1 bounce2 bounce3 bounce4 bounce5 bounce6
+		  collide0 collide1 collide2 collide3 collide4
+		  give0 give1 give2 give3 give4 target default)])
+(defn -register
+"equivalent to Connections.getPorts(this).addSignalProcessor(\"process\"); in Java"
+[this]
+(println "ClojureBox (register) : Register is run
+only when the object is created, as if it were a constructor.")
+(. (connections.Connections/getPorts this) addSignalProcessor "process"))
+(defn -process [ this obj ]
+(println "ClojureBox (process) :  This is a LISP function,
+being called through Java, through the wiredBox metaphor.")
+(.transmit (Connections/getPorts this)  obj))
+(defn -getName
+"the [_] means that  the function gets an explicit 'this'
+argument, just like python. In this case we don't care about it."
+[_]  "ArchLearning")
+(def output-base (File. "/home/r/Desktop/output-vision"))
+(def rsgs (with-meta (take 10 gs) (meta gs)))
+(def rrsgs (with-meta (take 3 rsgs) (meta gs)))
+; a concept is going to be derived from Genesis' own xml based representations.
+; this is an form of archlearning which figures out a function that representes
+; the concepts.
+(def black {:r 0  :g 0 :b 0})
+(def white {:r 255 :g 255 :b 255})
+(defn window-frame
+"analyzes a frame in terms of lots of tiny windows which
+each try to find some sort of edge. keeps coordinates."
+([x-form frame]
+(let [lines (frame-windows x-form frame)]
+(zipmap (for [x lines] (first (rest x)))
+	       lines)))
+([frame]
+(window-frame identity frame)))
+(defn intense-select-x-form
+"discard silly gray things"
+[window]
+(with-meta
+(zipmap
+(keys window)
+(map (fn  [rgb]
+	    (let [spread (- (max (:r rgb) (:g rgb) (:b rgb)) (min (:r rgb) (:g rgb) (:b rgb)))]
+	      (if (> spread 45)
+		rgb
+		{:r 0 :g 0 :b 0}))) (vals window)))  (meta window)))
+(defn edges-x-form
+[window]
+(frame-hash (ImagePlus. "sad :(" (overlay-draw blank (frame-windows window)))))
+(defn rgb-max
+[rgb1 rgb2]
+{:r (max (:r rgb1) (:r rgb2))
+:g (max (:g rgb1) (:g rgb2))
+:b (max (:b rgb1) (:b rgb2))})
+(defn frame-hash-add
+[frame1 frame2]
+(with-meta
+(let [indexes (apply hash-set (concat (keys frame1) (keys frame2)))]
+(zipmap indexes (for [x indexes] (rgb-max (frame1 x black)  (frame2 x black))))) (meta frame1)))
+(defn vid-seq-add
+"for black and white video-sequences. Just adds them together into one image sequence"
+[vid-seq1 vid-seq2]
+(with-meta
+(map  #(ImagePlus. "ADD B&W" (frame-hash->bufferedImage %)) (map frame-hash-add (map frame-hash vid-seq1) (map frame-hash vid-seq2)))
+(meta vid-seq1)))
+(defn edges-center-draw
+([base edges]
+(frame-hash-add
+base
+(zipmap (keys edges) (repeat white))))
+([edges]
+(edges-center-draw blank edges)))
+(defn edge-dot-x-form
+"gives a new frame-hash with only the edge points, all white."
+[frame]
+(edges-center-draw (window-frame frame)))
+(defn rgb-euclidian
+[{r1 :r g1 :g b1 :b} {r2 :r g2 :g b2 :b} ]
+(pow (+ (pow (- r1 r2) 2)
+	  (pow (- g1 g2) 2)
+	  (pow (- b1 b2) 2)) 0.5))
+(defn rgb-sub
+[tolerance rgb1 rgb2]
+(if (< (rgb-euclidian rgb1 rgb2) tolerance) black white))
+(defn frame-subtract
+[tolerance frame1 frame2]
+(with-meta
+(let [indexes (apply hash-set (concat (keys frame1) (keys frame2)))]
+(zipmap indexes (for [x indexes] (rgb-sub tolerance (frame1 x)  (frame2 x))))) (meta frame1)))
+(defn image-subtract
+[tolerance [img1 img2]]
+(frame-subtract tolerance (frame-hash img1) (frame-hash img2)))
+(defn motion-detect
+([tolerance video-seq]
+(with-meta
+(map (partial image-subtract tolerance) (partition 2 1 video-seq)) (meta video-seq)))
+([video-seq]
+(motion-detect 40 video-seq)))
+(defn motion-x-form
+([tolerance video-seq]
+(with-meta
+(map  #(ImagePlus. "motion-detect!" (frame-hash->bufferedImage %)) (motion-detect tolerance video-seq))
+(meta video-seq)))
+([video-seq]
+(motion-x-form 40 video-seq)))
+;the edge detector is what finds objects.
+;movement disambiguates between different ways of interperting what objects are there
+;color / other qualifiers enable focus on a subset of objects, and can give objects names.
+(defn find-an-object
+"tries to find a single object from the current sensory-buffer, which
+is a video-seq for now. My idea here is for this to feed-back on itself,
+adjusting parameters till it can find it's target, and then using those
+to construct an representation of the object in terms of how to find it using
+other visual routines paramaters."
+[video-seq])
+(defn transform
+[x-form video-seq]
+(with-meta
+(map (fn [imgPlus]
+	   (let [play (frame-hash imgPlus)]
+	     (x-form play)))
+	 video-seq)
+(meta video-seq)))
+(defn apply-x-form
+[x-form video-seq]
+(with-meta
+(map #(ImagePlus. "transformed!" (frame-hash->bufferedImage %))
+	 (map (fn [imgPlus]
+		(let [play (frame-hash imgPlus)]
+		  (x-form play)))
+	      video-seq))
+(meta video-seq)))
+(defn only-white
+"reduce the image to only its white points"
+[window]
+(with-meta
+(let [new-keys
+	(filter  #(= white (window %)) (keys window))]
+(zipmap new-keys (map window new-keys))) (meta window)))
+(defn white-sum
+[& rgbs]
+(let[ wht-map {white 1}]
+(reduce + (map #(wht-map % 0) rgbs))))
+(defn island?
+"return false if there's nothing around it within a certain radius"
+[window [x y]]
+(let [radius 3]
+(<= (apply white-sum (vals (rectangle-window x y radius radius window))) 1)))
+(defn white-border
+"anything that relies on a hack like this to work is wrong"
+[window]
+(with-meta
+(let [info (meta window)]
+(into window
+	    (zipmap
+	     (for [x (range (:width info)) y (range (:height info))
+		   :when (or (= (-(:width info) 1) x) (= (- (:height info) 1) y) (= 0 y) (= 0 x))] [x y])
+	     (repeat white))))(meta window)))
+(defn polygonize
+"for each edge-point, try to connect it with all the edge points around it,
+or obliterate it if it doesn't have any edge points close by."
+[window]
+(with-meta
+(let [edges (only-white window)]
+(let [new-keys
+	  (filter (comp not (partial island? window)) (keys window))]
+(let [ready-points (zipmap new-keys (map window new-keys))]
+(meta window))))))
+(defn connect-the-dots
+[radius window]
+(let [edge-points (white-border (only-white window))
+	image  (frame-hash->bufferedImage window)
+	g2 (.getGraphics image)]
+(doall
+(for [[x y] (keys edge-points)]
+(let [points  (apply cartesian-product (repeat 2 (keys (only-white (rectangle-window x y radius radius edge-points)))))]
+	(if (not (empty? points))
+	  (doall
+	  (for [[[x1 y1][x2 y2]] points]
+	    (.drawLine g2 x1 y1 x2 y2)))))))
+(frame-hash (ImagePlus. "stupid..."  image))))
+(defn blob-x-form
+[window]
+(with-meta
+((comp (partial connect-the-dots 4) edge-dot-x-form) window)
+(meta window)))
+(defn connect-points
+[frame-hash overlay]
+(let [image  (frame-hash->bufferedImage frame-hash)
+g2 (.getGraphics image)]
+(doall (for [ x overlay]
+(let [x1 (ffirst x) y1 (second (first x)) x2 (first (last x)) y2 (last (last x))]
+(.drawLine g2 x1 y1 x2 y2))))
+image))
+(defn disambiguate-edges
+"Like in project Prakesh, the thing that lets you discern shapes
+is watching them *move* coherently. After many months of this
+motion-boosting, the edge-detector itself becomes good enogh to
+analyze static pictures without motion.  This function takes edges
+and tries to combine them into lines, dividing the world into
+polygonal regions.  Motion is used to associate two regions together.
+associated with those points, that information is also used."
+[edges motion]
+)
+(defn triple-seq
+[triple]
+(list (.getFirst triple) (.getSecond triple) (.getThird triple)))
+(defn contains-word?
+[word triple]
+(contains? (set  (map (fn [s] (re-sub #"-\d+" "" s)) (triple-seq triple))) word))
+(defn write
+[reference]
+(fn [x] (dosync
+	   (println "wrote "  " to " "ref.")
+	   (ref-set reference x))))
+;; (defn join-point-lists
+;;   [pointlist1 pointlist2]
+;;   (for [x  :while (not(= x 5))] x)))
+(defn extract-single-blob
+"find the biggest blob in an image and return it"
+[window]
+;we're assuming that there are only blobs left -- funning this on an unprocessed
+;image will just return the entire image
+(map list window))
+(def gen-out (ref nil))
+(def triple (ref nil))
+(def gen1 (ref ()))
+(def gen2 (ref ()))
+(def gen3 (ref ()))
+(def gen4 (ref ()))
+(def gen5 (ref ()))
+(def gen6 (ref ()))
+(def gen7 (ref ()))
+(def gen8 (ref ()))
+(defn make-color-generator
+[]
+(let [r (java.util.Random. 58)
+g (java.util.Random. 125)
+b (java.util.Random. 8)]
+#(hash-map :r (.nextInt r 255)  :g (.nextInt r 255)   :b (.nextInt r 255))))
+;a blob is a collection of:
+;points, colors
+;other blobs
+;so, a window is a blob too.
+;; (defn blob-color-absob
+;;   [blob1 blob2]
+;;   (if (and (< (rgb-euclidian (color-avg blob1) (color-avg blob2)) 20) (close-together blob1 blob2))
+;;     (combine blob1 blob2)
+;;     '(blob1 blob2)))
+(defn make-test-box
+"stupid."
+[]
+(let [box (proxy [MultiFunctionBox] [] (getName [] "test-box [clojure]")
+		   (process1 [obj] ((write gen1) obj))
+		   (process2 [obj] ((write gen2) obj))
+		   (process3 [obj] ((write gen3) obj))
+		   (process4 [obj] ((write gen4) obj))
+		   (process5 [obj] ((write gen5) obj))
+		   (process6 [obj] ((write gen6) obj))
+		   (process7 [obj] ((write gen7) obj))
+		   (process8 [obj] ((write gen8) obj)))]
+(.addSignalProcessor (Connections/getPorts box) "PORT1" "process1")
+(.addSignalProcessor (Connections/getPorts box) "PORT2" "process2")
+(.addSignalProcessor (Connections/getPorts box) "PORT3" "process3")
+(.addSignalProcessor (Connections/getPorts box) "PORT4" "process4")
+(.addSignalProcessor (Connections/getPorts box) "PORT5" "process5")
+(.addSignalProcessor (Connections/getPorts box) "PORT6" "process6")
+(.addSignalProcessor (Connections/getPorts box) "PORT7" "process7")
+(.addSignalProcessor (Connections/getPorts box) "PORT8" "process8")
+box))
+(defn writer-box
+[reference]
+(let [box (proxy [MultiFunctionBox] []
+	      (getName [] "ref-set\n [clojure]")
+	      (process1 [obj] ((write reference) obj)))]
+(.addSignalProcessor (Connections/getPorts box) "process1")
+box))
+(def triples  (ref ()))
+(def parse    (ref ()))
+(def raw      (ref ()))
+(def idioms   (ref ()))
+(def yes-no   (ref ()))
+(def imagine  (ref ()))
+(def traj     (ref ()))
+(def action   (ref ()))
+(def transfer (ref ()))
+(def pix      (ref ()))
+(def property (ref ()))
+(use 'clojure.contrib.str-utils)
+(defn process-video-and-subtitles
+[this file]
+;we're looking for a text file of the same name as the video file.
+(let [subtitles (File. (.getParent file) (str (last (first (re-seq #"(^.*)\.avi$" (.getName file)))) ".txt"))]
+(dorun
+(for [line (re-split #"\n" (slurp (str subtitles)))]
+(do (println line)
+(.transmit (Connections/getPorts this)  line)))))
+(display (first (video-seq file))))
+(defn process-triple
+[this triple]
+(println "RLM [vision-box]: " triple))
+(defn visionBox
+[]
+(let [box (proxy [MultiFunctionBox] []
+	      (getName [] "VisionBox \n [clojure]")
+	      (process1 [obj] (process-video-and-subtitles this obj))
+	      (process2 [obj] (process-triple this obj)))]
+(.addSignalProcessor (Connections/getPorts box) "video-in" "process1")
+(.addSignalProcessor (Connections/getPorts box) "triple-in" "process2")
+(println "the good box")
+box))
+(defn custom-genesis
+"connects the writer boxes to genesis"
+[]
+(Connections/obliterateNetwork)
+(let [stupid-box (make-test-box) genesis (Genesis.) vis-box (visionBox) ]
+(Connections/wire "tripple port" (.getStartParser genesis) (writer-box triples))
+(Connections/wire "parse" (.getStartParser genesis) (writer-box parse))
+(Connections/wire "result" (.getNewSemanticTranslator genesis) (writer-box raw))
+(Connections/wire (.getIdiomExpert genesis) (writer-box idioms))
+(Connections/wire "yes-no question" (.getCommandExpert genesis) (writer-box yes-no))
+(Connections/wire "imagine" (.getCommandExpert genesis)  (writer-box imagine))
+(Connections/wire "viewer" (.getTrajectoryExpert genesis) (writer-box traj))
+(Connections/wire "viewer" (.getActionExpert genesis) (writer-box action))
+(Connections/wire "next" (.getTransferExpert genesis) (writer-box transfer))
+(Connections/wire  (.getRachelsPictureFinder genesis) (writer-box pix))
+(Connections/wire "viewer" (.getPropertyExpert genesis) (writer-box property))
+(Connections/wire "tripple port" (.getStartParser genesis) "triple-in" vis-box)
+(Connections/wire (.getArchLearning genesis) "video-in" vis-box)
+(Connections/wire  vis-box "sentence" (.getStartParser genesis))
+genesis))
+(use 'clojure.contrib.def)
+(defvar learning-hash  {}
+"Right now this serves as the visual memory.
+It's full of verbs/objects and the programs
+that find them.")
+(def green {:r 0 :g 200 :b 0})
+(def blue  {:r 0  :g 0  :b 255})
+(def red   {:r 255 :g 0 :b 0})
+(defn color-similar?
+[threshold window color coord]
+(< (rgb-euclidian (window coord) color) threshold))
+;should also have the same "shape" here
+(defn color-select
+[threshold color window]
+(with-meta
+(let [new-keys
+	     (filter  (partial color-similar? threshold window color) (keys window))]
+	 (zipmap new-keys (map window new-keys)))
+	   (meta window)))
+(defn object-sequence
+"get's the largest blob of the given color from a video sequence."
+[color video-seq]
+(apply-x-form (comp (partial color-select 135 color) intense-select-x-form) rrsgs))
+(defn -setFile
+[this file]
+(println "file is " file)
+(.process this file))
+(comment (things you can do that will actually work!)
+(do (use :reload-all 'clojureDemo.ArchLearning) (in-ns 'clojureDemo.ArchLearning))
+(display (overlay-draw (green-select-x-form play) (frame-windows green-select-x-form play )))
+;vision stuff
+(def edgesD (transform window-frame rrsgs))
+(doall
+(def edgesI (apply-x-form edges-x-form rrsgs))
+(display (rectangle-window 50 50 50 50 (frame-hash (nth edgesI 1))))
+)
+(def polyjuice (white-border (only-white (edge-dot-x-form play))))
+(count  (color-select 135 red (intense-select-x-form (frame-hash (last sg)))))
+(trans-save (File. output-base "only-red.avi")(apply-x-form (comp (partial color-select 135 red) intense-select-x-form) rrsgs))
+)

Mercurial > lasercutter

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