1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojureDemo/ArchLearning.clj	Fri Aug 20 00:32:44 2010 -0400
     1.3 @@ -0,0 +1,562 @@
     1.4 +(ns clojureDemo.ArchLearning
     1.5 +  (:gen-class
     1.6 +   :implements [connections.WiredBox]
     1.7 +   :methods [ [process [Object] void] [setFile [Object] void] ]
     1.8 +   :post-init register))
     1.9 +
    1.10 +(use 'clojure.contrib.import-static)
    1.11 +(import '(java.io File))
    1.12 +(import '(org.apache.commons.io FileUtils))
    1.13 +(import '(javax.imageio ImageIO) )
    1.14 +(import '(javax.swing JFrame))
    1.15 +(import '(java.awt Color BorderLayout))
    1.16 +(import '(ij.plugin PlugIn))
    1.17 +(import '(ij ImagePlus IJ))
    1.18 +(import '(java.lang Math))
    1.19 +(import '(java.awt Polygon))
    1.20 +(import '(java.awt.geom Line2D$Double))
    1.21 +
    1.22 +(use 'clojureDemo.appeture)
    1.23 +
    1.24 +(import-static java.lang.Math pow abs)
    1.25 +
    1.26 +(import '(ij Macro))
    1.27 +
    1.28 +(import '(java.io BufferedReader InputStreamReader))
    1.29 +(import '(java.awt.image BufferedImage))
    1.30 +(import '(genesis Genesis))
    1.31 +(import '(utils Mark))
    1.32 +(import '(capenLow StoryProcessor))
    1.33 +(import '(connections Connections WiredBox))
    1.34 +(import '(specialBoxes BasicBox MultiFunctionBox))
    1.35 +(import '(engineering NewHardWiredTranslator))
    1.36 +
    1.37 +(import '(java.awt Polygon))
    1.38 +(import '(java.awt.geom Line2D$Double))
    1.39 +(use 'clojure.contrib.str-utils)
    1.40 +
    1.41 +
    1.42 +;genesis imports
    1.43 +(import '(http Start))
    1.44 +
    1.45 +
    1.46 +(use '[clojureDemo.Xuggle :only (video-seq trans-save flash display video-data)])
    1.47 +(use 'clojureDemo.MegaDeath)
    1.48 +
    1.49 +
    1.50 +(use 'clojure.contrib.combinatorics)
    1.51 +
    1.52 +(use 'clojure.contrib.repl-utils)
    1.53 +
    1.54 +(use 'clojureDemo.GenesisPlay)
    1.55 +
    1.56 +(use ['clojureDemo.Defines 
    1.57 +      :only '(
    1.58 +	     lian look getto human0 blow base app0 app1 app2 app3 app4 app5 
    1.59 +		  bounce0 bounce1 bounce2 bounce3 bounce4 bounce5 bounce6
    1.60 +		  collide0 collide1 collide2 collide3 collide4  
    1.61 +		  give0 give1 give2 give3 give4 target default)])
    1.62 +
    1.63 +(defn -register
    1.64 +   "equivalent to Connections.getPorts(this).addSignalProcessor(\"process\"); in Java"
    1.65 +   [this]
    1.66 +   (println "ClojureBox (register) : Register is run 
    1.67 +    only when the object is created, as if it were a constructor.")
    1.68 +   (. (connections.Connections/getPorts this) addSignalProcessor "process"))
    1.69 +
    1.70 +(defn -process [ this obj ]
    1.71 +  (println "ClojureBox (process) :  This is a LISP function, 
    1.72 +   being called through Java, through the wiredBox metaphor.")
    1.73 +  (.transmit (Connections/getPorts this)  obj))
    1.74 +
    1.75 +(defn -getName
    1.76 +  "the [_] means that  the function gets an explicit 'this'
    1.77 +    argument, just like python. In this case we don't care about it."
    1.78 +  [_]  "ArchLearning")
    1.79 +
    1.80 +
    1.81 +
    1.82 +
    1.83 +
    1.84 +(def output-base (File. "/home/r/Desktop/output-vision"))
    1.85 +(def rsgs (with-meta (take 10 gs) (meta gs)))
    1.86 +(def rrsgs (with-meta (take 3 rsgs) (meta gs)))
    1.87 +; a concept is going to be derived from Genesis' own xml based representations.
    1.88 +; this is an form of archlearning which figures out a function that representes
    1.89 +; the concepts.
    1.90 +
    1.91 +
    1.92 +(def black {:r 0  :g 0 :b 0})
    1.93 +(def white {:r 255 :g 255 :b 255})
    1.94 +
    1.95 +
    1.96 +(defn window-frame
    1.97 +  "analyzes a frame in terms of lots of tiny windows which 
    1.98 +   each try to find some sort of edge. keeps coordinates."
    1.99 +  ([x-form frame]
   1.100 +     (let [lines (frame-windows x-form frame)]
   1.101 +       (zipmap (for [x lines] (first (rest x)))
   1.102 +	       lines)))
   1.103 +  ([frame]
   1.104 +     (window-frame identity frame)))
   1.105 +
   1.106 +
   1.107 +(defn intense-select-x-form
   1.108 +  "discard silly gray things"
   1.109 +  [window]
   1.110 +  (with-meta
   1.111 +    (zipmap
   1.112 +     (keys window)
   1.113 +     (map (fn  [rgb]
   1.114 +	    (let [spread (- (max (:r rgb) (:g rgb) (:b rgb)) (min (:r rgb) (:g rgb) (:b rgb)))]
   1.115 +	      (if (> spread 45)
   1.116 +		rgb
   1.117 +		{:r 0 :g 0 :b 0}))) (vals window)))  (meta window)))
   1.118 +
   1.119 +(defn edges-x-form
   1.120 +  [window]
   1.121 +  (frame-hash (ImagePlus. "sad :(" (overlay-draw blank (frame-windows window)))))
   1.122 +
   1.123 +   
   1.124 +
   1.125 +(defn rgb-max
   1.126 +  [rgb1 rgb2]
   1.127 +  {:r (max (:r rgb1) (:r rgb2))
   1.128 +   :g (max (:g rgb1) (:g rgb2))
   1.129 +   :b (max (:b rgb1) (:b rgb2))})
   1.130 +
   1.131 +(defn frame-hash-add
   1.132 +  [frame1 frame2]
   1.133 +  (with-meta
   1.134 +  (let [indexes (apply hash-set (concat (keys frame1) (keys frame2)))]
   1.135 +    (zipmap indexes (for [x indexes] (rgb-max (frame1 x black)  (frame2 x black))))) (meta frame1)))
   1.136 +
   1.137 +
   1.138 +
   1.139 +(defn vid-seq-add
   1.140 +  "for black and white video-sequences. Just adds them together into one image sequence"
   1.141 +  [vid-seq1 vid-seq2]
   1.142 +  (with-meta 
   1.143 +    (map  #(ImagePlus. "ADD B&W" (frame-hash->bufferedImage %)) (map frame-hash-add (map frame-hash vid-seq1) (map frame-hash vid-seq2)))
   1.144 +    (meta vid-seq1)))
   1.145 +
   1.146 +(defn edges-center-draw
   1.147 +  ([base edges]
   1.148 +     (frame-hash-add
   1.149 +      base
   1.150 +      (zipmap (keys edges) (repeat white))))
   1.151 +  ([edges]
   1.152 +     (edges-center-draw blank edges)))
   1.153 +
   1.154 +(defn edge-dot-x-form
   1.155 +  "gives a new frame-hash with only the edge points, all white."
   1.156 +  [frame]
   1.157 +  (edges-center-draw (window-frame frame)))
   1.158 +
   1.159 +  
   1.160 +(defn rgb-euclidian
   1.161 +  [{r1 :r g1 :g b1 :b} {r2 :r g2 :g b2 :b} ]
   1.162 +  (pow (+ (pow (- r1 r2) 2)
   1.163 +	  (pow (- g1 g2) 2)
   1.164 +	  (pow (- b1 b2) 2)) 0.5))
   1.165 +  
   1.166 +(defn rgb-sub
   1.167 +  [tolerance rgb1 rgb2]
   1.168 +  (if (< (rgb-euclidian rgb1 rgb2) tolerance) black white))
   1.169 +
   1.170 +
   1.171 +
   1.172 +(defn frame-subtract
   1.173 +  [tolerance frame1 frame2]
   1.174 +  (with-meta
   1.175 +  (let [indexes (apply hash-set (concat (keys frame1) (keys frame2)))]
   1.176 +    (zipmap indexes (for [x indexes] (rgb-sub tolerance (frame1 x)  (frame2 x))))) (meta frame1)))
   1.177 +
   1.178 +
   1.179 +(defn image-subtract
   1.180 +  [tolerance [img1 img2]]
   1.181 +  (frame-subtract tolerance (frame-hash img1) (frame-hash img2)))
   1.182 +
   1.183 +
   1.184 +(defn motion-detect
   1.185 +  ([tolerance video-seq]
   1.186 +     (with-meta
   1.187 +       (map (partial image-subtract tolerance) (partition 2 1 video-seq)) (meta video-seq)))
   1.188 +  ([video-seq]
   1.189 +     (motion-detect 40 video-seq)))
   1.190 +
   1.191 +(defn motion-x-form
   1.192 +  ([tolerance video-seq]
   1.193 +     (with-meta    
   1.194 +       (map  #(ImagePlus. "motion-detect!" (frame-hash->bufferedImage %)) (motion-detect tolerance video-seq))
   1.195 +       (meta video-seq)))
   1.196 +  ([video-seq] 
   1.197 +     (motion-x-form 40 video-seq)))
   1.198 +;the edge detector is what finds objects.
   1.199 +;movement disambiguates between different ways of interperting what objects are there
   1.200 +;color / other qualifiers enable focus on a subset of objects, and can give objects names.
   1.201 +
   1.202 +
   1.203 +
   1.204 +  
   1.205 +
   1.206 +(defn find-an-object
   1.207 +  "tries to find a single object from the current sensory-buffer, which
   1.208 +   is a video-seq for now. My idea here is for this to feed-back on itself,
   1.209 +   adjusting parameters till it can find it's target, and then using those 
   1.210 +   to construct an representation of the object in terms of how to find it using
   1.211 +   other visual routines paramaters."
   1.212 +  [video-seq])
   1.213 +
   1.214 +
   1.215 +
   1.216 +(defn transform
   1.217 +  [x-form video-seq]
   1.218 +  (with-meta
   1.219 +    (map (fn [imgPlus]
   1.220 +	   (let [play (frame-hash imgPlus)]
   1.221 +	     (x-form play)))
   1.222 +	 video-seq)
   1.223 +    (meta video-seq)))
   1.224 +
   1.225 +
   1.226 +(defn apply-x-form
   1.227 +  [x-form video-seq]
   1.228 +  (with-meta
   1.229 +    (map #(ImagePlus. "transformed!" (frame-hash->bufferedImage %))
   1.230 +	 (map (fn [imgPlus]
   1.231 +		(let [play (frame-hash imgPlus)]
   1.232 +		  (x-form play)))
   1.233 +	      video-seq))
   1.234 +    (meta video-seq)))
   1.235 +
   1.236 +
   1.237 +
   1.238 +(defn only-white
   1.239 +  "reduce the image to only its white points"
   1.240 +  [window]
   1.241 +  (with-meta
   1.242 +  (let [new-keys
   1.243 +	(filter  #(= white (window %)) (keys window))]
   1.244 +    (zipmap new-keys (map window new-keys))) (meta window)))
   1.245 +
   1.246 +
   1.247 +
   1.248 +
   1.249 +(defn white-sum 
   1.250 + [& rgbs]
   1.251 + (let[ wht-map {white 1}]
   1.252 + (reduce + (map #(wht-map % 0) rgbs))))
   1.253 +
   1.254 +(defn island?
   1.255 +  "return false if there's nothing around it within a certain radius"
   1.256 +  [window [x y]]
   1.257 +  (let [radius 3]
   1.258 +    (<= (apply white-sum (vals (rectangle-window x y radius radius window))) 1)))
   1.259 +
   1.260 +(defn white-border
   1.261 +  "anything that relies on a hack like this to work is wrong"
   1.262 +  [window]
   1.263 +  (with-meta
   1.264 +    (let [info (meta window)]
   1.265 +      (into window
   1.266 +	    (zipmap
   1.267 +	     (for [x (range (:width info)) y (range (:height info)) 
   1.268 +		   :when (or (= (-(:width info) 1) x) (= (- (:height info) 1) y) (= 0 y) (= 0 x))] [x y])
   1.269 +	     (repeat white))))(meta window)))
   1.270 +
   1.271 +(defn polygonize
   1.272 +   "for each edge-point, try to connect it with all the edge points around it, 
   1.273 +   or obliterate it if it doesn't have any edge points close by."
   1.274 +  [window]
   1.275 +  (with-meta
   1.276 +  (let [edges (only-white window)]
   1.277 +    (let [new-keys
   1.278 +	  (filter (comp not (partial island? window)) (keys window))]
   1.279 +      (let [ready-points (zipmap new-keys (map window new-keys))]
   1.280 + (meta window))))))
   1.281 +
   1.282 +
   1.283 +(defn connect-the-dots
   1.284 +  [radius window]
   1.285 +  (let [edge-points (white-border (only-white window))
   1.286 +	image  (frame-hash->bufferedImage window)
   1.287 +	g2 (.getGraphics image)]
   1.288 +    (doall
   1.289 +     (for [[x y] (keys edge-points)]
   1.290 +       
   1.291 +       (let [points  (apply cartesian-product (repeat 2 (keys (only-white (rectangle-window x y radius radius edge-points)))))]
   1.292 +	(if (not (empty? points))
   1.293 +	  (doall
   1.294 +	  (for [[[x1 y1][x2 y2]] points]
   1.295 +	    (.drawLine g2 x1 y1 x2 y2)))))))
   1.296 +    (frame-hash (ImagePlus. "stupid..."  image))))
   1.297 +
   1.298 + 
   1.299 +(defn blob-x-form
   1.300 +  [window]
   1.301 +  (with-meta 
   1.302 +    ((comp (partial connect-the-dots 4) edge-dot-x-form) window)
   1.303 +  (meta window)))
   1.304 +
   1.305 +
   1.306 +
   1.307 +
   1.308 +(defn connect-points
   1.309 + [frame-hash overlay]
   1.310 + (let [image  (frame-hash->bufferedImage frame-hash)
   1.311 +       g2 (.getGraphics image)]
   1.312 +   (doall (for [ x overlay] 
   1.313 +     (let [x1 (ffirst x) y1 (second (first x)) x2 (first (last x)) y2 (last (last x))] 
   1.314 +       (.drawLine g2 x1 y1 x2 y2))))
   1.315 +     image))
   1.316 +
   1.317 +
   1.318 +(defn disambiguate-edges
   1.319 +  "Like in project Prakesh, the thing that lets you discern shapes
   1.320 +   is watching them *move* coherently. After many months of this 
   1.321 +   motion-boosting, the edge-detector itself becomes good enogh to 
   1.322 +   analyze static pictures without motion.  This function takes edges
   1.323 +   and tries to combine them into lines, dividing the world into
   1.324 +   polygonal regions.  Motion is used to associate two regions together.
   1.325 +   associated with those points, that information is also used."
   1.326 +  [edges motion]
   1.327 +)
   1.328 +  
   1.329 +
   1.330 +(defn triple-seq
   1.331 +  [triple]
   1.332 +  (list (.getFirst triple) (.getSecond triple) (.getThird triple)))
   1.333 +
   1.334 +(defn contains-word?
   1.335 +  [word triple]
   1.336 +  (contains? (set  (map (fn [s] (re-sub #"-\d+" "" s)) (triple-seq triple))) word))
   1.337 +
   1.338 +
   1.339 +(defn write 
   1.340 +  [reference]
   1.341 +  (fn [x] (dosync 
   1.342 +	   (println "wrote "  " to " "ref.")
   1.343 +	   (ref-set reference x))))
   1.344 +
   1.345 +
   1.346 +;; (defn join-point-lists
   1.347 +;;   [pointlist1 pointlist2]
   1.348 +;;   (for [x  :while (not(= x 5))] x)))
   1.349 +
   1.350 +(defn extract-single-blob
   1.351 +  "find the biggest blob in an image and return it"
   1.352 +  [window]
   1.353 +  ;we're assuming that there are only blobs left -- funning this on an unprocessed
   1.354 +  ;image will just return the entire image
   1.355 +  (map list window))
   1.356 +
   1.357 +
   1.358 +
   1.359 +
   1.360 +(def gen-out (ref nil))
   1.361 +(def triple (ref nil))
   1.362 +
   1.363 +
   1.364 +
   1.365 +(def gen1 (ref ()))
   1.366 +(def gen2 (ref ()))
   1.367 +(def gen3 (ref ()))
   1.368 +(def gen4 (ref ()))
   1.369 +(def gen5 (ref ()))
   1.370 +(def gen6 (ref ()))
   1.371 +(def gen7 (ref ()))
   1.372 +(def gen8 (ref ()))
   1.373 +
   1.374 +
   1.375 +(defn make-color-generator
   1.376 +  []
   1.377 + (let [r (java.util.Random. 58)
   1.378 +       g (java.util.Random. 125)
   1.379 +       b (java.util.Random. 8)]
   1.380 +   #(hash-map :r (.nextInt r 255)  :g (.nextInt r 255)   :b (.nextInt r 255))))
   1.381 +
   1.382 +
   1.383 +;a blob is a collection of:
   1.384 +;points, colors
   1.385 +;other blobs
   1.386 +;so, a window is a blob too.
   1.387 +
   1.388 +
   1.389 +
   1.390 +
   1.391 +
   1.392 +
   1.393 +;; (defn blob-color-absob
   1.394 +;;   [blob1 blob2]
   1.395 +;;   (if (and (< (rgb-euclidian (color-avg blob1) (color-avg blob2)) 20) (close-together blob1 blob2))
   1.396 +;;     (combine blob1 blob2)
   1.397 +;;     '(blob1 blob2)))
   1.398 +  
   1.399 +
   1.400 +(defn make-test-box
   1.401 +  "stupid."
   1.402 +  []
   1.403 +  (let [box (proxy [MultiFunctionBox] [] (getName [] "test-box [clojure]") 
   1.404 +		   (process1 [obj] ((write gen1) obj))
   1.405 +		   (process2 [obj] ((write gen2) obj))
   1.406 +		   (process3 [obj] ((write gen3) obj))
   1.407 +		   (process4 [obj] ((write gen4) obj))
   1.408 +		   (process5 [obj] ((write gen5) obj))
   1.409 +		   (process6 [obj] ((write gen6) obj))
   1.410 +		   (process7 [obj] ((write gen7) obj))
   1.411 +		   (process8 [obj] ((write gen8) obj)))]
   1.412 +    
   1.413 +    (.addSignalProcessor (Connections/getPorts box) "PORT1" "process1")
   1.414 +    (.addSignalProcessor (Connections/getPorts box) "PORT2" "process2")
   1.415 +    (.addSignalProcessor (Connections/getPorts box) "PORT3" "process3")
   1.416 +    (.addSignalProcessor (Connections/getPorts box) "PORT4" "process4")
   1.417 +    (.addSignalProcessor (Connections/getPorts box) "PORT5" "process5")
   1.418 +    (.addSignalProcessor (Connections/getPorts box) "PORT6" "process6")
   1.419 +    (.addSignalProcessor (Connections/getPorts box) "PORT7" "process7")
   1.420 +    (.addSignalProcessor (Connections/getPorts box) "PORT8" "process8")
   1.421 +    box))
   1.422 +
   1.423 +
   1.424 +
   1.425 +(defn writer-box
   1.426 +  [reference]
   1.427 +  (let [box (proxy [MultiFunctionBox] [] 
   1.428 +	      (getName [] "ref-set\n [clojure]")
   1.429 +	      (process1 [obj] ((write reference) obj)))]
   1.430 +     (.addSignalProcessor (Connections/getPorts box) "process1")
   1.431 +     box))
   1.432 +
   1.433 +
   1.434 +
   1.435 +
   1.436 +(def triples  (ref ()))
   1.437 +(def parse    (ref ()))
   1.438 +(def raw      (ref ()))
   1.439 +(def idioms   (ref ()))
   1.440 +(def yes-no   (ref ()))
   1.441 +(def imagine  (ref ()))
   1.442 +(def traj     (ref ()))
   1.443 +(def action   (ref ()))
   1.444 +(def transfer (ref ()))
   1.445 +(def pix      (ref ()))
   1.446 +(def property (ref ()))
   1.447 +
   1.448 +(use 'clojure.contrib.str-utils)
   1.449 +
   1.450 +(defn process-video-and-subtitles
   1.451 +  [this file]
   1.452 +  ;we're looking for a text file of the same name as the video file.
   1.453 +  (let [subtitles (File. (.getParent file) (str (last (first (re-seq #"(^.*)\.avi$" (.getName file)))) ".txt"))]
   1.454 +    (dorun 
   1.455 +    (for [line (re-split #"\n" (slurp (str subtitles)))]
   1.456 +      (do (println line)
   1.457 +      (.transmit (Connections/getPorts this)  line)))))
   1.458 +  (display (first (video-seq file))))
   1.459 +
   1.460 +(defn process-triple
   1.461 +  [this triple]
   1.462 +  (println "RLM [vision-box]: " triple))
   1.463 +
   1.464 +(defn visionBox
   1.465 +  []
   1.466 +  (let [box (proxy [MultiFunctionBox] [] 
   1.467 +	      (getName [] "VisionBox \n [clojure]")
   1.468 +	      (process1 [obj] (process-video-and-subtitles this obj))
   1.469 +	      (process2 [obj] (process-triple this obj)))]
   1.470 +  (.addSignalProcessor (Connections/getPorts box) "video-in" "process1")
   1.471 +  (.addSignalProcessor (Connections/getPorts box) "triple-in" "process2")
   1.472 +
   1.473 +  (println "the good box")
   1.474 +  box))
   1.475 +
   1.476 +  
   1.477 +
   1.478 +
   1.479 +
   1.480 +(defn custom-genesis
   1.481 +  "connects the writer boxes to genesis"
   1.482 +  []
   1.483 +  (Connections/obliterateNetwork)
   1.484 +  (let [stupid-box (make-test-box) genesis (Genesis.) vis-box (visionBox) ]
   1.485 +    (Connections/wire "tripple port" (.getStartParser genesis) (writer-box triples))
   1.486 +    (Connections/wire "parse" (.getStartParser genesis) (writer-box parse))
   1.487 +    (Connections/wire "result" (.getNewSemanticTranslator genesis) (writer-box raw))
   1.488 +    (Connections/wire (.getIdiomExpert genesis) (writer-box idioms))
   1.489 +    (Connections/wire "yes-no question" (.getCommandExpert genesis) (writer-box yes-no))
   1.490 +    (Connections/wire "imagine" (.getCommandExpert genesis)  (writer-box imagine))
   1.491 +    (Connections/wire "viewer" (.getTrajectoryExpert genesis) (writer-box traj))
   1.492 +    (Connections/wire "viewer" (.getActionExpert genesis) (writer-box action))
   1.493 +    (Connections/wire "next" (.getTransferExpert genesis) (writer-box transfer))
   1.494 +    (Connections/wire  (.getRachelsPictureFinder genesis) (writer-box pix))
   1.495 +    (Connections/wire "viewer" (.getPropertyExpert genesis) (writer-box property))
   1.496 +    (Connections/wire "tripple port" (.getStartParser genesis) "triple-in" vis-box)
   1.497 +    
   1.498 +
   1.499 +    (Connections/wire (.getArchLearning genesis) "video-in" vis-box)
   1.500 +    (Connections/wire  vis-box "sentence" (.getStartParser genesis))
   1.501 +    
   1.502 + genesis))
   1.503 +
   1.504 +
   1.505 +(use 'clojure.contrib.def)
   1.506 +
   1.507 +(defvar learning-hash  {}
   1.508 +  "Right now this serves as the visual memory.  
   1.509 +   It's full of verbs/objects and the programs
   1.510 +   that find them.")
   1.511 +
   1.512 +(def green {:r 0 :g 200 :b 0})
   1.513 +(def blue  {:r 0  :g 0  :b 255})
   1.514 +(def red   {:r 255 :g 0 :b 0})
   1.515 +
   1.516 +
   1.517 +(defn color-similar?
   1.518 +  [threshold window color coord]
   1.519 +  (< (rgb-euclidian (window coord) color) threshold))
   1.520 +;should also have the same "shape" here
   1.521 +
   1.522 +(defn color-select
   1.523 +     [threshold color window]
   1.524 +     (with-meta
   1.525 +       (let [new-keys
   1.526 +	     (filter  (partial color-similar? threshold window color) (keys window))]
   1.527 +	 (zipmap new-keys (map window new-keys)))
   1.528 +	   (meta window)))
   1.529 +
   1.530 +
   1.531 +
   1.532 +(defn object-sequence
   1.533 +  "get's the largest blob of the given color from a video sequence."
   1.534 +  [color video-seq]
   1.535 + (apply-x-form (comp (partial color-select 135 color) intense-select-x-form) rrsgs))
   1.536 +
   1.537 +(defn -setFile
   1.538 +  [this file]
   1.539 +  (println "file is " file)
   1.540 +  (.process this file))
   1.541 +
   1.542 +
   1.543 +
   1.544 +
   1.545 +(comment (things you can do that will actually work!)
   1.546 +
   1.547 +(do (use :reload-all 'clojureDemo.ArchLearning) (in-ns 'clojureDemo.ArchLearning))
   1.548 +
   1.549 +(display (overlay-draw (green-select-x-form play) (frame-windows green-select-x-form play )))
   1.550 +
   1.551 +;vision stuff
   1.552 +
   1.553 +(def edgesD (transform window-frame rrsgs))
   1.554 +
   1.555 +(doall 
   1.556 + (def edgesI (apply-x-form edges-x-form rrsgs))
   1.557 + (display (rectangle-window 50 50 50 50 (frame-hash (nth edgesI 1))))
   1.558 + )
   1.559 +
   1.560 +(def polyjuice (white-border (only-white (edge-dot-x-form play))))
   1.561 +
   1.562 +(count  (color-select 135 red (intense-select-x-form (frame-hash (last sg)))))
   1.563 +(trans-save (File. output-base "only-red.avi")(apply-x-form (comp (partial color-select 135 red) intense-select-x-form) rrsgs))
   1.564 +)
   1.565 +

     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/src/clojureDemo/BasicVision.clj	Fri Aug 20 00:32:44 2010 -0400
     2.3 @@ -0,0 +1,85 @@
     2.4 +(ns clojureDemo.BasicVision)
     2.5 +
     2.6 +
     2.7 +(use 'clojure.contrib.import-static)
     2.8 +(import '(java.io File))
     2.9 +(import '(org.apache.commons.io FileUtils))
    2.10 +(import '(javax.imageio ImageIO) )
    2.11 +(import '(javax.swing JFrame))
    2.12 +(import '(java.awt Color BorderLayout))
    2.13 +(import '(ij.plugin PlugIn))
    2.14 +(import '(ij ImagePlus IJ))
    2.15 +(import '(java.lang Math))
    2.16 +(import '(java.awt Polygon))
    2.17 +(import '(java.awt.geom Line2D$Double))
    2.18 +
    2.19 +(use 'clojureDemo.appeture)
    2.20 +
    2.21 +(import-static java.lang.Math pow abs)
    2.22 +
    2.23 +(import '(ij Macro))
    2.24 +
    2.25 +(import '(java.io BufferedReader InputStreamReader))
    2.26 +(import '(java.awt.image BufferedImage))
    2.27 +(import '(genesis Genesis))
    2.28 +(import '(utils Mark))
    2.29 +(import '(capenLow StoryProcessor))
    2.30 +(import '(connections Connections WiredBox))
    2.31 +(import '(specialBoxes BasicBox MultiFunctionBox))
    2.32 +(import '(engineering NewHardWiredTranslator))
    2.33 +
    2.34 +(import '(java.awt Polygon))
    2.35 +(import '(java.awt.geom Line2D$Double))
    2.36 +(use 'clojure.contrib.str-utils)
    2.37 +
    2.38 +
    2.39 +;genesis imports
    2.40 +(import '(http Start))
    2.41 +
    2.42 +
    2.43 +(use '[clojureDemo.Xuggle :only (video-seq trans-save flash display video-data)])
    2.44 +(use 'clojureDemo.MegaDeath)
    2.45 +
    2.46 +
    2.47 +(use 'clojure.contrib.combinatorics)
    2.48 +
    2.49 +(use 'clojure.contrib.repl-utils)
    2.50 +
    2.51 +(use 'clojureDemo.GenesisPlay)
    2.52 +(use 'clojureDemo.ArchLearning)
    2.53 +
    2.54 +(use ['clojureDemo.Defines 
    2.55 +      :only '(
    2.56 +	     lian look getto human0 blow base app0 app1 app2 app3 app4 app5 
    2.57 +		  bounce0 bounce1 bounce2 bounce3 bounce4 bounce5 bounce6
    2.58 +		  collide0 collide1 collide2 collide3 collide4  
    2.59 +		  give0 give1 give2 give3 give4 target default)])
    2.60 +
    2.61 +
    2.62 +
    2.63 +; a concept is going to be derived from Genesis' own xml based representations.
    2.64 +; this is an form of archlearning which figures out a function that representes
    2.65 +; the concepts.
    2.66 +
    2.67 +
    2.68 +     
    2.69 +
    2.70 +
    2.71 +
    2.72 +
    2.73 +
    2.74 +
    2.75 +
    2.76 +
    2.77 +
    2.78 +
    2.79 +
    2.80 +
    2.81 +
    2.82 +
    2.83 +
    2.84 +
    2.85 +(comment
    2.86 +
    2.87 +(do (use :reload-all 'clojureDemo.BasicVision) (in-ns 'clojureDemo.BasicVision))
    2.88 +)

     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/src/clojureDemo/Defines.clj	Fri Aug 20 00:32:44 2010 -0400
     3.3 @@ -0,0 +1,46 @@
     3.4 +(ns clojureDemo.Defines)
     3.5 +
     3.6 +(import '(java.io File))
     3.7 +
     3.8 +(def -inf Double/NEGATIVE_INFINITY)
     3.9 +(def inf  Double/POSITIVE_INFINITY)
    3.10 +
    3.11 +
    3.12 +(def lian (File. "/home/r/Desktop/source-videos/lian1.mpeg"))
    3.13 +(def look (File. "/home/r/Desktop/source-videos/dramatic_look.flv"))
    3.14 +(def getto(File. "/home/r/Desktop/source-videos/Ghetto.flv"))
    3.15 +(def human0(File. "/home/r/Desktop/source-videos/vsr1/human0.avi"))
    3.16 +(def blow (File. "/home/r/Desktop/source-videos/blow.avi"))
    3.17 +
    3.18 +(def base (File. "/home/r/Desktop/source-videos/"))
    3.19 +
    3.20 +(def app0 (File. base "approach0v2.avi"))
    3.21 +(def app1 (File. base "approach1v3.avi"))
    3.22 +(def app2 (File. base "approach0v3.avi"))
    3.23 +(def app3 (File. base "approach2v2.avi"))
    3.24 +(def app4 (File. base "approach1v2.avi")) 
    3.25 +(def app5 (File. base "approach2v3.avi"))
    3.26 +  
    3.27 +(def bounce0 (File. base "bounce0v2.avi"))  
    3.28 +(def bounce1 (File. base "bounce1v3.avi")) 
    3.29 +(def bounce2 (File. base "bounce3v2.avi"))
    3.30 +(def bounce3 (File. base "bounce0v3.avi"))  
    3.31 +(def bounce4 (File. base "bounce2v2.avi"))
    3.32 +(def bounce5 (File. base "bounce1v2.avi"))  
    3.33 +(def bounce6 (File. base "bounce2v3.avi"))
    3.34 +
    3.35 +(def collide0 (File. base "collide0v3.avi"))  
    3.36 +(def collide1 (File. base "collide2v3.avi")) 
    3.37 +(def collide2 (File. base "collide1v2.avi"))
    3.38 +(def collide3 (File. base "collide0v2.avi"))  
    3.39 +(def collide4 (File. base "collide1v3.avi")) 
    3.40 +  
    3.41 +(def give0 (File. base "give0v3.avi"))  
    3.42 +(def give1 (File. base "give2v3.avi")) 
    3.43 +(def give2 (File. base "give1v2.avi")) 
    3.44 +(def give3 (File. base "give0v2.avi"))        
    3.45 +(def give4 (File. base "give1v3.avi"))
    3.46 +
    3.47 +
    3.48 +(def target (File. "/home/r/Desktop/output-vision/"))
    3.49 +(def default(File. target "default.avi"))

     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/src/clojureDemo/FaceDetect.clj	Fri Aug 20 00:32:44 2010 -0400
     4.3 @@ -0,0 +1,70 @@
     4.4 +(ns clojureDemo.FaceDetect
     4.5 +  (:import (javax.swing JFrame JLabel Timer)
     4.6 +	   (java.awt.event ActionListener KeyAdapter)
     4.7 +	   (java.awt Canvas Image Color)
     4.8 +	   (java.awt.image MemoryImageSource)
     4.9 +	   (hypermedia.video OpenCV)))
    4.10 +
    4.11 +;this will not work with the current setup;
    4.12 +;it's just here as a reference for how to access
    4.13 +;cameras.
    4.14 +
    4.15 +(def frame-rate (int 1000/30))
    4.16 +(def width 640)
    4.17 +(def height 480)
    4.18 +
    4.19 +(defn vision []
    4.20 +  (doto (OpenCV.)
    4.21 +    (.capture width height)
    4.22 +    (.cascade OpenCV/CASCADE_FRONTALFACE_ALT)
    4.23 +))
    4.24 +
    4.25 +(defn capture-image [vis]
    4.26 +  (.read vis)
    4.27 +  (let [mis (MemoryImageSource. (.width vis) (.height vis)
    4.28 +				(.pixels vis) 0 (.width vis))]
    4.29 +    (.createImage (Canvas.) mis)))
    4.30 +
    4.31 +(defn detect-face [vis]
    4.32 +  (.detect vis 1.2 2 OpenCV/HAAR_DO_CANNY_PRUNING 20 20))
    4.33 +
    4.34 +(defn capture-action [vis panel image faces]
    4.35 +  (proxy [ActionListener] []
    4.36 +    (actionPerformed
    4.37 +     [e]
    4.38 +     (dosync (ref-set image (capture-image vis))
    4.39 +	     (ref-set faces (detect-face vis)))
    4.40 +     (.repaint panel))))
    4.41 +
    4.42 +(defn panel [image faces]
    4.43 +  (proxy [JLabel] [] 
    4.44 +    (paint
    4.45 +     [g]
    4.46 +     (.drawImage g @image 0 0 nil)
    4.47 +     (.setColor g Color/red)
    4.48 +     (doseq [square @faces]
    4.49 +       (.drawRect g
    4.50 +		  (.x square) (.y square)
    4.51 +		  (.width square) (.height square))))))
    4.52 +
    4.53 +(defn key-listener [vis timer]
    4.54 +  (proxy [KeyAdapter] [] 
    4.55 +    (keyReleased 
    4.56 +     [e]
    4.57 +     (.stop timer)
    4.58 +     (.dispose vis))))
    4.59 +
    4.60 +(defn main []
    4.61 +  (let [vis   (vision)
    4.62 +	image (ref (capture-image vis))
    4.63 +	faces (ref (detect-face vis))
    4.64 +	panel (panel image faces)
    4.65 +	timer (Timer. frame-rate (capture-action vis panel image faces))]
    4.66 +    (.start timer)
    4.67 +    (doto (JFrame.)
    4.68 +      (.add panel)
    4.69 +      (.addKeyListener (key-listener vis timer))
    4.70 +      (.setSize width height)
    4.71 +      (.show))))
    4.72 +
    4.73 +

     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/src/clojureDemo/GenesisPlay.clj	Fri Aug 20 00:32:44 2010 -0400
     5.3 @@ -0,0 +1,501 @@
     5.4 +(ns clojureDemo.GenesisPlay)
     5.5 +
     5.6 +
     5.7 +(use 'clojure.contrib.import-static)
     5.8 +(import '(java.io File))
     5.9 +(import '(org.apache.commons.io FileUtils))
    5.10 +(import '(javax.imageio ImageIO) )
    5.11 +(import '(javax.swing JFrame))
    5.12 +(import '(java.awt Color BorderLayout))
    5.13 +(import '(ij.plugin PlugIn))
    5.14 +(import '(ij ImagePlus IJ))
    5.15 +(import '(java.lang Math))
    5.16 +
    5.17 +(use 'clojureDemo.appeture)
    5.18 +
    5.19 +(import-static java.lang.Math pow abs)
    5.20 +
    5.21 +(import '(ij Macro))
    5.22 +
    5.23 +(import '(java.io BufferedReader InputStreamReader))
    5.24 +(import '(java.awt.image BufferedImage))
    5.25 +(import '(genesis Genesis))
    5.26 +(import '(utils Mark))
    5.27 +(import '(capenLow StoryProcessor))
    5.28 +(import '(connections Connections WiredBox))
    5.29 +(import '(specialBoxes BasicBox MultiFunctionBox))
    5.30 +(import '(http Start))
    5.31 +(import '(engineering NewHardWiredTranslator))
    5.32 +
    5.33 +(import '(java.awt Polygon))
    5.34 +(import '(java.awt.geom Line2D$Double))
    5.35 +(use 'clojure.contrib.str-utils)
    5.36 +
    5.37 +
    5.38 +(use '[clojureDemo.Xuggle :only (video-seq trans-save flash display video-data)])
    5.39 +(use 'clojureDemo.MegaDeath)
    5.40 +
    5.41 +
    5.42 +(use 'clojure.contrib.combinatorics)
    5.43 +
    5.44 +(use 'clojure.contrib.repl-utils)
    5.45 +(use ['clojureDemo.Defines 
    5.46 +      :only '(
    5.47 +	     lian look getto human0 blow base app0 app1 app2 app3 app4 app5 
    5.48 +		  bounce0 bounce1 bounce2 bounce3 bounce4 bounce5 bounce6
    5.49 +		  collide0 collide1 collide2 collide3 collide4  
    5.50 +		  give0 give1 give2 give3 give4 target default)])
    5.51 +
    5.52 +
    5.53 +;(proxy 
    5.54 +
    5.55 +
    5.56 +
    5.57 +
    5.58 +
    5.59 +(defn startInFrame-rm 
    5.60 +  [genesis]
    5.61 +  (.start genesis)
    5.62 +  (let [frame (JFrame.)]
    5.63 +    (doto frame
    5.64 +      (.setTitle "Genesis")
    5.65 +      (.setBounds 0 0 1024 768)
    5.66 +      (doto (.getContentPane)
    5.67 +	(.setBackground Color/WHITE)
    5.68 +	(.setLayout (BorderLayout.))
    5.69 +	(.add genesis))
    5.70 +      (.setJMenuBar (.getMenuBar genesis))
    5.71 +      (.setVisible true))
    5.72 +    frame))
    5.73 +
    5.74 +
    5.75 +(defn run-genesis
    5.76 +  ([]  (startInFrame-rm (Genesis.)))
    5.77 +  ([genesis] (startInFrame-rm genesis)))
    5.78 +    
    5.79 +(defn lazy->hashMap
    5.80 +  [lazy]
    5.81 +   (zipmap  (map first lazy) (map last lazy)))
    5.82 +
    5.83 +(defn make-box
    5.84 +  "constructs a wired box sutiable for interfacing to Genesis"
    5.85 +  [name process-fn]
    5.86 +  (let [box (proxy [BasicBox] [] (getName [] name) 
    5.87 +		   (process [obj] (.transmit (Connections/getPorts this) (process-fn obj))))]
    5.88 +    (.addSignalProcessor (Connections/getPorts box) "process")
    5.89 +    box))
    5.90 +
    5.91 +
    5.92 +(defn make-generator-box
    5.93 +  "makes a box which only outputs a constant"
    5.94 +  [name constant]
    5.95 +  (let [box (proxy [BasicBox] []  (getName [] name) (process [obj] (.transmit (Connections/getPorts this) constant)))]    
    5.96 +    (.addSignalProcessor (Connections/getPorts box) "process")
    5.97 +    box))
    5.98 +
    5.99 +(defn naturals [] (iterate inc 0))
   5.100 +
   5.101 +;; ;(defn make-multifn-box [& args]
   5.102 +;; ;  (apply hash-map args)
   5.103 +  
   5.104 +;; ;  (map mega-macro naturals )
   5.105 +
   5.106 +;; ;  )
   5.107 +
   5.108 +
   5.109 +
   5.110 +
   5.111 +(defmacro function-name
   5.112 +  [function]
   5.113 +  (list str (list 'quote function)))
   5.114 +
   5.115 +(defn make-vision-box 
   5.116 +  "eventually I'll generalize this to arbitary functions and port names, but for now this is good enough"
   5.117 +  [function1 function2]
   5.118 +  (let [box (proxy [MultiFunctionBox] [] (getName [] "vision-box") 
   5.119 +		   (process1 [obj] (.transmit (Connections/getPorts this) (function1 obj)))
   5.120 +		   (process2 [obj] (.transmit (Connections/getPorts this) (function2 obj))))]
   5.121 +	(.addSignalProcessor (Connections/getPorts box) "PORT1" "process1")
   5.122 +	(.addSignalProcessor (Connections/getPorts box) "PORT2" "process2")
   5.123 +	box))
   5.124 +  
   5.125 +;; (defn make-box
   5.126 +;;   [name & functions]
   5.127 +;;   (let [box (proxy [MultiFunctionBox] [] (getName [] name)
   5.128 +;; 		   (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)] 
   5.129 +;; 		     ((symbol (str "process" (first indexed-fun))) 
   5.130 +;; 		      [obj] (.transmit (Connections/getPorts this) ((last indexed-fun) obj)))))]
   5.131 +    
   5.132 +;;     (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)] 
   5.133 +;;       (.addSignalProcessor (Connections/getPorts box) (str "PORT" (first indexed-fun))  (str "process" (first indexed-fun))))
   5.134 +;;     box))
   5.135 +
   5.136 +;; (defmacro proxy-functions
   5.137 +;;   [ name & functions]
   5.138 +;; (into
   5.139 +;;  (for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)] 
   5.140 +;;    (list (symbol (str "process" (first indexed-fun))) (vector 'obj)  
   5.141 +;; 	 (list '.transmit '(Connections/getPorts this) (list (last indexed-fun) 'obj))))
   5.142 +;;  (list  (list 'getName (vector) name)   (vector) (vector MultiFunctionBox) 'proxy)))
   5.143 +   
   5.144 +
   5.145 +
   5.146 +;; 		     ((symbol (str "process" (first indexed-fun))) 
   5.147 +;; 		      [obj] (.transmit (Connections/getPorts this) ((last indexed-fun) obj)))))
   5.148 +
   5.149 +;; (defmacro make-fun2-box
   5.150 +;;   [name & functions]
   5.151 +  
   5.152 +
   5.153 +
   5.154 +;; (defmacro make-fun-box
   5.155 +;;   [name & functions]
   5.156 +;;   (let [proxy-functions 
   5.157 +;; 	(for [indexed-fun  (clojure.contrib.seq-utils/indexed functions)]
   5.158 +;; 	   ((symbol (str "process" (first indexed-fun)))
   5.159 +;; 		      [`obj#] (.transmit (Connections/getPorts 'this) ((last indexed-fun) `obj#))))]
   5.160 +    
   5.161 +
   5.162 +  
   5.163 +;;   `(let [box# (proxy [MultiFunctionBox] [] (getName [] ~name))]
   5.164 +;;      ~proxy-functions     
   5.165 +;;     box#))
   5.166 +
   5.167 +;; (defmacro return
   5.168 +;;   [name & functions]
   5.169 +;;   (let [out (for [x functions]
   5.170 +;;     x)]
   5.171 +;;      out))
   5.172 +
   5.173 +  
   5.174 +
   5.175 +		   
   5.176 +
   5.177 +(defn local-genesis
   5.178 +  "connects the custom vision interperter to genesis"
   5.179 +  [function1 function2]
   5.180 +  (let [vision-box (make-vision-box function1 function2) genesis (Genesis.) ]
   5.181 +    (Connections/wire Start/TRIPLES (.getStartParser genesis) "PORT1" vision-box)
   5.182 +    (Connections/wire NewHardWiredTranslator/RESULT (.getNewSemanticTranslator genesis) "PORT2" vision-box)
   5.183 +    genesis))
   5.184 +
   5.185 +
   5.186 +
   5.187 +
   5.188 +
   5.189 +
   5.190 +(defn frame-hash
   5.191 +  "yields a convienent representation for the pixles in an image.
   5.192 +   Because of the size of the structvre generated, this must only be used
   5.193 +   in a transient way so that java can do it's garbage collection."
   5.194 +  [imagePlus]
   5.195 +  (with-meta
   5.196 +  (let [buf (.. imagePlus getBufferedImage)
   5.197 +	color (.getColorModel buf)]
   5.198 +   (doall (apply hash-map 
   5.199 +	   (interleave 
   5.200 +	    (doall (for [x (range (.getWidth imagePlus)) y (range (.getHeight imagePlus))]
   5.201 +	      (vector x y)))
   5.202 +	    (doall (for [x (range (.getWidth imagePlus)) y (range (.getHeight imagePlus))]
   5.203 +	     (let [data (.getRGB buf x y)] 
   5.204 +	      (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)
   5.205 +			:g (bit-shift-right (bit-and 0x00ff00 data) 8)
   5.206 +			:b (bit-and 0x0000ff data)))))))))
   5.207 +  {:width  (.getWidth imagePlus) :height (.getHeight imagePlus)}))
   5.208 +
   5.209 +
   5.210 +
   5.211 +(defn vid-seq
   5.212 +  [video]
   5.213 +  (with-meta (doall (map frame-hash (video-seq video))) (video-data video)))
   5.214 +
   5.215 +
   5.216 +
   5.217 +
   5.218 +
   5.219 +(defn video-hash
   5.220 +  "turns an entire video into a nice hash-map
   5.221 +   .... or at least it would, if java didn't suck and only give me 
   5.222 +   2 GB to work with with no way to increase it.
   5.223 +   linear processing... grumble grumble ....."
   5.224 +  [video-seq]
   5.225 +  (apply hash-map
   5.226 +	 (interleave
   5.227 +	  (naturals)
   5.228 +	  (doall (map #(frame-hash %) video-seq)))))
   5.229 +	   
   5.230 +
   5.231 +
   5.232 +
   5.233 +(defn frame-hash->bufferedImage
   5.234 +  [frame-hash]
   5.235 +    (let [data  (meta frame-hash)
   5.236 +	image (BufferedImage. (:width data) (:height data) BufferedImage/TYPE_INT_BGR)]
   5.237 +	
   5.238 +	(doall (for [element frame-hash] 
   5.239 +	  (let [coord  (key element) 
   5.240 +		rgb   (val element)
   5.241 +		packed-RGB 
   5.242 +		(+ (bit-shift-left (:r rgb) 16)
   5.243 +		   (bit-shift-left (:g rgb) 8)
   5.244 +		                   (:b rgb))]
   5.245 +	    (.setRGB image (first coord) (last coord) packed-RGB))))
   5.246 +	image))
   5.247 +
   5.248 +(defmethod display
   5.249 +  clojure.lang.PersistentHashMap [frame-hash]
   5.250 +  (display (frame-hash->bufferedImage frame-hash)))
   5.251 +
   5.252 + (defmethod display
   5.253 +   clojure.lang.PersistentArrayMap [frame-hash]
   5.254 +   (display (frame-hash->bufferedImage frame-hash)))
   5.255 +
   5.256 +;; (defmethod display 
   5.257 +;;    clojure.lang.LazySeq [frame-hash]
   5.258 +;;   (display (frame-hash->bufferedImage frame-hash)))
   5.259 +
   5.260 +
   5.261 +
   5.262 +
   5.263 +
   5.264 +(defn rectangle-window
   5.265 +  "efficiently grabs a rectangle from the frame-hash.
   5.266 +   Values that don't exisist in the picture are colored negative green!"
   5.267 +  [x y l w frame-hash]
   5.268 +  (let [coords (for [m (range (- x l) (+ 1 x l)) n (range (- y w) ( + 1 y w))] (vector m n))]
   5.269 +
   5.270 +    (with-meta
   5.271 +      (zipmap
   5.272 +       coords
   5.273 +       (map #(frame-hash % {:r 0 :g -500 :b 0}) coords))   
   5.274 +      (meta frame-hash))))
   5.275 +
   5.276 +
   5.277 +(defn sum 
   5.278 +     "squashes all the dinensions of the picture together into a single dimension
   5.279 +      sutiable for analysis."
   5.280 +     [window]
   5.281 +     (zipmap
   5.282 +      (keys window)
   5.283 +      (map (fn [rgb] (+ (:r rgb) (:b rgb) (:g rgb))) (vals window))))
   5.284 +
   5.285 +(defn b&w
   5.286 +  "turn everything grey"
   5.287 +  [window]
   5.288 +  (with-meta
   5.289 +  (zipmap
   5.290 +   (keys window)
   5.291 +   (map (fn  [rgb] 
   5.292 +	  (let [sum (int (/ (+ (:r rgb) (:b rgb) (:g rgb)) 3))]
   5.293 +	    {:r sum :g sum :b sum })) (vals window))) (meta window)))
   5.294 +
   5.295 +(defn green-select-x-form
   5.296 +  "find green things"
   5.297 +  [window]
   5.298 +  (with-meta
   5.299 +  (zipmap
   5.300 +   (keys window)
   5.301 +   (map (fn  [rgb] 
   5.302 +	  (if (and (> (:g rgb) (:b rgb)) (> (:g rgb) (:r rgb)))
   5.303 +	    rgb
   5.304 +	    {:r 0 :g 0 :b 0})) (vals window))) (meta window)))
   5.305 +  
   5.306 +
   5.307 +(defn manual-line-detect
   5.308 +  "Ty as I might, this can never be truly effective until higher level
   5.309 +   processes contribute to dynamicaly adjusting these paramaters. For
   5.310 +   now I'll settle with simple manual calibration."
   5.311 +  [var1 mean1 var2 mean2]
   5.312 +  (> 
   5.313 +  (if (or (< var1 250) (< var2 250))
   5.314 +    (abs (int (- mean1 mean2)))
   5.315 +    0) 55))
   5.316 +;30 looks good
   5.317 +
   5.318 +
   5.319 +
   5.320 +
   5.321 +(defn frame-windows
   5.322 +  "analyzes a frame in terms of lots of tiny windows which 
   5.323 +   each try to find some sort of edge."
   5.324 +  ([ x-form frame]
   5.325 +     (with-meta
   5.326 +     (let [width (:width  (meta frame) 500)
   5.327 +	   height(:height (meta frame) 500 )]
   5.328 +       (filter (comp not nil?) 
   5.329 +	       (for [x (range 0 width 2) y (range 0 height 2)]
   5.330 +		 (:line (window-line (rectangle-window x y 1 1 frame) (comp sum x-form) manual-line-detect))))) (meta frame)))
   5.331 +  ([frame]  (frame-windows identity frame)))
   5.332 +
   5.333 +
   5.334 +(defn static-segmentation
   5.335 +  "divides a single picture frame into appropiate objects using a 
   5.336 +   simple watershed method based on sharp color variation.
   5.337 +   radius: the general size of the window in pixels
   5.338 +   gradient: threshold for a color gradient to be recognized as a edge"
   5.339 +  [radius gradient frame]
   5.340 +  (let [ah (frame-hash frame)]
   5.341 +    ah))
   5.342 +
   5.343 +
   5.344 +(defn video-parse
   5.345 +  "this is the equilivalent to the S.T.A.R.T Parser for videos
   5.346 +      right now it's just a simple blob detector"
   5.347 +  [video-seq]
   5.348 +  
   5.349 +  )
   5.350 +
   5.351 +
   5.352 +
   5.353 +(defn overlay-draw
   5.354 + [frame-hash overlay]
   5.355 + (let [image  (frame-hash->bufferedImage frame-hash)
   5.356 +       g2 (.getGraphics image)]
   5.357 +   (doall (for [ x overlay] 
   5.358 +     (let [x1 (ffirst x) y1 (second (first x)) x2 (first (last x)) y2 (last (last x))] 
   5.359 +       (.drawLine g2 x1 y1 x2 y2))))
   5.360 +     image))
   5.361 +
   5.362 +
   5.363 +
   5.364 +(defn video-seq->b&w
   5.365 +  [video-seq]
   5.366 +  (with-meta
   5.367 +    (map #(ImagePlus. "B and W" (frame-hash->bufferedImage %))
   5.368 +
   5.369 +    (map (fn [imgPlus]
   5.370 +	   (let [play (frame-hash imgPlus)]
   5.371 +	     (b&w play)))
   5.372 +	 video-seq))
   5.373 +    (meta video-seq)))
   5.374 +
   5.375 +
   5.376 +
   5.377 +(defn vid-save
   5.378 +  [filename vid-seq]
   5.379 +  (trans-save filename 
   5.380 +	     (with-meta (map (comp #(ImagePlus. "reverse-x-form" %)  frame-hash->bufferedImage) vid-seq) (meta vid-seq))))
   5.381 + 
   5.382 +
   5.383 +
   5.384 +;(def g0 (video-seq give0))
   5.385 +(def gen (proxy [Genesis] [] ))
   5.386 +(def short-give  (with-meta (take 60 (drop 30 (video-seq give0))) {:fps 30 :width 320 :height 240 }))
   5.387 +
   5.388 +(def sg short-give)
   5.389 +(def g1 (first sg))
   5.390 +(def gs sg)
   5.391 +(def play  (frame-hash (first sg)))
   5.392 +(def blank (with-meta (zipmap (keys play) (repeat (count play) {:r 0 :g 0 :b 0})) (meta play)))
   5.393 +
   5.394 +(def blank (with-meta (zipmap (keys play) (repeat (count play) {:r 0 :g 0 :b 0})) (meta play)))
   5.395 +(def b+w-play (b&w play))
   5.396 +(def rgb (rectangle-window 50 50 1 1 play))
   5.397 +(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)))
   5.398 +
   5.399 +(def invertedColorPlay (with-meta (zipmap (keys play) (map #(hash-map :r (- 255 (:r %)) :g (- 255 (:g %)) :b (- 255 (:b %))) (vals play))) (meta play)))
   5.400 +
   5.401 +(def play1 (with-meta (frame-hash (nth sg 0)) {:width 320 :height 240}))
   5.402 +(def play2 (with-meta (frame-hash (nth sg 1)) {:width 320 :height 240}))
   5.403 +(def play3 (with-meta (frame-hash (nth sg 2)) {:width 320 :height 240}))
   5.404 +(def play4 (with-meta (frame-hash (nth sg 3)) {:width 320 :height 240}))
   5.405 +(def play5 (with-meta (frame-hash (nth sg 4)) {:width 320 :height 240}))
   5.406 +
   5.407 +
   5.408 +
   5.409 +
   5.410 +
   5.411 +
   5.412 +
   5.413 +
   5.414 +
   5.415 +
   5.416 +
   5.417 +
   5.418 +
   5.419 +
   5.420 +
   5.421 +
   5.422 +
   5.423 +
   5.424 +
   5.425 +
   5.426 +
   5.427 +
   5.428 +
   5.429 +
   5.430 +
   5.431 +
   5.432 +(comment
   5.433 +  ok here's the plan--
   5.434 +
   5.435 +  "genesis/language"
   5.436 +  raw text -> START -> representations/memory -> story tree
   5.437 +  
   5.438 +  "genesis/vision"
   5.439 +  raw video -> blob detector -> representations/memory -> event/structure tree
   5.440 +
   5.441 +  first, we start off with a video.
   5.442 +  the video get's passed through the blob detector.
   5.443 +  
   5.444 +  (blob-detector 
   5.445 +   first-pass-  divide up each frame into exasutive polygons. no temporal dependence
   5.446 +   second-pass- do a pairwise comparison of frames to link the polygons from each frame.
   5.447 +                polygons can either split apart or merge, but this step establishes their geneology.
   5.448 +   third-pass-  link the polygons together into higher objects using hueristic rules about motion
   5.449 +                these rules are determined by the language system, but for now they will be hardcoded.
   5.450 +                the only thing for now is that things that move together are the same object.
   5.451 +  )
   5.452 +
   5.453 +
   5.454 +  so now, we have a temporal history of polygons.
   5.455 +  the language part of the story may specify that certain characters
   5.456 +  with certain qualities do certain actions. 
   5.457 +  
   5.458 +  "Bob is wearing a red shirt. Shirts are big. Bob is a person.
   5.459 +   Mary is wearing a green shirt.
   5.460 +   Bob is person-sized.
   5.461 +   Bob is moving.
   5.462 +   The green object is a ball.
   5.463 +   Bob gives the ball to Mary."
   5.464 +
   5.465 +  Now, Genesis can select just the polygons that are important to the story,
   5.466 +  and it also learns important facts such as the relative size of a person to a ball.
   5.467 +
   5.468 +  The details which are captured in the polygon-transition space are--
   5.469 +  x (location of the center of each polygon), dx/dt , ((d^2)x)/(dt)^2, color (average), [left|right], polygon area
   5.470 +  polygon shape
   5.471 +  
   5.472 +  This information recurses on every component polygon as well.
   5.473 +
   5.474 +  When genesis want's to learn about verbs in particular, 
   5.475 +  it selects the aproapiate blobs from the linguistic desctiption (in bob's
   5.476 +  case it's "the big red blob on the left", for example.)
   5.477 +
   5.478 +  after selecting a subset of the blobs, it calculates the angles and distances between 
   5.479 +  those blobs' centers as erll as whether they are touching or overlaping.
   5.480 +
   5.481 +  From this sequence it derives an example of the verb.
   5.482 +
   5.483 +  From other examples it can do arch earning to refine the sequence to its salient features.
   5.484 + )
   5.485 +  
   5.486 +
   5.487 +
   5.488 +(comment (things you can do that will actually work!)
   5.489 +
   5.490 +(do (use :reload-all 'clojureDemo.GenesisPlay) (in-ns 'clojureDemo.GenesisPlay))
   5.491 +;genesis integration:
   5.492 +(def gen5 (make-generator-box "the 5th element" 5))
   5.493 +(Connections/wire gen5 (make-box "printer" println))
   5.494 +(Connections/viewNetwork)
   5.495 +(.process gen5 :ignore) ; causes 5 to be printed
   5.496 +(Connections/obliterateNetwork)
   5.497 +(.process gen5 :ignore); since the network connections were dissolved, nothing prints.
   5.498 +
   5.499 +
   5.500 +
   5.501 +)
   5.502 +
   5.503 +
   5.504 +

     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/src/clojureDemo/ImageJ.clj	Fri Aug 20 00:32:44 2010 -0400
     6.3 @@ -0,0 +1,12 @@
     6.4 +(ns clojureDemo.ImageJ)
     6.5 +
     6.6 +
     6.7 +
     6.8 +
     6.9 +(comment 
    6.10 +
    6.11 +(do (use :reload-all 'clojureDemo.ImageJ) (in-ns 'clojureDemo.ImageJ))
    6.12 +
    6.13 +1255231 for non delayed version.
    6.14 +
    6.15 +)

     7.1 Binary file src/clojureDemo/LocalGenesis.class has changed

     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/src/clojureDemo/MegaDeath.clj	Fri Aug 20 00:32:44 2010 -0400
     8.3 @@ -0,0 +1,90 @@
     8.4 +(ns clojureDemo.MegaDeath)
     8.5 +
     8.6 +(import '(java.io File))
     8.7 +(import '(org.apache.commons.io FileUtils))
     8.8 +(import '(javax.imageio ImageIO) )
     8.9 +
    8.10 +(import '(ij.plugin PlugIn))
    8.11 +(import '(ij ImagePlus IJ))
    8.12 +
    8.13 +(import '(ij Macro))
    8.14 +
    8.15 +(import '(java.io BufferedReader InputStreamReader))
    8.16 +(import '(java.awt.image BufferedImage))
    8.17 +
    8.18 +
    8.19 +
    8.20 +(use '[clojureDemo.Xuggle :only (video-seq trans-save flash video-data display)])
    8.21 +
    8.22 +
    8.23 +(use 'clojure.contrib.repl-utils)
    8.24 +(use ['clojureDemo.Defines 
    8.25 +      :only '(
    8.26 +	     lian look getto human0 blow base app0 app1 app2 app3 app4 app5 
    8.27 +		  bounce0 bounce1 bounce2 bounce3 bounce4 bounce5 bounce6
    8.28 +		  collide0 collide1 collide2 collide3 collide4  
    8.29 +		  give0 give1 give2 give3 give4 target default)])
    8.30 +
    8.31 +
    8.32 +(def hamster  (first (video-seq look)))
    8.33 +(def ham (.getImage hamster))
    8.34 +
    8.35 +(set! *print-length* 10)
    8.36 +
    8.37 +
    8.38 +
    8.39 +(defn final-ficker
    8.40 +  "wtf?"
    8.41 +  [& vars]
    8.42 +  (class (last vars)))
    8.43 +
    8.44 +(defmulti log-polar (fn [& args] (class (last args))))
    8.45 +
    8.46 +(defmethod log-polar clojure.lang.LazySeq
    8.47 +  ([X Y video-seq]
    8.48 +     (with-meta (map #(log-polar % X Y) video-seq) (meta video-seq)))
    8.49 +  ([video-seq]
    8.50 +     (with-meta (map #(log-polar %) video-seq) (meta video-seq))))
    8.51 +
    8.52 +
    8.53 +(defmethod log-polar ij.ImagePlus
    8.54 +     [imageP]
    8.55 +     (let [thread (Thread/currentThread)
    8.56 +	   options ""]
    8.57 +       (.setName thread "Run$_polar-transform")
    8.58 +       (Macro/setOptions thread options)
    8.59 +       (IJ/runPlugIn imageP "clojureDemo.Polar_Transformer" "")
    8.60 +       (let [return-image (IJ/getImage)]
    8.61 +	 (.hide return-image)
    8.62 +	 return-image)))
    8.63 +
    8.64 +(defn x-polar2 
    8.65 +     [imageP]
    8.66 +     (let [thread (Thread/currentThread)
    8.67 +	   options ""]
    8.68 +       (.setName thread "Run$_polar-transform")
    8.69 +       (Macro/setOptions thread options)
    8.70 +       (IJ/runPlugIn imageP "clojureDemo.Polar_Transformer" "")))
    8.71 +
    8.72 +
    8.73 +
    8.74 +(defn follow-object
    8.75 +     "takes in a video stream and does the most basic and simple forms of object detection."
    8.76 +     [video-seq]
    8.77 +)
    8.78 +
    8.79 +
    8.80 +
    8.81 +
    8.82 +
    8.83 +
    8.84 +
    8.85 +
    8.86 +
    8.87 +
    8.88 +
    8.89 +(comment
    8.90 +
    8.91 +(do (use :reload-all 'clojureDemo.MegaDeath) (in-ns 'clojureDemo.MegaDeath))
    8.92 +(map #(ns-unmap 'user %)(keys (ns-interns 'user)))
    8.93 +)

     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/src/clojureDemo/OpenCv.clj	Fri Aug 20 00:32:44 2010 -0400
     9.3 @@ -0,0 +1,226 @@
     9.4 +(ns clojureDemo.OpenCv)
     9.5 +  
     9.6 +(import '(java.awt Rectangle Robot Toolkit) )
     9.7 +(import '(java.awt.image BufferedImage) )
     9.8 +(import '(java.awt Graphics2D Panel))
     9.9 +(import '(java.io File) )
    9.10 +(import '(javax.imageio ImageIO) )
    9.11 +(import '(javax.swing JFrame))
    9.12 +(import '(org.apache.commons.io FileUtils))
    9.13 +(import clojure.lang.LazySeq)
    9.14 +(import '(name.audet.samuel.javacv.jna highgui cv cxcore 
    9.15 +				       cxcore$IplImage highgui$CvCapture$PointerByReference  
    9.16 +				       highgui$CvVideoWriter$PointerByReference cxcore$IplImage$PointerByReference))
    9.17 +(import '(name.audet.samuel.javacv CanvasFrame JavaCvErrorCallback))
    9.18 +
    9.19 +(.redirectError (JavaCvErrorCallback.))
    9.20 +
    9.21 +(use 'clojure.contrib.repl-utils)
    9.22 +;(use 'clojureDemo.Defines)
    9.23 +;(use '[clojureDemo.Xuggle :only (cache)])
    9.24 +
    9.25 +;this is still a work in progress, I'll come back to it later when I understand 
    9.26 +;jna more thoroughly.  the important abstraction here is 
    9.27 +;video-seq, which gives a lazy sequence of Intel Image Processing library images.
    9.28 +
    9.29 +(defn naturals [] (iterate inc 0))
    9.30 +
    9.31 +(defn- makePanel [image] (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))
    9.32 +
    9.33 +
    9.34 +(defmulti  display "Creates a JFrame and displays a buffered image"  class)
    9.35 +
    9.36 +(defmethod display 
    9.37 +  BufferedImage  [image] 
    9.38 +  (let [panel (makePanel image)
    9.39 +	frame (JFrame. "Oh Yeah!")]
    9.40 +    (.add frame panel) 
    9.41 +    (.pack frame) 
    9.42 +    (.setVisible frame true ) 
    9.43 +    (.setSize frame(.getWidth image) (.getHeight image))))
    9.44 +
    9.45 +(defmethod display
    9.46 +  cxcore$IplImage [image]
    9.47 +  ( display (.getBufferedImage image)))
    9.48 +  
    9.49 +(defmethod display
    9.50 +  String [image]
    9.51 +  (display (highgui/cvLoadImage image highgui/CV_LOAD_IMAGE_COLOR)))
    9.52 +
    9.53 +(defmethod display
    9.54 +  LazySeq [s]
    9.55 +  (display (first s)))
    9.56 +
    9.57 +
    9.58 +
    9.59 +(def ext "jpg") 
    9.60 +;see below for the rationale for this choice of extention.
    9.61 +
    9.62 +(def cache-location "/home/r/Desktop/vision-cache/")
    9.63 +
    9.64 +(defn close-capture
    9.65 +  [capture]
    9.66 +  (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture)))
    9.67 +
    9.68 +(defn close-writer
    9.69 +  [writer] (highgui/cvReleaseVideoWriter (highgui$CvVideoWriter$PointerByReference. writer))) 
    9.70 +
    9.71 +(defn- cache-path
    9.72 +  [video]
    9.73 +  (File. cache-location (.getName video)))
    9.74 +
    9.75 +(defn- already-cached
    9.76 +  "this is the simplest and most retarded way to do it"
    9.77 +  [video]
    9.78 +  (.exists (cache-path video)))
    9.79 +
    9.80 +(defn write-frame 
    9.81 +  [capture target-dir n]
    9.82 +  (let [image (highgui/cvQueryFrame capture)]
    9.83 +    (if (nil? image) false
    9.84 +	(highgui/cvSaveImage (str (File. target-dir (str n "."  ext))) image))))
    9.85 +
    9.86 +(defn- write-frame-bad
    9.87 +  [capture target-dir n]
    9.88 +  (println (str "saving frame: " n))
    9.89 +  (let [image (highgui/cvQueryFrame capture)]
    9.90 +    (if (nil? image) false
    9.91 +	( ImageIO/write (.getBufferedImage image) ext (File. target-dir (str n "."  ext))))))
    9.92 +
    9.93 +(defn- write-frames
    9.94 +  [video target-dir]
    9.95 +  (let [capture (highgui/cvCreateFileCapture (.getPath video))]
    9.96 +   (dorun 
    9.97 +    (for [n (naturals) :while (write-frame capture target-dir n) ] nil ))
    9.98 +    (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))))
    9.99 +
   9.100 +(defn- cache-frames
   9.101 +  [cache-location video]
   9.102 +  (time 
   9.103 +   (do
   9.104 +     (println "\"caching entire video structure... this will take a while... go get a snack or something :)\"")
   9.105 +     (FileUtils/deleteDirectory (cache-path video))
   9.106 +     (FileUtils/forceMkdir (cache-path video))
   9.107 +     (write-frames video  (cache-path video)))))
   9.108 +
   9.109 +;(defn cache
   9.110 +;  [video]
   9.111 +;  (if (already-cached video) nil (cache-frames cache-location video)))
   9.112 + 
   9.113 +(defn video-len 
   9.114 +  [video]
   9.115 +  (alength (.list (cache-path video))))
   9.116 +(def video-len (memoize video-len))
   9.117 + 
   9.118 +(defn video-data
   9.119 +  "since the opencv version is so absolutely unreliable..."
   9.120 +  [video]
   9.121 +  (let
   9.122 +      [capture (highgui/cvCreateFileCapture (.getPath video))
   9.123 +       info {:length      (video-len video)
   9.124 +	     :width       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_WIDTH)
   9.125 +	     :height      (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_HEIGHT)
   9.126 +	     :fps         (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FPS)
   9.127 +	     :codec       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FOURCC)}]
   9.128 +    (close-capture capture)
   9.129 +    info))
   9.130 +(def video-data (memoize video-data))
   9.131 +
   9.132 +(defn video-frame-path
   9.133 +     [video n]
   9.134 +     (File. (cache-path video)  (str n "."  ext)))
   9.135 +
   9.136 +
   9.137 +(defn- video-frame-ipl
   9.138 +  [video n] 
   9.139 +;  (cache video)
   9.140 +  (let 
   9.141 +      [c++-managed  (highgui/cvLoadImage (str (File. (cache-path video) (str n "."  ext))) highgui/CV_LOAD_IMAGE_COLOR)
   9.142 +       jvm-managed (.clone c++-managed)] 
   9.143 +	 ;this bit with the cloning is so I can deal with Garbage Collection once and for all.
   9.144 +	 ;the cpp-managed image must be manually Garbage Collected, but it's clone is managed by 
   9.145 +         ;the JVM's Garbage Collector.  By getting rid of the c++ part right here and now, no 
   9.146 +         ;other function has to worry about manual garbage collection ever again.
   9.147 +         ;Unfortunately, this doesn't seem to work for certain types of files. It's not file-size
   9.148 +         ;which is the issue, but something involving the image header.
   9.149 +    (cxcore/cvReleaseImage (.pointerByReference c++-managed))
   9.150 +    jvm-managed
   9.151 +))
   9.152 +  
   9.153 +
   9.154 +(defn- video-frame-buffered
   9.155 +  "takes one frame from a video in constant time"
   9.156 +  [video n]
   9.157 + ; (cache video)
   9.158 +  (ImageIO/read (File. (cache-path video) (str n "."  ext))))
   9.159 +
   9.160 +(defn video-frame [video n] (video-frame-buffered video n))
   9.161 +
   9.162 +(defn- dumb-write 
   9.163 +  [video n writer]
   9.164 +  (let 
   9.165 +      [c++-managed  (highgui/cvLoadImage (str (File. (cache-path video) (str n ext))) highgui/CV_LOAD_IMAGE_COLOR)]
   9.166 +    (highgui/cvWriteFrame writer  c++-managed)
   9.167 +    (cxcore/cvReleaseImage (cxcore$IplImage$PointerByReference. c++-managed))))
   9.168 +
   9.169 +(defn video-seq
   9.170 +  "makes a lazy sequence of IPL images"
   9.171 +  ;additionally, I want to pass metadata around with the sequence.
   9.172 +  [video] ;(cache video)
   9.173 +  (map #(video-frame video %) (range (video-len video))))
   9.174 +(defn video-writer
   9.175 +  "uses data about the video to make a writer"
   9.176 +  [data fileTarget]
   9.177 +  (highgui/cvCreateVideoWriter 
   9.178 +   (str fileTarget)
   9.179 +   
   9.180 +   ;(highgui/CV_FOURCC \P,\I,\M,\1) ;= MPEG-1 codec  (112913.386195 msecs) (104 MB)
   9.181 +   ;(highgui/CV_FOURCC \M,\J,\P,\G) ;= motion-jpeg codec (crashed)
   9.182 +   ;(highgui/CV_FOURCC \M,\P,\4,\2) ;= MPEG-4.2 codec (107184.186774 msecs) (82 MB)
   9.183 +   ;(highgui/CV_FOURCC \D,\I,\V,\3) ;= MPEG-4.3 codec (118308.933328 msecs)  (83 MB)
   9.184 +   (highgui/CV_FOURCC \D,\I,\V,\X) ;= MPEG-4 codec    (99037.738131 msecs)  (85 MB)
   9.185 +   ;(highgui/CV_FOURCC \U,\2,\6,\3) ;= H263 codec     (101141.993551 msecs) (89 MB)
   9.186 +   ;(highgui/CV_FOURCC \I,\2,\6,\3) ;= H263I codec      (crashed)
   9.187 +   ;(highgui/CV_FOURCC \F,\L,\V,\1) ;= FLV1 codec     (104307.567802 msecs) (93 MB)
   9.188 +   ;(:codec data)                    ;= whatever the movie originally had.  (98278.694169 msecs) (1.9 GB)  
   9.189 +
   9.190 +   (:fps data) (cxcore/cvSize (:width data) (:height data)) 
   9.191 +   1; 1 here means that we're writing in color.
   9.192 +    ; you cannot change it to 0 to write in 
   9.193 +    ; black and white. Everything just crashes instead.
   9.194 +    ; what a useful paramater.
   9.195 +   ))
   9.196 +
   9.197 +
   9.198 +(defn naturals []  (iterate inc 0))
   9.199 +
   9.200 +
   9.201 +(defn write-frame-2
   9.202 +  [writer frame]
   9.203 +  (let [c++-frame (cxcore$IplImage/createFrom frame)]
   9.204 +    (highgui/cvWriteFrame writer c++-frame)
   9.205 +   ; (cxcore/cvReleaseImage (.pointerByReference c++-frame)))
   9.206 +)
   9.207 +    frame)
   9.208 +
   9.209 +(defn save-seq 
   9.210 +  [writer video-seq]
   9.211 +  (map #(write-frame-2 writer %) video-seq))
   9.212 +
   9.213 +(defmacro trans-save
   9.214 +"there's a small problem with trans-save --- it IS
   9.215 +truly transitive, but it does too much work....
   9.216 +sometimes it writes files twice.
   9.217 +this is functionally correct though."
   9.218 +  [target config video-seq]
   9.219 +  `(let [writer# (video-writer ~config ~target)]
   9.220 +     (do
   9.221 +       (dorun (save-seq writer# ~video-seq))
   9.222 +       (close-writer writer#)
   9.223 +       ~video-seq)))
   9.224 +
   9.225 +
   9.226 +
   9.227 +(comment 
   9.228 +(do (use :reload-all 'clojureDemo.OpenCv) (in-ns 'clojureDemo.OpenCv))
   9.229 +)

    10.1 Binary file src/clojureDemo/Polar_Transformer.class has changed

    11.1 Binary file src/clojureDemo/ScracthPad.class has changed

    12.1 Binary file src/clojureDemo/TestNetwork.class has changed

    13.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.2 +++ b/src/clojureDemo/VideoParse.clj	Fri Aug 20 00:32:44 2010 -0400
    13.3 @@ -0,0 +1,230 @@
    13.4 +(ns clojureDemo.VideoParse)
    13.5 +  
    13.6 + 
    13.7 +
    13.8 +;this file is not used anymore, except for the (display %) function.
    13.9 +
   13.10 +
   13.11 +
   13.12 +(import '(java.awt Rectangle Robot Toolkit) )
   13.13 +(import '(java.awt.image BufferedImage) )
   13.14 +(import '(java.awt Graphics2D Panel))
   13.15 +(import '(java.io File) )
   13.16 +(import '(javax.imageio ImageIO) )
   13.17 +(import '(com.xuggle.mediatool ToolFactory))
   13.18 +(import '(com.xuggle.mediatool IMediaDebugListener IMediaDebugListener$Event))
   13.19 +(import '(com.xuggle.mediatool MediaToolAdapter))
   13.20 +(import '(com.xuggle.xuggler IContainer IContainer$Type IPacket))
   13.21 +(import '(javax.swing JFrame))
   13.22 +
   13.23 +(import clojure.lang.LazySeq)
   13.24 +
   13.25 +(import '(name.audet.samuel.javacv.jna highgui cv cxcore))
   13.26 +
   13.27 +(import '(name.audet.samuel.javacv CanvasFrame))
   13.28 +
   13.29 +(import '(name.audet.samuel.javacv.jna cxcore$IplImage))
   13.30 +
   13.31 +(import '(name.audet.samuel.javacv.jna highgui$CvCapture$PointerByReference))
   13.32 +(import '(name.audet.samuel.javacv.jna highgui$CvVideoWriter$PointerByReference))
   13.33 +
   13.34 +;definitions
   13.35 +
   13.36 +(def -inf Double/NEGATIVE_INFINITY)
   13.37 +(def inf  Double/POSITIVE_INFINITY)
   13.38 +
   13.39 +(use 'clojure.contrib.repl-utils)
   13.40 +
   13.41 +
   13.42 +;minor functions
   13.43 +
   13.44 +(defn converge
   13.45 +  "recursively runs update until prior passes accept, then returns"
   13.46 +  [prior update accept]
   13.47 +  (if (accept prior) prior (recur (update prior) update accept)))
   13.48 +
   13.49 +(defn interval-width [interval] (- (last interval) (first interval)))
   13.50 +
   13.51 +(defn midpoint [interval] 
   13.52 +  (let [a (first interval) b (last interval)]
   13.53 +    (if (and (= a -inf) (= b inf)) 0
   13.54 +    (if (= a -inf) (midpoint [(- b 200000) b])
   13.55 +	(if (= b inf) (midpoint [a (+ a 200000)])
   13.56 +	    (int (/ (+ a b) 2)))))))
   13.57 +
   13.58 +(defn cart2
   13.59 +  "calculates the cartesian product in 2 dimensions"
   13.60 +  [point] 
   13.61 +  (let [[x y] point] (for [abscissa (range x) ordinate (range y)] [abscissa ordinate])))
   13.62 +
   13.63 +(defn closeCapture
   13.64 +  [capture]
   13.65 +  (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture)))
   13.66 +
   13.67 +(defn- makePanel [image] (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))
   13.68 +
   13.69 +(defn screenshot "grab screenshot" [] 
   13.70 +  
   13.71 +  (ImageIO/write
   13.72 +   (.createScreenCapture (Robot.) (Rectangle. (.getScreenSize (Toolkit/getDefaultToolkit))))
   13.73 +   "JPG"
   13.74 +   (File. "/home/r/Desktop/screenie.jpg")))
   13.75 +
   13.76 +(defn- readerRecurse
   13.77 +  "calls .readPacket until there's nothing left to do"
   13.78 +  [reader]
   13.79 +  (if (not (nil? (.readPacket reader))) ; here .readPacket actually does the processing as a side-effect.
   13.80 +    nil                                   ; it returns null when it has MORE to process, and signals an error when done... 
   13.81 +    (recur reader)))
   13.82 +
   13.83 +(defmacro times
   13.84 +  "perform multiple timed tests on a form"
   13.85 +  [n form]
   13.86 +  `(dotimes [_# ~n] (time ~form)))
   13.87 +  
   13.88 +(defmacro me-1
   13.89 +  "does macroexpand-1 without having to quote the form"
   13.90 +  [form]
   13.91 +  (list 'macroexpand-1 (list 'quote form)))
   13.92 +
   13.93 +;Major Functions
   13.94 +
   13.95 +(defmulti  display "Creates a JFrame and displays a buffered image"  class)
   13.96 +
   13.97 +(defmethod display 
   13.98 +  BufferedImage  [image] 
   13.99 +  (let [panel (makePanel image)
  13.100 +	frame (JFrame. "Oh Yeah!")]
  13.101 +    (.add frame panel) 
  13.102 +    (.pack frame) 
  13.103 +    (.setVisible frame true ) 
  13.104 +    (.setSize frame(.getWidth image) (.getHeight image))))
  13.105 +
  13.106 +(defmethod display
  13.107 +  cxcore$IplImage [image]
  13.108 +  ( display (.getBufferedImage image)))
  13.109 +  
  13.110 +(defmethod display
  13.111 +  String [image]
  13.112 +  (display (highgui/cvLoadImage image highgui/CV_LOAD_IMAGE_COLOR)))
  13.113 +
  13.114 +(defmethod display
  13.115 +  LazySeq [s]
  13.116 +  (display (first s)))
  13.117 +
  13.118 +
  13.119 +(defn convert
  13.120 +  "takes video and converts it to a new type of video"
  13.121 +  [videoInput videoOutput]
  13.122 +  (let [reader (ToolFactory/makeReader videoInput)]
  13.123 +    (doto reader
  13.124 +      (.addListener (ToolFactory/makeWriter videoOutput reader))
  13.125 +      (.addListener (ToolFactory/makeDebugListener (into-array [IMediaDebugListener$Event/META_DATA]))))
  13.126 +    (readerRecurse reader)))
  13.127 +
  13.128 +
  13.129 +
  13.130 +(defn video-frame
  13.131 +  ":("
  13.132 +  [video frame]
  13.133 +  (lazy-seq
  13.134 +   (try 
  13.135 +    (let [capture (highgui/cvCreateFileCapture video)]
  13.136 +      (highgui/cvSetCaptureProperty capture highgui/CV_CAP_PROP_POS_FRAMES frame)
  13.137 +      (println (str "Wanted frame <" frame "> but went to keyFrame " (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_POS_FRAMES)))
  13.138 +      (let [out (highgui/cvQueryFrame capture)
  13.139 +	    image (.clone  out)]
  13.140 +	(highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))
  13.141 +	[image]))
  13.142 +    (catch java.lang.NullPointerException _ nil))))
  13.143 +
  13.144 +
  13.145 +  
  13.146 +
  13.147 +(defn save-frame
  13.148 +  "takes an opencv image and saves it to disk"
  13.149 +  [frame filename]
  13.150 +  (highgui/cvSaveImage filename frame))
  13.151 +
  13.152 +
  13.153 +(defn video-len
  13.154 +  "finds out the real length of a video in log time."
  13.155 +  [video]
  13.156 +  (letfn
  13.157 +      [
  13.158 +       (accept [interval] (= 0 (interval-width interval)))
  13.159 +       (update [interval]
  13.160 +	       (let [[a b] interval]
  13.161 +		 (if (> (interval-width interval) 2)
  13.162 +		   (let [
  13.163 +			 middle (midpoint interval)
  13.164 +			 frame (first (video-frame video middle))
  13.165 +			 ]
  13.166 +		     (if (nil? frame) [a middle] [middle b]))
  13.167 +		   [a a])))
  13.168 +       ]
  13.169 +       
  13.170 +   (first (converge [-inf inf] update accept))))
  13.171 +(def video-len (memoize video-len))
  13.172 +
  13.173 +
  13.174 +
  13.175 +(defn getData
  13.176 +  "returns a bunch of stuff about a video"
  13.177 +  [video]
  13.178 +  (let
  13.179 +      [capture (highgui/cvCreateFileCapture video)
  13.180 +       info {:frames      (video-len video)
  13.181 +	     :width       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_WIDTH)
  13.182 +	     :height      (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_HEIGHT)
  13.183 +	     :fps         (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FPS)
  13.184 +	     :codec       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FOURCC)}]
  13.185 +      
  13.186 +    (closeCapture capture)
  13.187 +    info))
  13.188 +(def getData (memoize getData))
  13.189 +  
  13.190 +
  13.191 +(defn sajitify-linear
  13.192 +  "oh yeah!"
  13.193 +  [video string]
  13.194 +  (let [ capture (highgui/cvCreateFileCapture video)
  13.195 +	frames (:frames (getData video))]
  13.196 +       (dotimes [n frames]
  13.197 +	 (highgui/cvSaveImage (str string  (format "%06d" n) ".jpg") (highgui/cvQueryFrame capture)))
  13.198 +       (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))))
  13.199 +
  13.200 +(defn getFrame
  13.201 +  "gets the frame of a video at the specified time in seconds.
  13.202 +  this works with the simplest interpolation --- just piecewise steps"
  13.203 +  [video time]
  13.204 +  (lazy-seq
  13.205 +  [time  (video-frame video (int (* time (:fps (getData video)))))]))
  13.206 +
  13.207 +(defn video-seq-times
  13.208 +  "it's the new and improved version of videoSeq, now using OpenCv.
  13.209 +  we expect a sequence of times in seconds"
  13.210 +  [times video]
  13.211 +  (map #(getFrame video %) times))
  13.212 +
  13.213 +(defn video-seq
  13.214 +  "get's ALL the frames of a video as a lazy sequence of (IplImages)"
  13.215 +  [video] 
  13.216 +  (take (:frames (getData video))   (map #(video-frame video %) (iterate inc 0))))
  13.217 +
  13.218 +(defn trans-Writer
  13.219 +  "uses data about the video to make a writer"
  13.220 +  [video fileTarget]
  13.221 +  (let [data (getData video)]
  13.222 +  (highgui/cvCreateVideoWriter fileTarget (highgui/CV_FOURCC "F" "L" "V" "1") (:fps data) (cxcore/cvSize (:width data) (:height data)) 1)))
  13.223 +
  13.224 +(def naturals (iterate inc 0))
  13.225 +
  13.226 +(defn sajitify-seq
  13.227 +  [video string]
  13.228 +  (dorun (map #(highgui/cvSaveImage (str string  (format "%06d" %2) ".jpg") (first %1)) (video-seq video) naturals)))
  13.229 +
  13.230 +
  13.231 +
  13.232 +
  13.233 +

    14.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.2 +++ b/src/clojureDemo/VideoTransforms.clj	Fri Aug 20 00:32:44 2010 -0400
    14.3 @@ -0,0 +1,194 @@
    14.4 +(ns clojureDemo.VideoTransforms)
    14.5 +  
    14.6 +(import '(java.awt Rectangle Robot Toolkit) )
    14.7 +(import '(java.awt.image BufferedImage) )
    14.8 +(import '(java.awt Graphics2D Panel))
    14.9 +(import '(java.io File) )
   14.10 +(import '(javax.imageio ImageIO) )
   14.11 +(import '(javax.swing JFrame))
   14.12 +(import '(org.apache.commons.io FileUtils))
   14.13 +(import clojure.lang.LazySeq)
   14.14 +(import '(name.audet.samuel.javacv.jna highgui cv cxcore))
   14.15 +(import '(name.audet.samuel.javacv CanvasFrame))
   14.16 +(import '(name.audet.samuel.javacv.jna cxcore$IplImage))
   14.17 +(import '(name.audet.samuel.javacv.jna highgui$CvCapture$PointerByReference))
   14.18 +(import '(name.audet.samuel.javacv.jna highgui$CvVideoWriter$PointerByReference))
   14.19 +(import '(name.audet.samuel.javacv.jna cxcore$IplImage$PointerByReference))
   14.20 +(import '(name.audet.samuel.javacv.jna cxcore$IplImage))
   14.21 +(import '(name.audet.samuel.javacv JavaCvErrorCallback))
   14.22 +
   14.23 +(.redirectError (JavaCvErrorCallback.));this enables the c errors to travel up to the JVM
   14.24 +                                       ;where they can be handled.
   14.25 +
   14.26 +
   14.27 +(use '[clojureDemo.VisionCore :only (video-seq cache video-data close-writer)])
   14.28 +
   14.29 + 
   14.30 +(use 'clojure.contrib.repl-utils)
   14.31 +
   14.32 +(def -inf Double/NEGATIVE_INFINITY)
   14.33 +(def inf  Double/POSITIVE_INFINITY)
   14.34 +
   14.35 +
   14.36 +(def lian (File. "/home/r/Desktop/source-videos/lian1.mpeg"))
   14.37 +(def look (File. "/home/r/Desktop/source-videos/dramatic_look.flv"))
   14.38 +(def getto(File. "/home/r/Desktop/source-videos/Ghetto.flv"))
   14.39 +(def human0(File. "/home/r/Desktop/source-videos/vsr1/human0.avi"))
   14.40 +
   14.41 +(def base (File. "/home/r/Desktop/source-videos/"))
   14.42 +
   14.43 +(def app0 (File. base "approach0v2.avi"))
   14.44 +(def app1 (File. base "approach1v3.avi"))
   14.45 +(def app2 (File. base "approach0v3.avi"))
   14.46 +(def app3 (File. base "approach2v2.avi"))
   14.47 +(def app4 (File. base "approach1v2.avi")) 
   14.48 +(def app5 (File. base "approach2v3.avi"))
   14.49 +  
   14.50 +(def bounce0 (File. base "bounce0v2.avi"))  
   14.51 +(def bounce1 (File. base "bounce1v3.avi")) 
   14.52 +(def bounce2 (File. base "bounce3v2.avi"))
   14.53 +(def bounce3 (File. base "bounce0v3.avi"))  
   14.54 +(def bounce4 (File. base "bounce2v2.avi"))
   14.55 +(def bounce5 (File. base "bounce1v2.avi"))  
   14.56 +(def bounce6 (File. base "bounce2v3.avi"))
   14.57 +
   14.58 +(def collide0 (File. base "collide0v3.avi"))  
   14.59 +(def collide1 (File. base "collide2v3.avi")) 
   14.60 +(def collide2 (File. base "collide1v2.avi"))
   14.61 +(def collide3 (File. base "collide0v2.avi"))  
   14.62 +(def collide4 (File. base "collide1v3.avi")) 
   14.63 +  
   14.64 +(def give0 (File. base "give0v3.avi"))  
   14.65 +(def give1 (File. base "give2v3.avi")) 
   14.66 +(def give2 (File. base "give1v2.avi")) 
   14.67 +(def give3 (File. base "give0v2.avi"))        
   14.68 +(def give4 (File. base "give1v3.avi"))
   14.69 +
   14.70 +
   14.71 +(def target (File. "/home/r/Desktop/output-vision/"))
   14.72 +(def default(File. target "default.avi"))
   14.73 +(defn- makePanel [image] (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))
   14.74 +
   14.75 +(defmulti  display "Creates a JFrame and displays a buffered image"  class)
   14.76 +
   14.77 +(defmethod display 
   14.78 +  BufferedImage  [image] 
   14.79 +  (let [panel (makePanel image)
   14.80 +	frame (JFrame. "Oh Yeah!")]
   14.81 +    (.add frame panel) 
   14.82 +    (.pack frame) 
   14.83 +    (.setVisible frame true ) 
   14.84 +    (.setSize frame(.getWidth image) (.getHeight image))))
   14.85 +
   14.86 +(defmethod display
   14.87 +  cxcore$IplImage [image]
   14.88 +  ( display (.getBufferedImage image)))
   14.89 +  
   14.90 +(defmethod display
   14.91 +  String [image]
   14.92 +  (display (highgui/cvLoadImage image highgui/CV_LOAD_IMAGE_COLOR)))
   14.93 +
   14.94 +(defmethod display
   14.95 +  LazySeq [s]
   14.96 +  (display (first s)))
   14.97 +
   14.98 +
   14.99 +(defn video-writer
  14.100 +  "uses data about the video to make a writer"
  14.101 +  [data fileTarget]
  14.102 +  (highgui/cvCreateVideoWriter 
  14.103 +   (str fileTarget)
  14.104 +   
  14.105 +   ;(highgui/CV_FOURCC \P,\I,\M,\1) ;= MPEG-1 codec  (112913.386195 msecs) (104 MB)
  14.106 +   ;(highgui/CV_FOURCC \M,\J,\P,\G) ;= motion-jpeg codec (crashed)
  14.107 +   ;(highgui/CV_FOURCC \M,\P,\4,\2) ;= MPEG-4.2 codec (107184.186774 msecs) (82 MB)
  14.108 +   ;(highgui/CV_FOURCC \D,\I,\V,\3) ;= MPEG-4.3 codec (118308.933328 msecs)  (83 MB)
  14.109 +   ;;(highgui/CV_FOURCC \D,\I,\V,\X) ;= MPEG-4 codec    (99037.738131 msecs)  (85 MB)
  14.110 +   (highgui/CV_FOURCC \H,\D,\Y,\C)
  14.111 +   ;(highgui/CV_FOURCC \U,\2,\6,\3) ;= H263 codec     (101141.993551 msecs) (89 MB)
  14.112 +   ;(highgui/CV_FOURCC \I,\2,\6,\3) ;= H263I codec      (crashed)
  14.113 +   ;(highgui/CV_FOURCC \F,\L,\V,\1) ;= FLV1 codec     (104307.567802 msecs) (93 MB)
  14.114 +   ;(:codec data)                    ;= whatever the movie originally had.  (98278.694169 msecs) (1.9 GB)  
  14.115 +
  14.116 +   (:fps data) (cxcore/cvSize (:width data) (:height data)) 
  14.117 +   1; 1 here means that we're writing in color.
  14.118 +    ; you cannot change it to 0 to write in 
  14.119 +    ; black and white. Everything just crashes instead.
  14.120 +    ; what a useful paramater.
  14.121 +   ))
  14.122 +
  14.123 +
  14.124 +(defn naturals []  (iterate inc 0))
  14.125 +
  14.126 +
  14.127 +(defn write-frame
  14.128 +  [writer frame]
  14.129 +  (do
  14.130 +    (highgui/cvWriteFrame writer frame)
  14.131 +    frame))
  14.132 +
  14.133 +(defn number-seq
  14.134 +  [video-seq]
  14.135 +  (map #(vector %1 %2) (naturals) video-seq))
  14.136 +
  14.137 +(defn save-seq 
  14.138 +  [writer video-seq]
  14.139 +  (map #(write-frame writer %) video-seq))
  14.140 +  
  14.141 +(defn create-runonce [function]
  14.142 +  (let [sentinel (Object.)
  14.143 +	result (atom sentinel)]
  14.144 +    (fn [& args]
  14.145 +      (locking sentinel
  14.146 +	(if (= @result sentinel)
  14.147 +	  (reset! result (function))
  14.148 +	  @result)))))
  14.149 +
  14.150 +(defmacro oncer 
  14.151 +  [video-seq-gen]
  14.152 +  `((create-runonce #(~@video-seq-gen))))
  14.153 +
  14.154 +(defmacro trans-save
  14.155 +"there's a small problem with trans-save --- it IS
  14.156 +truly transitive, but it does too much work....
  14.157 +sometimes it writes files twice.
  14.158 +this is functionally correct though."
  14.159 +  [target config video-seq]
  14.160 +  `(let [writer# (video-writer ~config ~target)]
  14.161 +     (do
  14.162 +       (dorun (save-seq writer# ~video-seq))
  14.163 +       (close-writer writer#)
  14.164 +       ~video-seq)))
  14.165 +
  14.166 +(defn save-video
  14.167 +  [video target]
  14.168 +  (let [writer (video-writer (video-data video) target)]
  14.169 +    (do 
  14.170 +      (dorun (map #(write-frame writer %) (video-seq video)))
  14.171 +      (close-writer writer))))
  14.172 +
  14.173 +
  14.174 +(comment (Examples of things you can try that will actually work)
  14.175 +
  14.176 +(def lazy-human (video-seq human0)) ;makes a lazy sequence of frames and returns instantly.
  14.177 +(def target1 (File. "some/path/out1.avi")) ;just creates a normal Java File object.
  14.178 +(def target2 (File. "some/other/path/out2.avi"))
  14.179 +(def human0-data (video-data human0)) ;creates a map containing the fps, width, and height of the video. 
  14.180 +
  14.181 +(trans-save target human0-data (video-seq human0))
  14.182 +;saves a copy of human0 to disk.
  14.183 +
  14.184 +(trans-save target2 human0-data (video-seq-filter (trans-save target1 human0-data (video-seq human0))))
  14.185 +;saves an unaltered copy of human0 to disk, filters the sequence of 
  14.186 +;Intel Processing Library images by video-seq-filter, and writes the 
  14.187 +;filtered result to disk.  video-seq-filter could discard every other frame,
  14.188 +;take the sequence by fives and do temporal blurring, or just turn every
  14.189 +;frame to black and white. 
  14.190 +
  14.191 +
  14.192 +(do (use :reload-all 'clojureDemo.VideoTransforms) (in-ns 'clojureDemo.VideoTransforms))
  14.193 +
  14.194 +)
  14.195 +
  14.196 + 
  14.197 +

    15.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.2 +++ b/src/clojureDemo/VisionCore.clj	Fri Aug 20 00:32:44 2010 -0400
    15.3 @@ -0,0 +1,229 @@
    15.4 +(ns clojureDemo.VisionCore)
    15.5 +  
    15.6 +(import '(java.awt Rectangle Robot Toolkit) )
    15.7 +(import '(java.awt.image BufferedImage) )
    15.8 +(import '(java.awt Graphics2D Panel))
    15.9 +(import '(java.io File) )
   15.10 +(import '(javax.imageio ImageIO) )
   15.11 +(import '(javax.swing JFrame))
   15.12 +(import '(org.apache.commons.io FileUtils))
   15.13 +(import clojure.lang.LazySeq)
   15.14 +(import '(name.audet.samuel.javacv.jna highgui cv cxcore))
   15.15 +(import '(name.audet.samuel.javacv CanvasFrame))
   15.16 +(import '(name.audet.samuel.javacv.jna cxcore$IplImage))
   15.17 +(import '(name.audet.samuel.javacv.jna highgui$CvCapture$PointerByReference))
   15.18 +(import '(name.audet.samuel.javacv.jna highgui$CvVideoWriter$PointerByReference))
   15.19 +(import '(name.audet.samuel.javacv.jna cxcore$IplImage$PointerByReference))
   15.20 +(import '(name.audet.samuel.javacv.jna cxcore$IplImage))
   15.21 +(import '(name.audet.samuel.javacv JavaCvErrorCallback))
   15.22 +(.redirectError (JavaCvErrorCallback.))
   15.23 +
   15.24 +(use 'clojure.contrib.repl-utils)
   15.25 +
   15.26 +(def -inf Double/NEGATIVE_INFINITY)
   15.27 +(def inf  Double/POSITIVE_INFINITY)
   15.28 +
   15.29 +
   15.30 +
   15.31 +(def lian (File. "/home/r/Desktop/source-videos/lian1.mpeg"))
   15.32 +(def look (File. "/home/r/Desktop/source-videos/dramatic_look.flv"))
   15.33 +
   15.34 +(def target (File. "/home/r/Desktop/output-vision/"))
   15.35 +
   15.36 +
   15.37 +;this is still a work in progress, I'll come back to it later when I understand 
   15.38 +;jna more thoroughly.  the important abstraction here is 
   15.39 +;video-seq, which gives a lazy sequence of Intel Image Processing library images.
   15.40 +
   15.41 +(defn naturals [] (iterate inc 0))
   15.42 +
   15.43 +(def ext "jpg") 
   15.44 +;see below for the rationale for this choice of extention.
   15.45 +
   15.46 +(def cache-location "/home/r/Desktop/vision-cache/")
   15.47 +
   15.48 +(defn close-capture
   15.49 +  [capture]
   15.50 +  (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture)))
   15.51 +
   15.52 +(defn close-writer
   15.53 +  [writer] (highgui/cvReleaseVideoWriter (highgui$CvVideoWriter$PointerByReference. writer))) 
   15.54 +
   15.55 +(defn- cache-path
   15.56 +  [video]
   15.57 +  (File. cache-location (.getName video)))
   15.58 +
   15.59 +(defn- already-cached
   15.60 +  "this is the simplest and most retarded way to do it"
   15.61 +  [video]
   15.62 +  (.exists (cache-path video)))
   15.63 +
   15.64 +(defn- write-frame 
   15.65 +  [capture target-dir n]
   15.66 +  (let [image (highgui/cvQueryFrame capture)]
   15.67 +    (if (nil? image) false
   15.68 +	(highgui/cvSaveImage (str (File. target-dir (str n "."  ext))) image))))
   15.69 +
   15.70 +(defn- write-frame-bad
   15.71 +  [capture target-dir n]
   15.72 +  (println (str "saving frame: " n))
   15.73 +  (let [image (highgui/cvQueryFrame capture)]
   15.74 +    (if (nil? image) false
   15.75 +	( ImageIO/write (.getBufferedImage image) ext (File. target-dir (str n "."  ext))))))
   15.76 +
   15.77 +(defn- write-frames
   15.78 +  [video target-dir]
   15.79 +  (let [capture (highgui/cvCreateFileCapture (.getPath video))]
   15.80 +   (dorun 
   15.81 +    (for [n (naturals) :while (write-frame capture target-dir n) ] nil ))
   15.82 +    (highgui/cvReleaseCapture (highgui$CvCapture$PointerByReference. capture))))
   15.83 +
   15.84 +(defn- cache-frames
   15.85 +  [cache-location video]
   15.86 +  (time 
   15.87 +   (do
   15.88 +     (println "\"caching entire video structure... this will take a while... go get a snack or something :)\"")
   15.89 +     (FileUtils/deleteDirectory (cache-path video))
   15.90 +     (FileUtils/forceMkdir (cache-path video))
   15.91 +     (write-frames video  (cache-path video)))))
   15.92 +
   15.93 +(defn cache
   15.94 +  [video]
   15.95 +  (if (already-cached video) nil (cache-frames cache-location video)))
   15.96 + 
   15.97 +(defn video-len 
   15.98 +  [video] (cache video)
   15.99 +  (alength (.list (cache-path video))))
  15.100 +(def video-len (memoize video-len))
  15.101 + 
  15.102 +(defn video-data
  15.103 +  "since the opencv version is so absolutely unreliable..."
  15.104 +  [video]
  15.105 +  (let
  15.106 +      [capture (highgui/cvCreateFileCapture (.getPath video))
  15.107 +       info {:length      (video-len video)
  15.108 +	     :width       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_WIDTH)
  15.109 +	     :height      (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FRAME_HEIGHT)
  15.110 +	     :fps         (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FPS)
  15.111 +	     :codec       (highgui/cvGetCaptureProperty capture highgui/CV_CAP_PROP_FOURCC)}]
  15.112 +    (close-capture capture)
  15.113 +    info))
  15.114 +(def video-data (memoize video-data))
  15.115 +
  15.116 +(defn- video-frame
  15.117 +  [video n] 
  15.118 +  (cache video)
  15.119 +  (let 
  15.120 +      [c++-managed  (highgui/cvLoadImage (str (File. (cache-path video) (str n "."  ext))) highgui/CV_LOAD_IMAGE_COLOR)
  15.121 +       jvm-managed (.clone c++-managed)] 
  15.122 +	 ;this bit with the cloning is so I can deal with Garbage Collection once and for all.
  15.123 +	 ;the cpp-managed image must be manually Garbage Collected, but it's clone is managed by 
  15.124 +         ;the JVM's Garbage Collector.  By getting rid of the c++ part right here and now, no 
  15.125 +         ;other function has to worry about manual garbage collection ever again.
  15.126 +         ;Unfortunately, this doesn't seem to work for certain types of files. It's not file-size
  15.127 +         ;which is the issue, but something involving the image header.
  15.128 +    (cxcore/cvReleaseImage (.pointerByReference c++-managed))
  15.129 +    jvm-managed
  15.130 +))
  15.131 +  
  15.132 +
  15.133 +(defn- video-frame-buffered
  15.134 +  "takes one frame from a video in constant time"
  15.135 +  [video n]
  15.136 +  (cache video)
  15.137 +  (ImageIO/read (File. (cache-path video) (str n "."  ext))))
  15.138 +
  15.139 +
  15.140 +(defn- dumb-write 
  15.141 +  [video n writer]
  15.142 +  (let 
  15.143 +      [c++-managed  (highgui/cvLoadImage (str (File. (cache-path video) (str n ext))) highgui/CV_LOAD_IMAGE_COLOR)]
  15.144 +    (highgui/cvWriteFrame writer  c++-managed)
  15.145 +    (cxcore/cvReleaseImage (cxcore$IplImage$PointerByReference. c++-managed))))
  15.146 +
  15.147 +(defn video-seq
  15.148 +  "makes a lazy sequence of IPL images"
  15.149 +  ;additionally, I want to pass metadata around with the sequence.
  15.150 +  [video] (cache video)
  15.151 +  (map #(video-frame video %) (range (video-len video))))
  15.152 +
  15.153 +
  15.154 +
  15.155 +
  15.156 +
  15.157 +
  15.158 +(comment
  15.159 +
  15.160 +; I initially decided to use .sr because it loads the fastest out of all the 
  15.161 +; formats opencv supports, under a simple benchmark of reading/writing
  15.162 +; a blank file of each  type 100 times.
  15.163 +
  15.164 +  ;I just kept changing the file extention at the REPL to generate these times.     
  15.165 +  (def file "test.tiff")
  15.166 +  (do 
  15.167 +    (time (dotimes [_ 100] (highgui/cvSaveImage (str cache-location file) ipl)))
  15.168 +    (time (dotimes [_ 100]  (highgui/cvLoadImage (str cache-location file)))))
  15.169 +
  15.170 +  ;      Write              Read
  15.171 +  (jpg  4404.000955 msecs 3397.8564   msecs)
  15.172 +  (jpeg 4376.138853 msecs 3482.990118 msecs)
  15.173 +  (jpeg 4253.721501 msecs 3414.004122 msecs)
  15.174 +  (bmp  3488.281695 msecs  786.883035 msecs)
  15.175 +  (dib  3589.010247 msecs  685.681985 msecs)
  15.176 +  (jpe  4288.541679 msecs 3359.819425 msecs)
  15.177 +  (png 10127.648557 msecs 3786.184994 msecs)
  15.178 +  (pbm  3880.794141 msecs  917.737667 msecs)
  15.179 +  (pgm  3879.710445 msecs  894.78237  msecs)
  15.180 +  (ppm  3938.319148 msecs 1014.412766 msecs)
  15.181 +  (sr   3510.893891 msecs  676.502596 msecs)
  15.182 +  (dib  3434.654784 msecs  737.495844 msecs)
  15.183 +  (bmp  3354.956726 msecs  783.353025 msecs)
  15.184 +  (ras  3351.400751 msecs  722.548007 msecs)
  15.185 +  (tiff 3657.893326 msecs 1361.576798 msecs)
  15.186 +  (tif  3594.753736 msecs 1254.568533 msecs)
  15.187 +
  15.188 +;Ah, but now it's time for some more tests.
  15.189 +;I started using
  15.190 +(def ext ".sr")
  15.191 +;, and an empty cache, and ran
  15.192 +(cache lian)
  15.193 +"caching entire video structure... this will take a while... go get a snack or something :)"
  15.194 +"Elapsed time: 56486.816728 msecs"
  15.195 +(time (dorun (video-seq lian)))
  15.196 +"Elapsed time: 120515.66221 msecs"
  15.197 +(time (dorun (video-seq lian)))
  15.198 +"Elapsed time: 122867.82989 msecs" ;good agreement with times
  15.199 +
  15.200 +;*erased vision cache with*
  15.201 +;*rm -rf ~/Desktop/vision-cache *
  15.202 +(def ext ".bmp")
  15.203 +(cache lian)
  15.204 +"Elapsed time: 59613.624691 msecs"
  15.205 +(time (dorun (video-seq lian)))
  15.206 +"Elapsed time: 123850.390784 msecs"
  15.207 +
  15.208 +;same process except with
  15.209 +(def ext ".jpg")
  15.210 +(cache lian)
  15.211 +"Elapsed time: 139964.031921 msecs"
  15.212 +(time (dorun (video-seq lian)))
  15.213 +"Elapsed time: 127740.50204 msecs"
  15.214 +
  15.215 +;I find this quite shocking --- the jpg's do take longer to cache,
  15.216 +;but the processing time is almost the same!
  15.217 +
  15.218 +;since lian is 434 MB as a bunch of jpg files, and 3.7 GB as .sr files,
  15.219 +;I'll go with the jpgs.
  15.220 +
  15.221 +
  15.222 +;; writing files
  15.223 +
  15.224 +"JPG"
  15.225 +(time (write-video sarah (File. "/home/r/Desktop/clojure2.avi")))
  15.226 +"Elapsed time: 371541.024455 msecs"
  15.227 +
  15.228 +"BMP"
  15.229 +(time (write-video sarah (File. "/home/r/Desktop/clojure3.avi")))
  15.230 +"Elapsed time: 382568.502361 msecs"
  15.231 +
  15.232 +)

    16.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.2 +++ b/src/clojureDemo/VisionReader.clj	Fri Aug 20 00:32:44 2010 -0400
    16.3 @@ -0,0 +1,31 @@
    16.4 +(ns clojureDemo.VisionReader
    16.5 +  (:gen-class
    16.6 +   :implements [connections.WiredBox]
    16.7 +   :methods [ [process [Object] void] [setFile [Object] void] ]
    16.8 +   :post-init register))
    16.9 +
   16.10 +(import '(davidNackoul PlotUnitMatchAlgorithm StoryGraph PlotUnit))
   16.11 +(import '(bridge.reps.things Sequence Thing))
   16.12 +
   16.13 +
   16.14 +(defn -setFile
   16.15 +  [this file]
   16.16 +  (println "file is " file))
   16.17 +
   16.18 +(defn -register
   16.19 +   "equivalent to Connections.getPorts(this).addSignalProcessor(\"process\"); in Java"
   16.20 +   [this]
   16.21 +   (println "ClojureBox  (register) : Register is run 
   16.22 +    only when the object is created, as if it were in every constructor.")
   16.23 +   (. (connections.Connections/getPorts this) addSignalProcessor "process"))
   16.24 +
   16.25 +(defn -process [ _ _ ]
   16.26 +  (println "ClojureBox (process) :  This is a LISP function, 
   16.27 +   being called through Java, through the wiredBox metaphor."))
   16.28 +
   16.29 +(defn -getName
   16.30 +  "the [_] means that  the function gets an explicit 'this'
   16.31 +    argument, just like python. In this case we don't care about it."
   16.32 +  [_]  "VisionReader")
   16.33 +
   16.34 + 

    17.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    17.2 +++ b/src/clojureDemo/WiredDemo.clj	Fri Aug 20 00:32:44 2010 -0400
    17.3 @@ -0,0 +1,40 @@
    17.4 +(ns clojureDemo.WiredDemo
    17.5 +(		
    17.6 + :gen-class
    17.7 + :implements [connections.WiredBox]
    17.8 + :methods [ [process [Object] void]]
    17.9 + :post-init register
   17.10 +)
   17.11 +)
   17.12 +   
   17.13 +
   17.14 +(defn -register [this]
   17.15 +
   17.16 +; translate:
   17.17 +; Connections.getPorts(this).addSignalProcessor("process");
   17.18 +; ---- to -----
   17.19 +
   17.20 +(println "ClojureBox  (register) : Register is run only when the object is created, like a constructor.")
   17.21 +
   17.22 +(. (connections.Connections/getPorts this) addSignalProcessor "process")
   17.23 +
   17.24 +
   17.25 +)
   17.26 +
   17.27 +
   17.28 +(defn -process [ _ _ ]
   17.29 +(println "ClojureBox (process) :  This is a LISP function, being called through Java, through the wiredBox metaphor.")
   17.30 +)
   17.31 +
   17.32 +
   17.33 +
   17.34 +
   17.35 +(
   17.36 +defn -getName [_]  "ClojureBox"
   17.37 +
   17.38 +; the [_] means that  the function gets an explicit "this" argument, like python,
   17.39 +; but we don't care about it.
   17.40 +
   17.41 +)
   17.42 +
   17.43 + 

    18.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    18.2 +++ b/src/clojureDemo/Xuggle.clj	Fri Aug 20 00:32:44 2010 -0400
    18.3 @@ -0,0 +1,221 @@
    18.4 +(ns clojureDemo.Xuggle)
    18.5 +
    18.6 +(import '(ij ImagePlus IJ))
    18.7 +(import '(java.awt Rectangle Robot Toolkit) )
    18.8 +(import '(java.awt.image BufferedImage) )
    18.9 +(import '(java.awt Graphics2D Panel))
   18.10 +(import '(java.io File) )
   18.11 +(import '(javax.imageio ImageIO) )
   18.12 +(import '(com.xuggle.mediatool ToolFactory))
   18.13 +(import '(com.xuggle.mediatool IMediaDebugListener IMediaDebugListener$Event))
   18.14 +(import '(com.xuggle.mediatool MediaToolAdapter MediaListenerAdapter))
   18.15 +(import '(com.xuggle.xuggler IContainer IContainer$Type IPacket))
   18.16 +(import '(javax.swing JFrame))
   18.17 +(import '(com.xuggle.mediatool IMediaWriter))
   18.18 +(import '(org.apache.commons.io FileUtils))
   18.19 +(import '(javax.imageio.stream FileImageOutputStream))
   18.20 +(import '(javax.imageio ImageWriteParam IIOImage))
   18.21 +(import '(com.xuggle.xuggler IRational))
   18.22 +(import '(java.util.concurrent TimeUnit))
   18.23 +(import '(com.xuggle.xuggler ICodec))
   18.24 +
   18.25 +(use  'clojureDemo.Defines)
   18.26 +;(use '[clojureDemo.OpenCv :only (video-data)])
   18.27 +
   18.28 +
   18.29 +
   18.30 +(import '(java.io File))
   18.31 +(import '(org.apache.commons.io FileUtils))
   18.32 +(import '(javax.imageio ImageIO) )
   18.33 +
   18.34 +(import '(ij.plugin PlugIn))
   18.35 +(import '(ij ImagePlus IJ))
   18.36 +
   18.37 +
   18.38 +(use 'clojure.contrib.repl-utils)
   18.39 +(use ['clojureDemo.Defines 
   18.40 +      :only '(
   18.41 +	     lian look getto human0 blow base app0 app1 app2 app3 app4 app5 
   18.42 +		  bounce0 bounce1 bounce2 bounce3 bounce4 bounce5 bounce6
   18.43 +		  collide0 collide1 collide2 collide3 collide4  
   18.44 +		  give0 give1 give2 give3 give4 target default)])
   18.45 +
   18.46 +
   18.47 +;(def hamster (ImagePlus. "lklk" (first (video-seq look))))
   18.48 +
   18.49 +
   18.50 +
   18.51 +
   18.52 +
   18.53 +(defn- makePanel [image] (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))
   18.54 +
   18.55 +
   18.56 +(defmulti  display "Creates a JFrame and displays a buffered image"  class)
   18.57 +
   18.58 +(defmethod display 
   18.59 +  BufferedImage  [image] 
   18.60 +  (let [panel (makePanel image)
   18.61 +	frame (JFrame. "Oh Yeah!")]
   18.62 +    (.add frame panel) 
   18.63 +    (.pack frame) 
   18.64 +    (.setVisible frame true ) 
   18.65 +    (.setSize frame(.getWidth image) (.getHeight image))))
   18.66 + 
   18.67 +(defmethod display
   18.68 +  ImagePlus [image]
   18.69 +  (display (.getBufferedImage image)))
   18.70 +
   18.71 +
   18.72 +
   18.73 +
   18.74 +(defn flash
   18.75 +     [image]
   18.76 +     
   18.77 +     (.start (Thread. (fn [] 
   18.78 +			(do 
   18.79 +			  (.show image)
   18.80 +			  (.updateAndRepaintWindow image)
   18.81 +			  (Thread/sleep 4000)
   18.82 +			  (.hide image))))))
   18.83 +
   18.84 +
   18.85 +(defn readerRecurse
   18.86 +  "calls .readPacket until there's nothing left to do"
   18.87 +  [reader]
   18.88 +  (if (not (nil? (.readPacket reader))) ; here .readPacket actually does the processing as a side-effect.
   18.89 +    nil                                   ; it returns null when it has MORE to process, and signals an error when done... 
   18.90 +    (recur reader)))
   18.91 +
   18.92 +
   18.93 +(def *cache-directory* (File. "/home/r/Desktop/vision-cache"))
   18.94 +(def *ext* "jpg")
   18.95 +
   18.96 +
   18.97 +
   18.98 +
   18.99 +(defn writeJpg
  18.100 +  "WTF is this shit?!"
  18.101 +  [image target quality]
  18.102 +  (let [jpgWriter (.next (ImageIO/getImageWritersByFormatName *ext*))]
  18.103 +    (doto (.getDefaultWriteParam jpgWriter) 
  18.104 +      (.setCompressionMode ImageWriteParam/MODE_EXPLICIT)
  18.105 +      (.setCompressionQuality quality))
  18.106 +    (doto jpgWriter
  18.107 +      (.setOutput (FileImageOutputStream. target))
  18.108 +      (.write (IIOImage. image nil nil))
  18.109 +      (.dispose))))
  18.110 +    
  18.111 +
  18.112 +
  18.113 +(defn cache-path
  18.114 +  [video]
  18.115 +  (File. *cache-directory* (.getName video)))
  18.116 +
  18.117 +(defn video-frame-path
  18.118 +     [video n]
  18.119 +     (File. (cache-path video)  (str n "."  *ext*)))
  18.120 +
  18.121 +
  18.122 +(defn already-cached
  18.123 +  "this is the simplest and most retarded way to do it"
  18.124 +  [video]
  18.125 +  (.exists (cache-path video)))
  18.126 +
  18.127 +
  18.128 + 
  18.129 + 
  18.130 +
  18.131 +
  18.132 +(defn make-incrementer [start increment] (let [a (ref (- start increment))] (fn [] (dosync (ref-set a (+ @a increment))))))
  18.133 +
  18.134 +(defn make-frame-writer
  18.135 +  [video]
  18.136 +  (let [incrementer (make-incrementer 0 1)]
  18.137 +  (proxy [MediaListenerAdapter] [] 
  18.138 +    
  18.139 +    (onVideoPicture
  18.140 +     [event]
  18.141 +     ;(println (.getImage event))
  18.142 +     ;(println (File. (cache-path video) (str (incrementer) "." *ext* ) ))
  18.143 +     
  18.144 +     (let [target  (File. (cache-path video) (str (incrementer) "." *ext* ))]
  18.145 +       (if (= *ext* "jpg")
  18.146 +	 (writeJpg (.getImage event)  target  1)
  18.147 +	 (ImageIO/write (.getImage event) *ext* target )))))))
  18.148 +    
  18.149 +
  18.150 +
  18.151 +(defn cache 
  18.152 +  "caching of frames without opencv"
  18.153 +  [video]
  18.154 +  
  18.155 +  (if (already-cached video)
  18.156 +    nil 
  18.157 +    (time
  18.158 +    (let [reader (ToolFactory/makeReader (str video))]
  18.159 +      (println "slow cache!")
  18.160 +      (FileUtils/forceMkdir (cache-path video))
  18.161 +      (doto reader
  18.162 +	(.setBufferedImageTypeToGenerate BufferedImage/TYPE_3BYTE_BGR)
  18.163 +	(.addListener  (make-frame-writer video))
  18.164 +	(.addListener (ToolFactory/makeDebugListener (into-array [IMediaDebugListener$Event/META_DATA]))))
  18.165 +      (readerRecurse reader)))))
  18.166 +
  18.167 +
  18.168 +(defn video-data 
  18.169 +  "get video data without opencv"
  18.170 +  [video] (cache video)
  18.171 +
  18.172 +  
  18.173 +  {:length (- (count (file-seq (cache-path video))) 1)
  18.174 +   :width  (.getWidth (ImagePlus. (str (video-frame-path video 0))))
  18.175 +   :height (.getHeight (ImagePlus. (str (video-frame-path video 0))))
  18.176 +   :fps 30}) ; yeah --- I'll figure this out later.
  18.177 + (def video-data (memoize video-data))
  18.178 +
  18.179 +
  18.180 +
  18.181 +(defn convert
  18.182 +  "takes video and converts it to a new type of video"
  18.183 +  [videoInput videoOutput]
  18.184 +  (let [reader (ToolFactory/makeReader (str videoInput))]
  18.185 +    (doto reader
  18.186 +      (.addListener (ToolFactory/makeWriter (str videoOutput) reader))
  18.187 +      (.addListener (ToolFactory/makeDebugListener (into-array [IMediaDebugListener$Event/META_DATA]))))
  18.188 +    (readerRecurse reader)))
  18.189 +
  18.190 +
  18.191 +(import '(com.xuggle.xuggler.video ConverterFactory))
  18.192 +
  18.193 +
  18.194 +(defn trans-save
  18.195 +  "this is a transitive way to save a stream to an avi file.
  18.196 +   It uses meta data to determine what fps to use to encode."
  18.197 +  [destination video-seq]
  18.198 +  (let [data (meta video-seq)
  18.199 +	writer (ToolFactory/makeWriter (str destination))
  18.200 +	incrementer (make-incrementer 0 (/ 1 30))]
  18.201 +    (.addVideoStream writer 0 0 (ICodec/findEncodingCodecByName "mpeg4") 
  18.202 +		     (IRational/make (double (:fps data))) 
  18.203 +		     (int (:width data)) (int (:height data)))
  18.204 +    (dorun (map  #(.encodeVideo writer 0 
  18.205 +			 (ConverterFactory/convertToType (.getBufferedImage %) BufferedImage/TYPE_3BYTE_BGR) 
  18.206 +			(long (* 1000000000 (incrementer)))  TimeUnit/NANOSECONDS)  video-seq))
  18.207 +	(.close writer))
  18.208 +  video-seq)
  18.209 +
  18.210 +
  18.211 +(defn video-seq 
  18.212 +  "let's use ImagePlus stuff!"
  18.213 +  ([video] (cache video) 
  18.214 +    (with-meta (map #(ImagePlus. (str (video-frame-path video %))) (range (:length (video-data video))) ) (video-data video))))
  18.215 +
  18.216 +
  18.217 +
  18.218 +
  18.219 +
  18.220 +
  18.221 +(comment 
  18.222 +  (do (use :reload-all 'clojureDemo.Xuggle) (in-ns 'clojureDemo.Xuggle))
  18.223 +)
  18.224 + 

    19.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.2 +++ b/src/clojureDemo/appeture.clj	Fri Aug 20 00:32:44 2010 -0400
    19.3 @@ -0,0 +1,103 @@
    19.4 +(ns clojureDemo.appeture)
    19.5 +
    19.6 +(use 'clojure.contrib.repl-utils)
    19.7 +(use 'clojure.contrib.accumulators)
    19.8 +
    19.9 +"right now this only will work on odd square arrays"
   19.10 +
   19.11 +(def rrr {[0 0] 20 , [1 0] 20, [2 0] 20
   19.12 +	  [0 1]  0 , [1 1]  0, [2 1]  0
   19.13 +	  [0 2]  0 , [1 2]  0, [2 2]  0})
   19.14 +
   19.15 +(def rrrr {[0 0] 20 , [1 0] 20, [2 0] 20 , [3 0] 20, [4 0] 20,
   19.16 +	   [0 1] 20 , [1 1] 20, [2 1] 20 , [3 1] 20, [4 1] 20,
   19.17 +	   [0 2]  0 , [1 2]  0, [2 2]  0 , [3 2] 0,  [4 2] 0,
   19.18 +	   [0 3]  0 , [1 3]  0, [2 3]  0 , [3 3] 0,  [4 3] 0,
   19.19 +	   [0 4]  0 , [1 4]  0, [2 4]  0 , [3 4] 0,  [4 4] 0,})
   19.20 +
   19.21 +(defn vector-mul
   19.22 +  [mul vect]
   19.23 +  (apply vector (map #(* mul %) vect)) )
   19.24 +
   19.25 +(defn vector-sum
   19.26 +  ([] 0)
   19.27 +  ([& args] 
   19.28 +  (apply vector (reduce #(map + %1 %2) args))))
   19.29 +
   19.30 +(defn vector-sub
   19.31 +  [vector1 vector2]
   19.32 +  (vector-sum vector1 (vector-mul -1 vector2)))
   19.33 + 
   19.34 +(defn vector-dot
   19.35 +  [vector1 vector2]
   19.36 +  (reduce + (map * vector1 vector2)))
   19.37 +
   19.38 +(defn center
   19.39 +  [window]
   19.40 +  (let [coords (keys window)]
   19.41 +  (vector-mul (/ 1 (count coords)) (apply vector-sum coords))))
   19.42 +
   19.43 +(defn window-segmentate
   19.44 +  [window line]
   19.45 +  (let [center (center window)]
   19.46 +  (letfn [(path   [window] (filter (fn [point] (apply = (line center point))) (keys window)))
   19.47 +	  (top    [window] (filter (fn [point] (apply > (line center point))) (keys window)))
   19.48 +	  (bottom [window] (filter (fn [point] (apply < (line center point))) (keys window)))]
   19.49 +     {:top (top window) :bottom (bottom window) :line (path window)})))
   19.50 +
   19.51 +(defn diag1
   19.52 +  [window]
   19.53 +  (window-segmentate window (fn [center point] (list (first  (vector-sub point center)) (-(last  (vector-sub point center)))))))
   19.54 +
   19.55 +(defn diag2
   19.56 +  [window]
   19.57 +(window-segmentate window  (fn [center point] (list (first (vector-sub point center)) (last  (vector-sub point center))))))
   19.58 + 
   19.59 +(defn vert
   19.60 +  [window]
   19.61 +(window-segmentate window  (fn [center point] (list (first (vector-sub point center)) 0))))
   19.62 + 
   19.63 +(defn horiz
   19.64 +  [window]
   19.65 +(window-segmentate window  (fn [center point] (list 0 (last (vector-sub point center))))))
   19.66 +
   19.67 +
   19.68 + 
   19.69 +
   19.70 + 
   19.71 +
   19.72 +(defn lines
   19.73 +  [window]    
   19.74 +    (let [lines (list (vert window) (horiz window) (diag1 window) (diag2 window))]
   19.75 +      lines))
   19.76 +;This is the wrong model.  Higher level processors should set these paramaters, and 
   19.77 +; juggle them around if they aren't getting anything they understand.
   19.78 +
   19.79 +
   19.80 +
   19.81 +(defn stats-base
   19.82 +  [sections window sel-fun]
   19.83 + (let [stats-top    (add-items empty-mean-variance (map window (:top sections)))
   19.84 +	stats-bottom (add-items empty-mean-variance (map window (:bottom sections)))]
   19.85 +   (let [ var1 (:variance stats-top) mean1 (:mean stats-top) var2 (:variance stats-bottom) mean2 (:mean stats-bottom)]
   19.86 +     (sel-fun var1 mean1 var2 mean2))))
   19.87 +
   19.88 +(defn window-line
   19.89 +  [window transformation detection]
   19.90 +  (let [x-window (transformation window)]
   19.91 +    (first (filter #(stats-base % x-window detection) (lines x-window)))))
   19.92 +	       
   19.93 +(defn window-stats
   19.94 +  ([window] (window-stats window identity))
   19.95 +  ([window transformation]
   19.96 +  (let [x-window (transformation window)]
   19.97 +    (map (fn [line] (stats-base line x-window #(list %1 %2 %3 %4))) (lines x-window)))))
   19.98 +
   19.99 +
  19.100 +
  19.101 +
  19.102 +(comment 
  19.103 +
  19.104 +(do (use :reload-all 'clojureDemo.appeture) (in-ns 'clojureDemo.appeture))
  19.105 +
  19.106 +)

    20.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    20.2 +++ b/src/clojureDemo/explore.clj	Fri Aug 20 00:32:44 2010 -0400
    20.3 @@ -0,0 +1,11 @@
    20.4 +(ns clojureDemo.explore)
    20.5 +
    20.6 +(use 'clojure.contrib.accumulators)
    20.7 +(use 'clojure.contrib.repl-utils)
    20.8 +
    20.9 +
   20.10 +(comment 
   20.11 +
   20.12 +(do (use :reload-all 'clojureDemo.explore) (in-ns 'clojureDemo.explore))
   20.13 +
   20.14 +)

    21.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    21.2 +++ b/src/clojureDemo/import_java_fns.clj	Fri Aug 20 00:32:44 2010 -0400
    21.3 @@ -0,0 +1,10 @@
    21.4 +(ns clojureDemo.import-java-fns)
    21.5 +
    21.6 +
    21.7 +
    21.8 +(defmacro single-arg-fn [package fun]
    21.9 +  (let [name (symbol (str package "/" fun))]
   21.10 +  `(defn ~fun [a#] (~name a#))))
   21.11 +
   21.12 +(defmacro java-map [package & fns]
   21.13 +  `(do ~@(map #(list 'single-arg-fn package %) fns)))

    22.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    22.2 +++ b/src/clojureDemo/librlm.clj	Fri Aug 20 00:32:44 2010 -0400
    22.3 @@ -0,0 +1,11 @@
    22.4 +(ns clojureDemo.librlm)
    22.5 +
    22.6 +  (defmethod*  - java.lang.Boolean [x] (not x))
    22.7 +
    22.8 +;  (defmethod + [java.lang.Boolean java.lang.Boolean]
    22.9 +;    [a b] (or a b))
   22.10 +  
   22.11 +;  (defmethod * [java.lang.Boolean java.lang.Boolean]
   22.12 +;    [a b] (and a b))
   22.13 +  
   22.14 +;  (defmethod / java.lang.Boolean [x] x)

    23.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    23.2 +++ b/src/clojureDemo/librlm.clj~	Fri Aug 20 00:32:44 2010 -0400
    23.3 @@ -0,0 +1,11 @@
    23.4 +(ns clojureDemo.librlm)
    23.5 +
    23.6 +;  (defmethod*  - java.lang.Boolean [x] (not x))
    23.7 +
    23.8 +;  (defmethod + [java.lang.Boolean java.lang.Boolean]
    23.9 +;    [a b] (or a b))
   23.10 +  
   23.11 +;  (defmethod * [java.lang.Boolean java.lang.Boolean]
   23.12 +;    [a b] (and a b))
   23.13 +  
   23.14 +;  (defmethod / java.lang.Boolean [x] x)

    24.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.2 +++ b/src/clojureDemo/project-euler.clj~	Fri Aug 20 00:32:44 2010 -0400
    24.3 @@ -0,0 +1,16 @@
    24.4 +
    24.5 +
    24.6 +(ns clojureDemo.project-euler)
    24.7 +
    24.8 +
    24.9 +(use 'clojureDemo.rlm)
   24.10 +(rlm-base-load)
   24.11 +
   24.12 +(defn range-sum 
   24.13 +"calculates the sum of a range.  Takes the exact same arguments
   24.14 + as clojure.core/range"
   24.15 +([end]
   24.16 +   (/ (* end (- end 1) ) 2)))
   24.17 +
   24.18 +
   24.19 +

    25.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    25.2 +++ b/src/clojureDemo/project_euler.clj	Fri Aug 20 00:32:44 2010 -0400
    25.3 @@ -0,0 +1,559 @@
    25.4 +
    25.5 +(ns clojureDemo.project-euler
    25.6 +
    25.7 +(:refer-clojure :exclude [+ - / * 
    25.8 +			  assoc conj dissoc empty get into seq
    25.9 +			  = < > <= >= zero?
   25.10 +			  ])
   25.11 +
   25.12 +(:use [clojure.contrib.generic
   25.13 +	 arithmetic
   25.14 +	 collection
   25.15 +	 comparison
   25.16 +	 ])
   25.17 +
   25.18 +(:use [clojure.contrib
   25.19 +	 combinatorics
   25.20 +	 repl-utils
   25.21 +	 def
   25.22 +	 duck-streams
   25.23 +	 shell-out
   25.24 +	 import-static
   25.25 +	 lazy-seqs
   25.26 +	 logging
   25.27 +	 map-utils
   25.28 +	 math
   25.29 +	 mock
   25.30 +	 monads
   25.31 +	 ns-utils
   25.32 +         seq-utils
   25.33 +         function-utils
   25.34 +       profile
   25.35 +       str-utils
   25.36 +	 ])
   25.37 +
   25.38 +(:use [clojure.contrib.pprint :exclude [write]])
   25.39 +  
   25.40 +(:use [clojure.contrib.pprint.examples
   25.41 +	 hexdump
   25.42 +	 json
   25.43 +	 multiply
   25.44 +	 props
   25.45 +	 show-doc
   25.46 +	 xml
   25.47 +	 ])
   25.48 +
   25.49 +(:import java.io.File)
   25.50 +(:import [java.util Calendar Date])
   25.51 +
   25.52 +)
   25.53 +
   25.54 +
   25.55 +
   25.56 +
   25.57 +
   25.58 +(defn range-sum 
   25.59 +  "calculates the sum of a range.  Takes the exact same arguments
   25.60 +  as clojure.core/range equilivent to (reduce + (range start end step)), but O(1)."
   25.61 +  ([end]
   25.62 +     (/ (* end (- end 1) ) 2))
   25.63 +  
   25.64 +  ([start end]
   25.65 +     (- (range-sum end) (range-sum start)))
   25.66 +
   25.67 +  ([start end step]
   25.68 +     (letfn [(zero-sum [end step] (* step (range-sum 0 (ceil (/ end step)))))]
   25.69 +     (+ (zero-sum (- end start) step) (* start (int (/ (- end start) step)))))))
   25.70 +
   25.71 +
   25.72 +
   25.73 +(defn range-sum-squares
   25.74 +  "equivalent to (reduce + (map #(expt % 2) (range start end step))), 
   25.75 +   but runs in O(1) time."
   25.76 +  ([end]
   25.77 +     (let [n (- end 1)]
   25.78 +     (- (* (expt n 3) 1/3) ;continous volume
   25.79 +	(+ (* -1/6 n) (* -1/2 (expt n 2)))))) ;discrete correction
   25.80 +
   25.81 +   ([start end]
   25.82 +     (- (range-sum-squares end) (range-sum-squares start)))
   25.83 +
   25.84 +   ([start end step]
   25.85 +      ;; (letfn [(zero-sum-squares [end step]
   25.86 +      ;; 				(* step step (range-sum-squares 0 (ceil (/ end step)))))]
   25.87 +      ;; 	(+ 
   25.88 +      ;; 	 (* 2 step (range-sum (ceil (/ (- end start) step))))
   25.89 +      ;; 	 (zero-sum end step) 
   25.90 +      ;; 	 (* start start (int (/ (- end start) step)))))))
   25.91 +))	
   25.92 +
   25.93 +
   25.94 +(defn prime-factors 
   25.95 +  "all the prime factors of the number n"
   25.96 +  [n]
   25.97 +  (filter #(= 0 (rem n %)) (for [p primes :while (<= p n)] p)))
   25.98 +
   25.99 +(defn factor? [a b] (= 0 (rem a b)))
  25.100 +
  25.101 +(defn factor-map [a b]
  25.102 +  (if (factor? a b) 
  25.103 +	{b (quot a b)}
  25.104 +	nil))
  25.105 +
  25.106 +
  25.107 +(defn divides? [numerator divisor] (= (rem numerator divisor) 0))
  25.108 +
  25.109 +
  25.110 +(def != (comp not =))
  25.111 +
  25.112 +
  25.113 +(defn decompose [number factor]
  25.114 +    (loop [n number counter 0]
  25.115 +      (if (!= (rem n factor) 0)
  25.116 +        counter
  25.117 +	(recur (/ n factor) (inc counter)))))
  25.118 +
  25.119 +	
  25.120 +
  25.121 +
  25.122 +
  25.123 +
  25.124 +
  25.125 +(defn single-factor [{num :current-num index :prime-index factors :prime-factors :as old-state}]
  25.126 +  (let [divisor (nth primes index)
  25.127 +	new-index (inc index)
  25.128 +	done? (= num 1)]
  25.129 +    (if (divides? num divisor)
  25.130 +      (let [new-num (/ num (expt divisor (decompose num divisor)))   
  25.131 +	    factors (assoc factors divisor (decompose num divisor))]
  25.132 +	[[factors done?] (assoc old-state
  25.133 +		 :current-num new-num :prime-index new-index :prime-factors factors)])
  25.134 +      
  25.135 +      [[factors done?] (assoc old-state 
  25.136 +	       :current-num num :prime-index new-index :prime-factors factors)])))
  25.137 +      
  25.138 +
  25.139 +(defn wtf "a is not used" [a] (domonad state-m [part single-factor] part))
  25.140 +
  25.141 +(defn fuck-it [] 
  25.142 +  (domonad state-m 
  25.143 +	   [[factors done?]
  25.144 +	    (state-m-until second wtf nil)]
  25.145 +	   
  25.146 +	   factors))
  25.147 +
  25.148 +(defn prime-factor-map [num]
  25.149 +  
  25.150 +  (first ((fuck-it) {:prime-factors {}
  25.151 +		     :prime-index 0
  25.152 +		     :current-num num})))
  25.153 +
  25.154 +(defn prime-factors-monad [num]
  25.155 +  (sort (keys (prime-factor-map num))))
  25.156 +
  25.157 +
  25.158 +
  25.159 +
  25.160 +
  25.161 +
  25.162 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25.163 +;; fun with state monad
  25.164 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25.165 +
  25.166 +
  25.167 +(defn ++ [{num :num :as world}]
  25.168 +  (let [num++ (inc num)]
  25.169 +    [num++ (assoc world :num num++)]))
  25.170 +
  25.171 +(defn huh? []
  25.172 +  (with-monad state-m 
  25.173 +    (domonad [x ++
  25.174 +	      y ++]
  25.175 +	     y)))
  25.176 +
  25.177 +
  25.178 +(comment 
  25.179 +
  25.180 +huh?
  25.181 +->
  25.182 +((let [m-bind (fn m-bind-state [mv f]
  25.183 +		(fn [s]
  25.184 +		  (let [[v ss] (mv s)]
  25.185 +		    ((f v) ss))))] 
  25.186 +       (m-bind
  25.187 +	++ (fn [x] ++))) {:num 1})
  25.188 +
  25.189 +
  25.190 +)
  25.191 +
  25.192 +
  25.193 +(defn wordify [n] (cl-format nil "~R" n))
  25.194 +    
  25.195 +(defn british-letter-count-prof [n]
  25.196 +  (prof :total
  25.197 +  (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))
  25.198 +	word (prof :wordify (wordify n))
  25.199 +	word-seq (prof :sequence (seq word))
  25.200 +	word-filter (prof :filter (filter #(Character/isLetter %) word-seq))
  25.201 +	word-count (prof :count (count word-filter))
  25.202 +	answer (prof :add (+ and? word-count))]
  25.203 +    answer)))
  25.204 +
  25.205 +(defn british-letter-count-prof2 
  25.206 +"now this is faster, because it uses string manipulation.  go profiling!"
  25.207 +[n]
  25.208 +  (prof :total
  25.209 +  (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))
  25.210 +	word (prof :wordify (wordify n))
  25.211 +	word-regex (prof :regex (re-gsub #"[\W-,]" "" word))
  25.212 +	
  25.213 +	word-count (prof :count (.length word-regex))
  25.214 +	answer (prof :add (+ and? word-count))]
  25.215 +    answer)))
  25.216 +
  25.217 +
  25.218 +   
  25.219 +
  25.220 +
  25.221 +
  25.222 +
  25.223 +
  25.224 +
  25.225 +
  25.226 +
  25.227 +
  25.228 +
  25.229 +
  25.230 +
  25.231 +
  25.232 +
  25.233 +
  25.234 +
  25.235 +;pseudo code for primes
  25.236 +
  25.237 +;fn prime-decomposition
  25.238 +; [n]
  25.239 +; map = {} 
  25.240 +; 
  25.241 +; for x in primes
  25.242 +;   add to map (divide teh fick out n x)
  25.243 +;   n = n / prime-factors
  25.244 +;   if n == 1 BREAK;
  25.245 +;
  25.246 +;
  25.247 +
  25.248 +
  25.249 +
  25.250 +(defn rng [seed]
  25.251 +  (let [m      259200
  25.252 +	value  (/ (float seed) (float m))
  25.253 +	next   (rem (+ 54773 (* 7141 seed)) m)]
  25.254 +    [value next]))
  25.255 +
  25.256 +
  25.257 +(defn yeah! []
  25.258 +  (let [name sequence-m 
  25.259 +	m-bind (:m-bind name) 
  25.260 +	m-result (:m-result name) 
  25.261 +	m-zero (:m-zero name) 
  25.262 +	m-plus (:m-plus name)] 
  25.263 +
  25.264 +
  25.265 +    (m-bind (range 5) (fn [a] (m-bind [2 3] (fn [b] (m-result (+ a b))))))))
  25.266 +
  25.267 +
  25.268 +(defn ohhhh!! []
  25.269 +  
  25.270 +  (let 
  25.271 +      [name state-m 
  25.272 +       m-bind (:m-bind name) 
  25.273 +       m-result (:m-result name) ]
  25.274 +    
  25.275 +    (m-bind rng (fn [x1] (m-bind rng (fn [x2] (m-result (+ x1 x2))))))))
  25.276 +
  25.277 +
  25.278 +
  25.279 +(defmulti palindrome? class)
  25.280 +  
  25.281 +(defmethod palindrome? (class "string") [a]
  25.282 +  (= (seq a) (reverse a)))
  25.283 +
  25.284 +(defmethod palindrome? (class 500) [a]
  25.285 +  (palindrome? (str a)))
  25.286 +
  25.287 +
  25.288 +
  25.289 +
  25.290 +
  25.291 +
  25.292 +
  25.293 +
  25.294 +(defn circulars 
  25.295 +  "returns a vector of all the circular permutations of a number"
  25.296 +  [n]
  25.297 +  (map #(Integer. (apply str %)) (rotations (seq (str n)))))
  25.298 +    
  25.299 +
  25.300 +(defn prime-factors
  25.301 +  [n]
  25.302 +  (for [a primes :while (<= a n) :when (= (rem n a) 0)]  a)) 
  25.303 +
  25.304 +
  25.305 +(defmethod = [nil java.lang.Integer] [ a b ]
  25.306 +  false)
  25.307 +
  25.308 +
  25.309 +
  25.310 +(def mil 1000000)
  25.311 +(def bil 1000000000)
  25.312 +
  25.313 +(defn primes-under-million [] (apply hash-set (take 78498 primes)))
  25.314 +(def primes-under-million (memoize primes-under-million))
  25.315 +
  25.316 +
  25.317 +(defn primes-under-billion [] (apply hash-set (take 664579 primes)))
  25.318 +(def primes-under-billion (memoize primes-under-billion))
  25.319 +
  25.320 +
  25.321 +
  25.322 +
  25.323 +
  25.324 +(defn prime? [n] (not (nil? (get (primes-under-billion) n))))
  25.325 +
  25.326 +
  25.327 +(defn circular-memoize 
  25.328 +  "assumes that f is a predicate that takes in a number for which, 
  25.329 +   if the predicate is true for the number, it is also true for all
  25.330 +   of the circular permutations of the number.  Memoizes the result
  25.331 +   for all circular permutations so as to avoid subsequent computation."
  25.332 +  [f]
  25.333 +   (let [mem (atom {})]
  25.334 +    (fn [n]
  25.335 +      (if-let [e (find @mem n)]
  25.336 +        (val e)
  25.337 +        (let [ret (f n)]
  25.338 +	  (dorun (for [circ (circulars n)]
  25.339 +		   (swap! mem assoc n ret)))
  25.340 +          ret)))))
  25.341 +
  25.342 +(defn circularly-prime?
  25.343 +  [n]
  25.344 +  (not (some (comp not prime?) (circulars n))))
  25.345 +
  25.346 +(def circularly-prime? (memoize circularly-prime?))
  25.347 +
  25.348 +
  25.349 +(defmethod = :default  [& args]
  25.350 +  (apply clojure.core/= args))
  25.351 +  
  25.352 +(def logins 
  25.353 +     (map str
  25.354 +	  [319 680 180 690 129 620 762 689 762 318
  25.355 +	   368 710 720 710 629 168 160 689 716 731
  25.356 +	   736 729 316 729 729 710 769 290 719 680
  25.357 +	   318 389 162 289 162 718 729 319 790 680
  25.358 +	   890 362 319 760 316 729 380 319 728 716]))
  25.359 +
  25.360 +(defn remove-multiples [n]
  25.361 +  (reduce (fn [a b] (if (= (last a) b) a (conj a b))) [] n))
  25.362 +
  25.363 +(defn insert [item n vect]
  25.364 +  (let [split (split-at n vect)]
  25.365 +    (apply vector (flatten [(first split) item (last split)]))))
  25.366 +
  25.367 +(defn expand-code [old-code [c b a]]
  25.368 +  (let [main-length (count old-code)]
  25.369 +    (for [x (range (inc main-length)) y (range (inc x)) z (range (inc y))] 
  25.370 +      (insert c z (insert b y (insert a x old-code)))))) 
  25.371 +
  25.372 +(defn domain-expand-contract [old-domain constraint]
  25.373 +  (let [new-domain 
  25.374 +	(map remove-multiples 
  25.375 +	     (remove-multiples 
  25.376 +	      (sort 
  25.377 +	       (apply concat 
  25.378 +		      (map #(expand-code % constraint) old-domain)))))
  25.379 +	min-code-length (apply min (map count new-domain)) ]
  25.380 +    (map #(apply str %) (filter #(= (count %) min-code-length) new-domain))))
  25.381 +(def domain-expand-contract (memoize domain-expand-contract))
  25.382 +
  25.383 +
  25.384 +
  25.385 +(defn lazy-fibo 
  25.386 +  ([] (concat [0 1] (lazy-fibo 0 1)))
  25.387 +  ([a b] (let [n (+ a b)] (lazy-seq (cons n (lazy-fibo b n))))))
  25.388 +
  25.389 +
  25.390 +(defn collatz-seq [n]  
  25.391 +  (lazy-seq
  25.392 +  (cond (= n 1) [1]
  25.393 +	(even? n) (lazy-seq (cons n (collatz-seq (/ n 2))))
  25.394 +	(odd? n)  (lazy-seq (cons n (collatz-seq (+ 1 (* 3 n))))))))
  25.395 +(def collatz-seq (memoize collatz-seq))
  25.396 +
  25.397 +
  25.398 +
  25.399 +(defn pythagorean-triple? [a b c]
  25.400 +  (let [[a b c] (sort [a b c])]
  25.401 +    (= (+ (* a a) (* b b) ) (* c c))))
  25.402 +
  25.403 +
  25.404 +(defn sum-squares [coll]
  25.405 +  (reduce +  (map #(* % %) coll)))
  25.406 +
  25.407 +
  25.408 +(defn british-letter-count [n]
  25.409 +  
  25.410 +  (let [and? (if (and (> n 99) (!= 0 (rem n 100))) 3 0)]
  25.411 +
  25.412 +    (+ and? (count (filter #(Character/isLetter %) (seq (wordify n)))))))
  25.413 +
  25.414 +
  25.415 +
  25.416 +(defmacro apply-macro
  25.417 +  "This is evil.  Don't ever use it.  It makes a macro behave like a
  25.418 +  function.  Seriously, how messed up is that?
  25.419 +
  25.420 +  Evaluates all args, then uses them as arguments to the macro as with
  25.421 +  apply.
  25.422 +
  25.423 +  (def things [true true false])
  25.424 +  (apply-macro and things)
  25.425 +  ;; Expands to:  (and true true false)"
  25.426 +  [macro & args]
  25.427 +  (cons macro (flatten (map eval args))))
  25.428 +
  25.429 +(defn fun1 [] (Thread/sleep 5000) 5)
  25.430 +
  25.431 +(defn fun2 [] (Thread/sleep 30000) 5)
  25.432 +
  25.433 +
  25.434 +(def naturals (iterate inc 0))
  25.435 +  
  25.436 +
  25.437 +
  25.438 +
  25.439 +(defn race []
  25.440 +  (let [result (ref nil)
  25.441 +	threads [(Thread. (fn [] (try 
  25.442 +				  (let [answer (fun1)] 
  25.443 +				    (dosync (ref-set result answer)))
  25.444 +				  (catch Exception _ nil))))
  25.445 +		 (Thread. (fn [] (try 
  25.446 +				  (let [answer (fun2)] 
  25.447 +				    (dosync (ref-set result answer))) 
  25.448 +				  (catch Exception _ nil))))]]
  25.449 +	   
  25.450 +    (dorun (map #(.start %) threads))
  25.451 +    (loop []
  25.452 +      (if (!= (deref result) nil)
  25.453 +	(do (dorun (map #(.stop %) threads))
  25.454 +	    (deref result))
  25.455 +	(recur)))))
  25.456 +
  25.457 +
  25.458 +
  25.459 +
  25.460 +
  25.461 +
  25.462 +
  25.463 +(defn make-date [year month day] (do (let [date (Calendar/getInstance)] (.set date year month day 0 0) date)))
  25.464 +
  25.465 +(def jan-1-1901 (make-date 1900 0 1))
  25.466 +
  25.467 +(defn sunday? [#^java.util.Date date] (re-matches #"^Sun.*"  (str  date)))
  25.468 +
  25.469 +(count (filter sunday? (for [a (range 1 40000) date [(.getTime (make-date 1900 0 a)) ] :while (< (.getYear date) 100)] date )))
  25.470 +
  25.471 +
  25.472 +
  25.473 +
  25.474 +(comment
  25.475 +
  25.476 +;; ----------------------------------------------------------------------
  25.477 +;; Answers
  25.478 +;; ----------------------------------------------------------------------
  25.479 +
  25.480 +; Problem 1 
  25.481 +(+ (range-sum 0 1001 3) (range-sum 0 1001 5) (* -1 (range-sum 0 1001 15)))
  25.482 +
  25.483 +; Problem 2
  25.484 +(reduce + (for [a (filter even? (fibs)) :while (<= a 4000000 )] a))
  25.485 +
  25.486 +; Problem 3
  25.487 +(apply max (prime-factors 600851475143))
  25.488 +
  25.489 +; Problem 4
  25.490 +(reduce max (for [a (range 100 1000) b (range 100 1000) :when (palindrome? (* a b))] (* a b)))
  25.491 +
  25.492 +; Problem 5
  25.493 +(reduce lcm (range 1 21))
  25.494 +
  25.495 +; Problem 6
  25.496 +(- (expt (range-sum 101) 2) (range-sum-squares 101))
  25.497 +
  25.498 +; Problem 7
  25.499 +(nth primes 10000)
  25.500 +
  25.501 +
  25.502 +; Problem 9
  25.503 +(reduce * (first (for [a (range 1 1000) b (range 1 a) c [(sqrt (sum-squares [a b]))] 
  25.504 +      :when (= (+ a b c) 1000)] [a b c])))
  25.505 +
  25.506 +; Problem 10 
  25.507 +(reduce + (for [a primes :while (< a 2000000)] a))
  25.508 +
  25.509 +
  25.510 +
  25.511 +
  25.512 +
  25.513 +; Problem 14
  25.514 +(first (reduce (fn [a b] (if (> (count a) (count b)) a b)) [] (map collatz-seq (range 1 mil))))
  25.515 +
  25.516 +
  25.517 +; Problem 16
  25.518 +(reduce + (map #(Character/getNumericValue %) (seq (str (expt 2 1000)))))
  25.519 +
  25.520 +; Problem 17
  25.521 +(reduce + (map british-letter-count (range 1 1001)))
  25.522 +
  25.523 +
  25.524 +; Problem 24
  25.525 +(nth  (lex-permutations [ 0 1 2 3 4 5 6 7 8 9]) (- mil 1))
  25.526 +
  25.527 +; Problem 33
  25.528 +(reduce * (for [num (range 1 10) 
  25.529 +      den (range 1  10) 
  25.530 +      weird (range 1 10) 
  25.531 +      top [(+ num (* 10 weird))]
  25.532 +      bottom [(+ weird (* 10 den))]
  25.533 +      :when (and (> (/ top bottom) 1) (= (/ top bottom) (/ num den)))]
  25.534 +  (/ bottom top)))
  25.535 +
  25.536 +; Problem 35
  25.537 +(count (filter circularly-prime? (primes-under-million)))
  25.538 +
  25.539 +; Problem 40 
  25.540 +(let [fff (apply str (take 1030000 naturals))] 
  25.541 +  (reduce * (map #(Character/getNumericValue (nth fff %)) 
  25.542 +		 (map (fn [x] (expt 10 x)) (range 7)) )))
  25.543 +
  25.544 +
  25.545 +
  25.546 +
  25.547 +
  25.548 +
  25.549 +; Problem 79
  25.550 +(reduce domain-expand-contract [""] logins)
  25.551 +
  25.552 +)
  25.553 +
  25.554 +
  25.555 +
  25.556 +
  25.557 +
  25.558 +
  25.559 +
  25.560 +
  25.561 +
  25.562 +

    26.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    26.2 +++ b/src/clojureDemo/project_euler.clj~	Fri Aug 20 00:32:44 2010 -0400
    26.3 @@ -0,0 +1,559 @@
    26.4 +
    26.5 +(ns clojureDemo.project-euler
    26.6 +
    26.7 +(:refer-clojure :exclude [+ - / * 
    26.8 +			  assoc conj dissoc empty get into seq
    26.9 +			  = < > <= >= zero?
   26.10 +			  ])
   26.11 +
   26.12 +(:use [clojure.contrib.generic
   26.13 +	 arithmetic
   26.14 +	 collection
   26.15 +	 comparison
   26.16 +	 ])
   26.17 +
   26.18 +(:use [clojure.contrib
   26.19 +	 combinatorics
   26.20 +	 repl-utils
   26.21 +	 def
   26.22 +	 duck-streams
   26.23 +	 shell-out
   26.24 +	 import-static
   26.25 +	 lazy-seqs
   26.26 +	 logging
   26.27 +	 map-utils
   26.28 +	 math
   26.29 +	 mock
   26.30 +	 monads
   26.31 +	 ns-utils
   26.32 +         seq-utils
   26.33 +         function-utils
   26.34 +       profile
   26.35 +       str-utils
   26.36 +	 ])
   26.37 +
   26.38 +(:use [clojure.contrib.pprint :exclude [write]])
   26.39 +  
   26.40 +(:use [clojure.contrib.pprint.examples
   26.41 +	 hexdump
   26.42 +	 json
   26.43 +	 multiply
   26.44 +	 props
   26.45 +	 show-doc
   26.46 +	 xml
   26.47 +	 ])
   26.48 +
   26.49 +(:import java.io.File)
   26.50 +(:import [java.util Calendar Date])
   26.51 +
   26.52 +)
   26.53 +
   26.54 +
   26.55 +
   26.56 +
   26.57 +
   26.58 +(defn range-sum 
   26.59 +  "calculates the sum of a range.  Takes the exact same arguments
   26.60 +  as clojure.core/range equilivent to (reduce + (range start end step)), but O(1)."
   26.61 +  ([end]
   26.62 +     (/ (* end (- end 1) ) 2))
   26.63 +  
   26.64 +  ([start end]
   26.65 +     (- (range-sum end) (range-sum start)))
   26.66 +
   26.67 +  ([start end step]
   26.68 +     (letfn [(zero-sum [end step] (* step (range-sum 0 (ceil (/ end step)))))]
   26.69 +     (+ (zero-sum (- end start) step) (* start (int (/ (- end start) step)))))))
   26.70 +
   26.71 +
   26.72 +
   26.73 +(defn range-sum-squares
   26.74 +  "equivalent to (reduce + (map #(expt % 2) (range start end step))), 
   26.75 +   but runs in O(1) time."
   26.76 +  ([end]
   26.77 +     (let [n (- end 1)]
   26.78 +     (- (* (expt n 3) 1/3) ;continous volume
   26.79 +	(+ (* -1/6 n) (* -1/2 (expt n 2)))))) ;discrete correction
   26.80 +
   26.81 +   ([start end]
   26.82 +     (- (range-sum-squares end) (range-sum-squares start)))
   26.83 +
   26.84 +   ([start end step]
   26.85 +      ;; (letfn [(zero-sum-squares [end step]
   26.86 +      ;; 				(* step step (range-sum-squares 0 (ceil (/ end step)))))]
   26.87 +      ;; 	(+ 
   26.88 +      ;; 	 (* 2 step (range-sum (ceil (/ (- end start) step))))
   26.89 +      ;; 	 (zero-sum end step) 
   26.90 +      ;; 	 (* start start (int (/ (- end start) step)))))))
   26.91 +))	
   26.92 +
   26.93 +
   26.94 +(defn prime-factors 
   26.95 +  "all the prime factors of the number n"
   26.96 +  [n]
   26.97 +  (filter #(= 0 (rem n %)) (for [p primes :while (<= p n)] p)))
   26.98 +
   26.99 +(defn factor? [a b] (= 0 (rem a b)))
  26.100 +
  26.101 +(defn factor-map [a b]
  26.102 +  (if (factor? a b) 
  26.103 +	{b (quot a b)}
  26.104 +	nil))
  26.105 +
  26.106 +
  26.107 +(defn divides? [numerator divisor] (= (rem numerator divisor) 0))
  26.108 +
  26.109 +
  26.110 +(def != (comp not =))
  26.111 +
  26.112 +
  26.113 +(defn decompose [number factor]
  26.114 +    (loop [n number counter 0]
  26.115 +      (if (!= (rem n factor) 0)
  26.116 +        counter
  26.117 +	(recur (/ n factor) (inc counter)))))
  26.118 +
  26.119 +	
  26.120 +
  26.121 +
  26.122 +
  26.123 +
  26.124 +
  26.125 +(defn single-factor [{num :current-num index :prime-index factors :prime-factors :as old-state}]
  26.126 +  (let [divisor (nth primes index)
  26.127 +	new-index (inc index)
  26.128 +	done? (= num 1)]
  26.129 +    (if (divides? num divisor)
  26.130 +      (let [new-num (/ num (expt divisor (decompose num divisor)))   
  26.131 +	    factors (assoc factors divisor (decompose num divisor))]
  26.132 +	[[factors done?] (assoc old-state
  26.133 +		 :current-num new-num :prime-index new-index :prime-factors factors)])
  26.134 +      
  26.135 +      [[factors done?] (assoc old-state 
  26.136 +	       :current-num num :prime-index new-index :prime-factors factors)])))
  26.137 +      
  26.138 +
  26.139 +(defn wtf "a is not used" [a] (domonad state-m [part single-factor] part))
  26.140 +
  26.141 +(defn fuck-it [] 
  26.142 +  (domonad state-m 
  26.143 +	   [[factors done?]
  26.144 +	    (state-m-until second wtf nil)]
  26.145 +	   
  26.146 +	   factors))
  26.147 +
  26.148 +(defn prime-factor-map [num]
  26.149 +  
  26.150 +  (first ((fuck-it) {:prime-factors {}
  26.151 +		     :prime-index 0
  26.152 +		     :current-num num})))
  26.153 +
  26.154 +(defn prime-factors-monad [num]
  26.155 +  (sort (keys (prime-factor-map num))))
  26.156 +
  26.157 +
  26.158 +
  26.159 +
  26.160 +
  26.161 +
  26.162 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26.163 +;; fun with state monad
  26.164 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26.165 +
  26.166 +
  26.167 +(defn ++ [{num :num :as world}]
  26.168 +  (let [num++ (inc num)]
  26.169 +    [num++ (assoc world :num num++)]))
  26.170 +
  26.171 +(defn huh? []
  26.172 +  (with-monad state-m 
  26.173 +    (domonad [x ++
  26.174 +	      y ++]
  26.175 +	     y)))
  26.176 +
  26.177 +
  26.178 +(comment 
  26.179 +
  26.180 +huh?
  26.181 +->
  26.182 +((let [m-bind (fn m-bind-state [mv f]
  26.183 +		(fn [s]
  26.184 +		  (let [[v ss] (mv s)]
  26.185 +		    ((f v) ss))))] 
  26.186 +       (m-bind
  26.187 +	++ (fn [x] ++))) {:num 1})
  26.188 +
  26.189 +
  26.190 +)
  26.191 +
  26.192 +
  26.193 +(defn wordify [n] (cl-format nil "~R" n))
  26.194 +    
  26.195 +(defn british-letter-count-prof [n]
  26.196 +  (prof :total
  26.197 +  (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))
  26.198 +	word (prof :wordify (wordify n))
  26.199 +	word-seq (prof :sequence (seq word))
  26.200 +	word-filter (prof :filter (filter #(Character/isLetter %) word-seq))
  26.201 +	word-count (prof :count (count word-filter))
  26.202 +	answer (prof :add (+ and? word-count))]
  26.203 +    answer)))
  26.204 +
  26.205 +(defn british-letter-count-prof2 
  26.206 +"now this is faster, because it uses string manipulation.  go profiling!"
  26.207 +[n]
  26.208 +  (prof :total
  26.209 +  (let [and? (prof :rem-test (if (and (> n 99) (!= 0 (rem n 100))) 3 0))
  26.210 +	word (prof :wordify (wordify n))
  26.211 +	word-regex (prof :regex (re-gsub #"[\W-,]" "" word))
  26.212 +	
  26.213 +	word-count (prof :count (.length word-regex))
  26.214 +	answer (prof :add (+ and? word-count))]
  26.215 +    answer)))
  26.216 +
  26.217 +
  26.218 +   
  26.219 +
  26.220 +
  26.221 +
  26.222 +
  26.223 +
  26.224 +
  26.225 +
  26.226 +
  26.227 +
  26.228 +
  26.229 +
  26.230 +
  26.231 +
  26.232 +
  26.233 +
  26.234 +
  26.235 +;pseudo code for primes
  26.236 +
  26.237 +;fn prime-decomposition
  26.238 +; [n]
  26.239 +; map = {} 
  26.240 +; 
  26.241 +; for x in primes
  26.242 +;   add to map (divide teh fick out n x)
  26.243 +;   n = n / prime-factors
  26.244 +;   if n == 1 BREAK;
  26.245 +;
  26.246 +;
  26.247 +
  26.248 +
  26.249 +
  26.250 +(defn rng [seed]
  26.251 +  (let [m      259200
  26.252 +	value  (/ (float seed) (float m))
  26.253 +	next   (rem (+ 54773 (* 7141 seed)) m)]
  26.254 +    [value next]))
  26.255 +
  26.256 +
  26.257 +(defn yeah! []
  26.258 +  (let [name sequence-m 
  26.259 +	m-bind (:m-bind name) 
  26.260 +	m-result (:m-result name) 
  26.261 +	m-zero (:m-zero name) 
  26.262 +	m-plus (:m-plus name)] 
  26.263 +
  26.264 +
  26.265 +    (m-bind (range 5) (fn [a] (m-bind [2 3] (fn [b] (m-result (+ a b))))))))
  26.266 +
  26.267 +
  26.268 +(defn ohhhh!! []
  26.269 +  
  26.270 +  (let 
  26.271 +      [name state-m 
  26.272 +       m-bind (:m-bind name) 
  26.273 +       m-result (:m-result name) ]
  26.274 +    
  26.275 +    (m-bind rng (fn [x1] (m-bind rng (fn [x2] (m-result (+ x1 x2))))))))
  26.276 +
  26.277 +
  26.278 +
  26.279 +(defmulti palindrome? class)
  26.280 +  
  26.281 +(defmethod palindrome? (class "string") [a]
  26.282 +  (= (seq a) (reverse a)))
  26.283 +
  26.284 +(defmethod palindrome? (class 500) [a]
  26.285 +  (palindrome? (str a)))
  26.286 +
  26.287 +
  26.288 +
  26.289 +
  26.290 +
  26.291 +
  26.292 +
  26.293 +
  26.294 +(defn circulars 
  26.295 +  "returns a vector of all the circular permutations of a number"
  26.296 +  [n]
  26.297 +  (map #(Integer. (apply str %)) (rotations (seq (str n)))))
  26.298 +    
  26.299 +
  26.300 +(defn prime-factors
  26.301 +  [n]
  26.302 +  (for [a primes :while (<= a n) :when (= (rem n a) 0)]  a)) 
  26.303 +
  26.304 +
  26.305 +(defmethod = [nil java.lang.Integer] [ a b ]
  26.306 +  false)
  26.307 +
  26.308 +
  26.309 +
  26.310 +(def mil 1000000)
  26.311 +(def bil 1000000000)
  26.312 +
  26.313 +(defn primes-under-million [] (apply hash-set (take 78498 primes)))
  26.314 +(def primes-under-million (memoize primes-under-million))
  26.315 +
  26.316 +
  26.317 +(defn primes-under-billion [] (apply hash-set (take 664579 primes)))
  26.318 +(def primes-under-billion (memoize primes-under-billion))
  26.319 +
  26.320 +
  26.321 +
  26.322 +
  26.323 +
  26.324 +(defn prime? [n] (not (nil? (get (primes-under-billion) n))))
  26.325 +
  26.326 +
  26.327 +(defn circular-memoize 
  26.328 +  "assumes that f is a predicate that takes in a number for which, 
  26.329 +   if the predicate is true for the number, it is also true for all
  26.330 +   of the circular permutations of the number.  Memoizes the result
  26.331 +   for all circular permutations so as to avoid subsequent computation."
  26.332 +  [f]
  26.333 +   (let [mem (atom {})]
  26.334 +    (fn [n]
  26.335 +      (if-let [e (find @mem n)]
  26.336 +        (val e)
  26.337 +        (let [ret (f n)]
  26.338 +	  (dorun (for [circ (circulars n)]
  26.339 +		   (swap! mem assoc n ret)))
  26.340 +          ret)))))
  26.341 +
  26.342 +(defn circularly-prime?
  26.343 +  [n]
  26.344 +  (not (some (comp not prime?) (circulars n))))
  26.345 +
  26.346 +(def circularly-prime? (memoize circularly-prime?))
  26.347 +
  26.348 +
  26.349 +(defmethod = :default  [& args]
  26.350 +  (apply clojure.core/= args))
  26.351 +  
  26.352 +(def logins 
  26.353 +     (map str
  26.354 +	  [319 680 180 690 129 620 762 689 762 318
  26.355 +	   368 710 720 710 629 168 160 689 716 731
  26.356 +	   736 729 316 729 729 710 769 290 719 680
  26.357 +	   318 389 162 289 162 718 729 319 790 680
  26.358 +	   890 362 319 760 316 729 380 319 728 716]))
  26.359 +
  26.360 +(defn remove-multiples [n]
  26.361 +  (reduce (fn [a b] (if (= (last a) b) a (conj a b))) [] n))
  26.362 +
  26.363 +(defn insert [item n vect]
  26.364 +  (let [split (split-at n vect)]
  26.365 +    (apply vector (flatten [(first split) item (last split)]))))
  26.366 +
  26.367 +(defn expand-code [old-code [c b a]]
  26.368 +  (let [main-length (count old-code)]
  26.369 +    (for [x (range (inc main-length)) y (range (inc x)) z (range (inc y))] 
  26.370 +      (insert c z (insert b y (insert a x old-code)))))) 
  26.371 +
  26.372 +(defn domain-expand-contract [old-domain constraint]
  26.373 +  (let [new-domain 
  26.374 +	(map remove-multiples 
  26.375 +	     (remove-multiples 
  26.376 +	      (sort 
  26.377 +	       (apply concat 
  26.378 +		      (map #(expand-code % constraint) old-domain)))))
  26.379 +	min-code-length (apply min (map count new-domain)) ]
  26.380 +    (map #(apply str %) (filter #(= (count %) min-code-length) new-domain))))
  26.381 +(def domain-expand-contract (memoize domain-expand-contract))
  26.382 +
  26.383 +
  26.384 +
  26.385 +(defn lazy-fibo 
  26.386 +  ([] (concat [0 1] (lazy-fibo 0 1)))
  26.387 +  ([a b] (let [n (+ a b)] (lazy-seq (cons n (lazy-fibo b n))))))
  26.388 +
  26.389 +
  26.390 +(defn collatz-seq [n]  
  26.391 +  (lazy-seq
  26.392 +  (cond (= n 1) [1]
  26.393 +	(even? n) (lazy-seq (cons n (collatz-seq (/ n 2))))
  26.394 +	(odd? n)  (lazy-seq (cons n (collatz-seq (+ 1 (* 3 n))))))))
  26.395 +(def collatz-seq (memoize collatz-seq))
  26.396 +
  26.397 +
  26.398 +
  26.399 +(defn pythagorean-triple? [a b c]
  26.400 +  (let [[a b c] (sort [a b c])]
  26.401 +    (= (+ (* a a) (* b b) ) (* c c))))
  26.402 +
  26.403 +
  26.404 +(defn sum-squares [coll]
  26.405 +  (reduce +  (map #(* % %) coll)))
  26.406 +
  26.407 +
  26.408 +(defn british-letter-count [n]
  26.409 +  
  26.410 +  (let [and? (if (and (> n 99) (!= 0 (rem n 100))) 3 0)]
  26.411 +
  26.412 +    (+ and? (count (filter #(Character/isLetter %) (seq (wordify n)))))))
  26.413 +
  26.414 +
  26.415 +
  26.416 +(defmacro apply-macro
  26.417 +  "This is evil.  Don't ever use it.  It makes a macro behave like a
  26.418 +  function.  Seriously, how messed up is that?
  26.419 +
  26.420 +  Evaluates all args, then uses them as arguments to the macro as with
  26.421 +  apply.
  26.422 +
  26.423 +  (def things [true true false])
  26.424 +  (apply-macro and things)
  26.425 +  ;; Expands to:  (and true true false)"
  26.426 +  [macro & args]
  26.427 +  (cons macro (flatten (map eval args))))
  26.428 +
  26.429 +(defn fun1 [] (Thread/sleep 5000) 5)
  26.430 +
  26.431 +(defn fun2 [] (Thread/sleep 30000) 5)
  26.432 +
  26.433 +
  26.434 +(def naturals (iterate inc 0))
  26.435 +  
  26.436 +
  26.437 +
  26.438 +
  26.439 +(defn race []
  26.440 +  (let [result (ref nil)
  26.441 +	threads [(Thread. (fn [] (try 
  26.442 +				  (let [answer (fun1)] 
  26.443 +				    (dosync (ref-set result answer)))
  26.444 +				  (catch Exception _ nil))))
  26.445 +		 (Thread. (fn [] (try 
  26.446 +				  (let [answer (fun2)] 
  26.447 +				    (dosync (ref-set result answer))) 
  26.448 +				  (catch Exception _ nil))))]]
  26.449 +	   
  26.450 +    (dorun (map #(.start %) threads))
  26.451 +    (loop []
  26.452 +      (if (!= (deref result) nil)
  26.453 +	(do (dorun (map #(.stop %) threads))
  26.454 +	    (deref result))
  26.455 +	(recur)))))
  26.456 +
  26.457 +
  26.458 +
  26.459 +
  26.460 +
  26.461 +
  26.462 +
  26.463 +(defn make-date [year month day] (do (let [date (Calendar/getInstance)] (.set date year month day 0 0) date)))
  26.464 +
  26.465 +(def jan-1-1901 (make-date 1900 0 1))
  26.466 +
  26.467 +(defn sunday? [#^java.util.Calendar date] (= 7 (.getDay (.getTime date))))
  26.468 +
  26.469 +
  26.470 +
  26.471 +
  26.472 +
  26.473 +
  26.474 +(comment
  26.475 +
  26.476 +;; ----------------------------------------------------------------------
  26.477 +;; Answers
  26.478 +;; ----------------------------------------------------------------------
  26.479 +
  26.480 +; Problem 1 
  26.481 +(+ (range-sum 0 1001 3) (range-sum 0 1001 5) (* -1 (range-sum 0 1001 15)))
  26.482 +
  26.483 +; Problem 2
  26.484 +(reduce + (for [a (filter even? (fibs)) :while (<= a 4000000 )] a))
  26.485 +
  26.486 +; Problem 3
  26.487 +(apply max (prime-factors 600851475143))
  26.488 +
  26.489 +; Problem 4
  26.490 +(reduce max (for [a (range 100 1000) b (range 100 1000) :when (palindrome? (* a b))] (* a b)))
  26.491 +
  26.492 +; Problem 5
  26.493 +(reduce lcm (range 1 21))
  26.494 +
  26.495 +; Problem 6
  26.496 +(- (expt (range-sum 101) 2) (range-sum-squares 101))
  26.497 +
  26.498 +; Problem 7
  26.499 +(nth primes 10000)
  26.500 +
  26.501 +
  26.502 +; Problem 9
  26.503 +(reduce * (first (for [a (range 1 1000) b (range 1 a) c [(sqrt (sum-squares [a b]))] 
  26.504 +      :when (= (+ a b c) 1000)] [a b c])))
  26.505 +
  26.506 +; Problem 10 
  26.507 +(reduce + (for [a primes :while (< a 2000000)] a))
  26.508 +
  26.509 +
  26.510 +
  26.511 +
  26.512 +
  26.513 +; Problem 14
  26.514 +(first (reduce (fn [a b] (if (> (count a) (count b)) a b)) [] (map collatz-seq (range 1 mil))))
  26.515 +
  26.516 +
  26.517 +; Problem 16
  26.518 +(reduce + (map #(Character/getNumericValue %) (seq (str (expt 2 1000)))))
  26.519 +
  26.520 +; Problem 17
  26.521 +(reduce + (map british-letter-count (range 1 1001)))
  26.522 +
  26.523 +
  26.524 +; Problem 24
  26.525 +(nth  (lex-permutations [ 0 1 2 3 4 5 6 7 8 9]) (- mil 1))
  26.526 +
  26.527 +; Problem 33
  26.528 +(reduce * (for [num (range 1 10) 
  26.529 +      den (range 1  10) 
  26.530 +      weird (range 1 10) 
  26.531 +      top [(+ num (* 10 weird))]
  26.532 +      bottom [(+ weird (* 10 den))]
  26.533 +      :when (and (> (/ top bottom) 1) (= (/ top bottom) (/ num den)))]
  26.534 +  (/ bottom top)))
  26.535 +
  26.536 +; Problem 35
  26.537 +(count (filter circularly-prime? (primes-under-million)))
  26.538 +
  26.539 +; Problem 40 
  26.540 +(let [fff (apply str (take 1030000 naturals))] 
  26.541 +  (reduce * (map #(Character/getNumericValue (nth fff %)) 
  26.542 +		 (map (fn [x] (expt 10 x)) (range 7)) )))
  26.543 +
  26.544 +
  26.545 +
  26.546 +
  26.547 +
  26.548 +
  26.549 +; Problem 79
  26.550 +(reduce domain-expand-contract [""] logins)
  26.551 +
  26.552 +)
  26.553 +
  26.554 +
  26.555 +
  26.556 +
  26.557 +
  26.558 +
  26.559 +
  26.560 +
  26.561 +
  26.562 +