lasercutter: src/clojureDemo/GenesisPlay.clj comparison

comparison 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

comparison

equal deleted inserted replaced

-:163bf9b2fd13
+:6d9bdaf919f7
+(ns clojureDemo.GenesisPlay)
+(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))
+(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 '(http Start))
+(import '(engineering NewHardWiredTranslator))
+(import '(java.awt Polygon))
+(import '(java.awt.geom Line2D$Double))
+(use 'clojure.contrib.str-utils)
+(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.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)])
+;(proxy
+(defn startInFrame-rm
+[genesis]
+(.start genesis)
+(let [frame (JFrame.)]
+(doto frame
+(.setTitle "Genesis")
+(.setBounds 0 0 1024 768)
+(doto (.getContentPane)
+	(.setBackground Color/WHITE)
+	(.setLayout (BorderLayout.))
+	(.add genesis))
+(.setJMenuBar (.getMenuBar genesis))
+(.setVisible true))
+frame))
+(defn run-genesis
+([]  (startInFrame-rm (Genesis.)))
+([genesis] (startInFrame-rm genesis)))
+(defn lazy->hashMap
+[lazy]
+(zipmap  (map first lazy) (map last lazy)))
+(defn make-box
+"constructs a wired box sutiable for interfacing to Genesis"
+[name process-fn]
+(let [box (proxy [BasicBox] [] (getName [] name)
+		   (process [obj] (.transmit (Connections/getPorts this) (process-fn obj))))]
+(.addSignalProcessor (Connections/getPorts box) "process")
+box))
+(defn make-generator-box
+"makes a box which only outputs a constant"
+[name constant]
+(let [box (proxy [BasicBox] []  (getName [] name) (process [obj] (.transmit (Connections/getPorts this) constant)))]
+(.addSignalProcessor (Connections/getPorts box) "process")
+box))
+(defn naturals [] (iterate inc 0))
+;; ;(defn make-multifn-box [& args]
+;; ;  (apply hash-map args)
+;; ;  (map mega-macro naturals )
+;; ;  )
+(defmacro function-name
+[function]
+(list str (list 'quote function)))
+(defn make-vision-box
+"eventually I'll generalize this to arbitary functions and port names, but for now this is good enough"
+[function1 function2]
+(let [box (proxy [MultiFunctionBox] [] (getName [] "vision-box")
+		   (process1 [obj] (.transmit (Connections/getPorts this) (function1 obj)))
+		   (process2 [obj] (.transmit (Connections/getPorts this) (function2 obj))))]
+	(.addSignalProcessor (Connections/getPorts box) "PORT1" "process1")
+	(.addSignalProcessor (Connections/getPorts box) "PORT2" "process2")
+	box))
+;; (defn make-box
+;;   [name & functions]
+;;   (let [box (proxy [MultiFunctionBox] [] (getName [] name)
+;; 		   (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)]
+;; 		     ((symbol (str "process" (first indexed-fun)))
+;; 		      [obj] (.transmit (Connections/getPorts this) ((last indexed-fun) obj)))))]
+;;     (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)]
+;;       (.addSignalProcessor (Connections/getPorts box) (str "PORT" (first indexed-fun))  (str "process" (first indexed-fun))))
+;;     box))
+;; (defmacro proxy-functions
+;;   [ name & functions]
+;; (into
+;;  (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)]
+;;    (list (symbol (str "process" (first indexed-fun))) (vector 'obj)
+;; 	 (list '.transmit '(Connections/getPorts this) (list (last indexed-fun) 'obj))))
+;;  (list  (list 'getName (vector) name)   (vector) (vector MultiFunctionBox) 'proxy)))
+;; 		     ((symbol (str "process" (first indexed-fun)))
+;; 		      [obj] (.transmit (Connections/getPorts this) ((last indexed-fun) obj)))))
+;; (defmacro make-fun2-box
+;;   [name & functions]
+;; (defmacro make-fun-box
+;;   [name & functions]
+;;   (let [proxy-functions
+;; 	(for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)]
+;; 	   ((symbol (str "process" (first indexed-fun)))
+;; 		      [`obj#] (.transmit (Connections/getPorts 'this) ((last indexed-fun) `obj#))))]
+;;   `(let [box# (proxy [MultiFunctionBox] [] (getName [] ~name))]
+;;      ~proxy-functions
+;;     box#))
+;; (defmacro return
+;;   [name & functions]
+;;   (let [out (for [x functions]
+;;     x)]
+;;      out))
+(defn local-genesis
+"connects the custom vision interperter to genesis"
+[function1 function2]
+(let [vision-box (make-vision-box function1 function2) genesis (Genesis.) ]
+(Connections/wire Start/TRIPLES (.getStartParser genesis) "PORT1" vision-box)
+(Connections/wire NewHardWiredTranslator/RESULT (.getNewSemanticTranslator genesis) "PORT2" vision-box)
+genesis))
+(defn frame-hash
+"yields a convienent representation for the pixles in an image.
+Because of the size of the structvre generated, this must only be used
+in a transient way so that java can do it's garbage collection."
+[imagePlus]
+(with-meta
+(let [buf (.. imagePlus getBufferedImage)
+	color (.getColorModel buf)]
+(doall (apply hash-map
+	   (interleave
+	    (doall (for [x (range (.getWidth imagePlus)) y (range (.getHeight imagePlus))]
+	      (vector x y)))
+	    (doall (for [x (range (.getWidth imagePlus)) y (range (.getHeight imagePlus))]
+	     (let [data (.getRGB buf x y)]
+	      (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
+			:g (bit-shift-right (bit-and 0x00ff00 data) 8)
+			:b (bit-and 0x0000ff data)))))))))
+{:width  (.getWidth imagePlus) :height (.getHeight imagePlus)}))
+(defn vid-seq
+[video]
+(with-meta (doall (map frame-hash (video-seq video))) (video-data video)))
+(defn video-hash
+"turns an entire video into a nice hash-map
+.... or at least it would, if java didn't suck and only give me
+2 GB to work with with no way to increase it.
+linear processing... grumble grumble ....."
+[video-seq]
+(apply hash-map
+	 (interleave
+	  (naturals)
+	  (doall (map #(frame-hash %) video-seq)))))
+(defn frame-hash->bufferedImage
+[frame-hash]
+(let [data  (meta frame-hash)
+	image (BufferedImage. (:width data) (:height data) BufferedImage/TYPE_INT_BGR)]
+	(doall (for [element frame-hash]
+	  (let [coord  (key element)
+		rgb   (val element)
+		packed-RGB
+		(+ (bit-shift-left (:r rgb) 16)
+		   (bit-shift-left (:g rgb) 8)
+		                   (:b rgb))]
+	    (.setRGB image (first coord) (last coord) packed-RGB))))
+	image))
+(defmethod display
+clojure.lang.PersistentHashMap [frame-hash]
+(display (frame-hash->bufferedImage frame-hash)))
+(defmethod display
+clojure.lang.PersistentArrayMap [frame-hash]
+(display (frame-hash->bufferedImage frame-hash)))
+;; (defmethod display
+;;    clojure.lang.LazySeq [frame-hash]
+;;   (display (frame-hash->bufferedImage frame-hash)))
+(defn rectangle-window
+"efficiently grabs a rectangle from the frame-hash.
+Values that don't exisist in the picture are colored negative green!"
+[x y l w frame-hash]
+(let [coords (for [m (range (- x l) (+ 1 x l)) n (range (- y w) ( + 1 y w))] (vector m n))]
+(with-meta
+(zipmap
+coords
+(map #(frame-hash % {:r 0 :g -500 :b 0}) coords))
+(meta frame-hash))))
+(defn sum
+"squashes all the dinensions of the picture together into a single dimension
+sutiable for analysis."
+[window]
+(zipmap
+(keys window)
+(map (fn [rgb] (+ (:r rgb) (:b rgb) (:g rgb))) (vals window))))
+(defn b&w
+"turn everything grey"
+[window]
+(with-meta
+(zipmap
+(keys window)
+(map (fn  [rgb]
+	  (let [sum (int (/ (+ (:r rgb) (:b rgb) (:g rgb)) 3))]
+	    {:r sum :g sum :b sum })) (vals window))) (meta window)))
+(defn green-select-x-form
+"find green things"
+[window]
+(with-meta
+(zipmap
+(keys window)
+(map (fn  [rgb]
+	  (if (and (> (:g rgb) (:b rgb)) (> (:g rgb) (:r rgb)))
+	    rgb
+	    {:r 0 :g 0 :b 0})) (vals window))) (meta window)))
+(defn manual-line-detect
+"Ty as I might, this can never be truly effective until higher level
+processes contribute to dynamicaly adjusting these paramaters. For
+now I'll settle with simple manual calibration."
+[var1 mean1 var2 mean2]
+(>
+(if (or (< var1 250) (< var2 250))
+(abs (int (- mean1 mean2)))
+0) 55))
+;30 looks good
+(defn frame-windows
+"analyzes a frame in terms of lots of tiny windows which
+each try to find some sort of edge."
+([ x-form frame]
+(with-meta
+(let [width (:width  (meta frame) 500)
+	   height(:height (meta frame) 500 )]
+(filter (comp not nil?)
+	       (for [x (range 0 width 2) y (range 0 height 2)]
+		 (:line (window-line (rectangle-window x y 1 1 frame) (comp sum x-form) manual-line-detect))))) (meta frame)))
+([frame]  (frame-windows identity frame)))
+(defn static-segmentation
+"divides a single picture frame into appropiate objects using a
+simple watershed method based on sharp color variation.
+radius: the general size of the window in pixels
+gradient: threshold for a color gradient to be recognized as a edge"
+[radius gradient frame]
+(let [ah (frame-hash frame)]
+ah))
+(defn video-parse
+"this is the equilivalent to the S.T.A.R.T Parser for videos
+right now it's just a simple blob detector"
+[video-seq]
+)
+(defn overlay-draw
+[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 video-seq->b&w
+[video-seq]
+(with-meta
+(map #(ImagePlus. "B and W" (frame-hash->bufferedImage %))
+(map (fn [imgPlus]
+	   (let [play (frame-hash imgPlus)]
+	     (b&w play)))
+	 video-seq))
+(meta video-seq)))
+(defn vid-save
+[filename vid-seq]
+(trans-save filename
+	     (with-meta (map (comp #(ImagePlus. "reverse-x-form" %)  frame-hash->bufferedImage) vid-seq) (meta vid-seq))))
+;(def g0 (video-seq give0))
+(def gen (proxy [Genesis] [] ))
+(def short-give  (with-meta (take 60 (drop 30 (video-seq give0))) {:fps 30 :width 320 :height 240 }))
+(def sg short-give)
+(def g1 (first sg))
+(def gs sg)
+(def play  (frame-hash (first sg)))
+(def blank (with-meta (zipmap (keys play) (repeat (count play) {:r 0 :g 0 :b 0})) (meta play)))
+(def blank (with-meta (zipmap (keys play) (repeat (count play) {:r 0 :g 0 :b 0})) (meta play)))
+(def b+w-play (b&w play))
+(def rgb (rectangle-window 50 50 1 1 play))
+(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)))
+(def invertedColorPlay (with-meta (zipmap (keys play) (map #(hash-map :r (- 255 (:r %)) :g (- 255 (:g %)) :b (- 255 (:b %))) (vals play))) (meta play)))
+(def play1 (with-meta (frame-hash (nth sg 0)) {:width 320 :height 240}))
+(def play2 (with-meta (frame-hash (nth sg 1)) {:width 320 :height 240}))
+(def play3 (with-meta (frame-hash (nth sg 2)) {:width 320 :height 240}))
+(def play4 (with-meta (frame-hash (nth sg 3)) {:width 320 :height 240}))
+(def play5 (with-meta (frame-hash (nth sg 4)) {:width 320 :height 240}))
+(comment
+ok here's the plan--
+"genesis/language"
+raw text -> START -> representations/memory -> story tree
+"genesis/vision"
+raw video -> blob detector -> representations/memory -> event/structure tree
+first, we start off with a video.
+the video get's passed through the blob detector.
+(blob-detector
+first-pass-  divide up each frame into exasutive polygons. no temporal dependence
+second-pass- do a pairwise comparison of frames to link the polygons from each frame.
+polygons can either split apart or merge, but this step establishes their geneology.
+third-pass-  link the polygons together into higher objects using hueristic rules about motion
+these rules are determined by the language system, but for now they will be hardcoded.
+the only thing for now is that things that move together are the same object.
+)
+so now, we have a temporal history of polygons.
+the language part of the story may specify that certain characters
+with certain qualities do certain actions.
+"Bob is wearing a red shirt. Shirts are big. Bob is a person.
+Mary is wearing a green shirt.
+Bob is person-sized.
+Bob is moving.
+The green object is a ball.
+Bob gives the ball to Mary."
+Now, Genesis can select just the polygons that are important to the story,
+and it also learns important facts such as the relative size of a person to a ball.
+The details which are captured in the polygon-transition space are--
+x (location of the center of each polygon), dx/dt , ((d^2)x)/(dt)^2, color (average), [left|right], polygon area
+polygon shape
+This information recurses on every component polygon as well.
+When genesis want's to learn about verbs in particular,
+it selects the aproapiate blobs from the linguistic desctiption (in bob's
+case it's "the big red blob on the left", for example.)
+after selecting a subset of the blobs, it calculates the angles and distances between
+those blobs' centers as erll as whether they are touching or overlaping.
+From this sequence it derives an example of the verb.
+From other examples it can do arch earning to refine the sequence to its salient features.
+)
+(comment (things you can do that will actually work!)
+(do (use :reload-all 'clojureDemo.GenesisPlay) (in-ns 'clojureDemo.GenesisPlay))
+;genesis integration:
+(def gen5 (make-generator-box "the 5th element" 5))
+(Connections/wire gen5 (make-box "printer" println))
+(Connections/viewNetwork)
+(.process gen5 :ignore) ; causes 5 to be printed
+(Connections/obliterateNetwork)
+(.process gen5 :ignore); since the network connections were dissolved, nothing prints.
+)

Mercurial > lasercutter

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