(ns org.aurellem.bbbgs (:require [clojure.data.json :as json])) (import org.opencv.core.Core) (import org.opencv.video.BackgroundSubtractorMOG) (import org.opencv.core.Mat) (import org.opencv.core.MatOfByte) (import org.opencv.highgui.Highgui) (import javax.imageio.ImageIO) (import org.aurellem.genesis.Bbbgs) (import org.opencv.video.BackgroundSubtractorMOG) (import org.opencv.core.Mat) (import java.io.ByteArrayInputStream) (import org.opencv.core.MatOfByte) (import org.opencv.highgui.Highgui) (import java.io.File) (import java.awt.Color) (import java.awt.image.BufferedImage) (import java.awt.color.ColorSpace) (import java.awt.image.ColorConvertOp) (use 'cortex.util) (use 'cortex.sense) (use 'org.aurellem.co57-cache) (use 'org.aurellem.video-info) (defn load-opencv [] (clojure.lang.RT/loadLibrary "opencv_java246")) (defn load-bbbgs [] (clojure.lang.RT/loadLibrary "bbbgs")) (load-bbbgs) (defn num->rgb [n] [(bit-shift-right (bit-and n 0xff0000) 16) (bit-shift-right (bit-and n 0x00ff00) 8) (bit-shift-right (bit-and n 0x0000ff) 0)]) (defn rgb->num [[r g b]] (+ (bit-shift-left (int r) 16) (bit-shift-left (int g) 8) (int b))) (defn lab->rgb [[l a b]] (vec (Bbbgs/convertLab2RGB l a b))) (defn rgb->lab [[r g b]] (vec (Bbbgs/convertRGB2Lab r g b))) (defn euclidean-distance [x y] (Math/sqrt (reduce + (map #(* % %) (map - x y))))) (def colors (map-vals (comp rgb->lab num->rgb) {:red 0xff0000 :yellow 0xffff00 :green 0x00ff00 :blue 0x0000ff :violet 0xff00ff :white 0xffffff :black 0x000000 :gray 0x888888 :teal 0x11eeec :orange 0xee8811 :pink 0xee1199 :dark-blue 0x112266 :tan 0xaa9977})) (defn color-class [color] ((comp name key first) (sort-by (comp (partial euclidean-distance color) val) colors))) (def threshold 9) (defn color-pair [[L1 A1 B1 :as lab1] [L2 A2 B2 :as lab2]] (let [name-1 (color-class lab1) name-2 (color-class lab2)] (cond (not= name-1 name-2) [name-1 name-2] ;; check to see if they are very close (< (euclidean-distance lab1 lab2) threshold) [name-1 name-2] ;; Check luminance :else (if (> L1 L2) [(str "lighter-" name-1) (str "darker-" name-2)] [(str "darker-" name-1) (str "lighter-" name-2)])))) (defn round-trip [[R G B]] (let [[L A B] (rgb->lab [R G B])] (println L A B) (lab->rgb [L A B]))) (extend-type (class []) Viewable (view [[r g b]] (let [im (BufferedImage. 40 40 BufferedImage/TYPE_INT_RGB)] (dorun (for [x (range 40) y (range 40)] (.setRGB im x y (rgb->num [(int r) (int g) (int b)])))) (view im)))) (extend-type (class 0xFFFFFF) Viewable (view [num] (view (num->rgb num)))) (defn mat->bufferedImage [mat] (let [byte-matrix (MatOfByte.)] (Highgui/imencode ".jpg" mat byte-matrix) (ImageIO/read (ByteArrayInputStream. (.toArray byte-matrix))))) (defn test-highui-loop [] (view (mat->bufferedImage (Highgui/imread "/home/r/proj/genesis/movies/capture-26/capture0000001.png")))) (extend-type org.opencv.core.Mat Viewable (view [mat] (view (mat->bufferedImage mat)))) (defn test-image [] (Highgui/imread "/home/r/proj/genesis/movies/capture-26/capture0000001.png")) (defn test-image-2 [] (Highgui/imread "/home/r/proj/genesis/movies/capture-26/capture0000002.png")) (defn reset [] (Bbbgs/bgInit 640 480)) (defn frame->mat [title frame-num] (let [input-image-name (.getCanonicalPath (nth (images title) frame-num))] (Highgui/imread input-image-name))) (defn add-bounding-boxes [title {:keys [bb-scale-width bb-scale-height]} bounding-boxes] (dorun (map (fn [bb] (if (= (:type bb) "human") (let [width (:width bb) height (:height bb) center-x (+ (:left bb) (/ width 2)) center-y (+ (:top bb) (/ height 2)) scaled-top (max 0 (- center-y (* bb-scale-height (/ height 2)))) scaled-left (max 0 (- center-x (* bb-scale-width (/ width 2))))] (Bbbgs/addBoundingBox scaled-left scaled-top (min (* bb-scale-width width) 640) (min (* bb-scale-height height) 480))))) bounding-boxes))) (defn unchunk [s] (when (seq s) (lazy-seq (cons (first s) (unchunk (next s)))))) (defn moving-window [stream past-count next-count process-fn] (map-indexed (fn [index frame] (let [past-frames (doall (take past-count (drop (max 0 (- index past-count)) (take index stream)))) next-frames (doall (take next-count (drop (inc index) stream)))] (process-fn past-count next-count past-frames next-frames frame))) stream)) (defn windowed [past future stream] (moving-window stream past future (fn [_ _ past-frames next-frames frame] [past-frames frame next-frames]))) (defn smothed-bounding-boxes [title] (let [frame-nums (range 1 (:num-frames (movie-info title))) bounding-box-stream (map (partial bounding-boxes title)frame-nums)] (moving-window bounding-box-stream 10 10 (fn [_ _ prev-boxes next-boxes boxes] (set (for [box boxes] (let [id (:id box) data (map first (filter (comp not empty?) (map #(filter (fn [b] (= (:id b) id)) %) (concat prev-boxes next-boxes)))) average (fn [vals] (/ (reduce + vals) (max 1 (count vals))))] (assoc box :height (int (average (map :height data))) :width (int (average (map :width data))) :top (int (average (map :top data))) :left (int (average (map :left data))))))))))) (alter-var-root #'smothed-bounding-boxes memoize) (defn process-video-frame "warning! -- this must be called sequentially on the same video to work properly!" [title config frame-num bbs] (println "process " frame-num) (let [input-image (frame->mat title frame-num)] (add-bounding-boxes title config bbs) (Bbbgs/processImage input-image) (let [aug-bbs (doall (sort-by :id (map #(assoc % :energy (Bbbgs/boundingBoxEnergyRatio (:left %) (:top %) (:width %) (:height %))) bbs))) high-energy-bbs (filter #(> (:energy %) (:energy-threshold config)) aug-bbs)] (add-bounding-boxes title config high-energy-bbs) (let [bounding-box-mask (Bbbgs/boundingBoxImage)] (Bbbgs/processImage input-image) (let [bb-with-colors (doall (for [bb high-energy-bbs] (let [center-row (+ (/ (:height bb) 2) (:top bb)) center-col (+ (/ (:width bb) 2) (:left bb)) ratio (/ 1 3) scaled-width (* ratio (:width bb)) scaled-height (* ratio (:height bb))] (assoc bb :top-color (seq (Bbbgs/colorSeg (- center-col (/ scaled-width 2)) (- center-row (/ scaled-height 2)) scaled-width (/ scaled-height 2) 0)) :bottom-color (seq (Bbbgs/colorSeg (- center-col scaled-width) center-row (* scaled-width 2) scaled-height 0))))))] {;:input input-image ;:foreground (Bbbgs/foregroundImage) ;:background (Bbbgs/backgroundImage) ;:bounding-box-mask bounding-box-mask :processed-bounding-boxes bb-with-colors :frame-num frame-num}))))) (defn prime-video [title config start end] (dorun (for [frame-num (reverse (range start end))] (process-video-frame title config frame-num)))) (defn bbbgs-init [title {:keys [hist thresh height width] :as config}] (load-opencv) (load-bbbgs) (Bbbgs/setHistoryDepth (int hist)) (Bbbgs/bgInit (int width) (int height)) (Bbbgs/setThreshold (float thresh))) (defn image-stream [title] (map #(frame->mat title %) (range (num-frames title)))) (alter-var-root #'image-stream memoize) (defn ids [frame] (set (map :id (:processed-bounding-boxes frame)))) (defn select-id [id frames] (map (comp first (fn [boxes] (filter (fn [box] (= (:id box) id)) boxes))) (map :processed-bounding-boxes frames))) (defn median [samples] (let [dimension (count (first samples)) total (count samples)] (for [index (range dimension)] (first (drop (int (/ total 2)) (sort (map #(nth % index) samples))))))) (defn stabilize-colors [_ _ past-frames next-frames frame] (assoc frame :processed-bounding-boxes ;; for each box we stabilize the color (map (fn [box] ;; gather all the colors for this id and calculate the mean. (let [id (:id box) boxes (filter (comp not nil?) (select-id id (concat past-frames next-frames))) top-colors (filter (comp not nil?) (map :top-color boxes)) bottom-colors (filter (comp not nil?) (map :bottom-color boxes))] ;; calculate median (let [top-color-median (median top-colors) bottom-color-median (median bottom-colors) [top-color-name bottom-color-name] (apply color-pair (map rgb->lab [top-color-median bottom-color-median]))] (assoc box :top-color top-color-median :bottom-color bottom-color-median :top-color-name top-color-name :bottom-color-name bottom-color-name)))) (:processed-bounding-boxes frame)))) (defn remove-transient-boxes [past-count next-count past-frames next-frames frame] ;; a bounding box must exist for at least a second (30 frames) for ;; it to be considered real (let [past-ids (map ids past-frames) next-ids (map ids next-frames) filtered-boxes (filter (fn [box] (let [id (:id box)] (or (and (= (count past-ids) past-count) (every? (fn [x] (x id)) past-ids)) (and (= (count next-ids) next-count) (every? (fn [x] (x id)) next-ids))))) (:processed-bounding-boxes frame))] (assoc frame :processed-bounding-boxes filtered-boxes))) (defn process-stream [title {:keys [start end prime transient-time color-time] :as config}] (bbbgs-init title config) (prime-video title config start (+ prime start)) (let [frame-nums (unchunk (range start end)) raw-stream (map (partial process-video-frame title config) frame-nums (drop start (smothed-bounding-boxes title))) transient-past-count transient-time transient-next-count transient-time color-past-count color-time color-next-count color-time] (moving-window (moving-window raw-stream transient-past-count transient-next-count remove-transient-boxes) color-past-count color-next-count stabilize-colors))) ;;(alter-var-root #'process-stream memoize) (def default-bbbgs-settings {:hist 4 :thresh 10 :bb-scale-width 1 :bb-scale-height 1 :width 640 :height 480 :start 1 :end 2000 :prime 0 :energy-threshold 0.1 :transient-time 30 :color-time 30}) (defn config [title] (merge default-bbbgs-settings (movie-info title) {:end (num-frames title) :bb-scale-width 1})) (defn draw-square [im color left top width height] (let [pix (rgb->num color)] (dorun (for [col (range left (+ left width)) row (range top (+ top height))] (.setRGB im col row pix))))) (defn display-video-frame [title config display-foreground display-background display-bb {:keys [input foreground background bounding-box-mask] :as frame}] (let [background-im (mat->bufferedImage background) foreground-im (mat->bufferedImage foreground) input-im (mat->bufferedImage input) draw-squares (fn [im] (dorun (for [box (:processed-bounding-boxes frame)] (do (if-let [top-color (:top-color box)] (draw-square im top-color (:left box) (:top box) (:width box) (/ (:height box) 2))) (if-let [bottom-color (:bottom-color box)] (draw-square im bottom-color (:left box) (+ (/ (:height box) 2) (:top box)) (:width box) (/ (:height box) 2))))))) ;col-conv ;(ColorConvertOp. ; (ColorSpace/getInstance ColorSpace/CS_GRAY) ; (ColorSpace/getInstance ColorSpace/CS_LINEAR_RGB) nil) ] ;(.filter col-conv bb-im nil) (do (draw-squares foreground-im) (draw-squares background-im) (draw-squares input-im) (display-foreground foreground-im) (display-background background-im) (display-bb input-im)) ;; destroy the matrices here or suffer an out of memory error ;; eventually (.release foreground) (.release background) (.release input) (.release bounding-box-mask) )) (defn demo-video ([title config record?] (let [bounding-box (view-image (if record? (File. record? "bounding-box")) "bounding-box") foreground (view-image (if record? (File. record? "foreground")) "foreground") background (view-image (if record? (File. record? "background")) "background")] (dorun (map (partial display-video-frame title config foreground background bounding-box) (process-stream title config))))) ([title] (demo-video title (config title) nil))) (def vid "capture-26.mp4") (def harvard "harvard-square.mp4") (def harvard-auto "harvard-square-auto.mp4") (defn test-bbbgs ([] (test-bbbgs nil)) ([base] (demo-video vid default-bbbgs-settings base ))) ;;(def output (File. "/home/r/proj/genesis/render/stable")) ;; (demo-video vid (config vid) output) (def output (File. "/home/r/proj/genesis/render/harvard-auto/")) (defn make-harvard-video! [] (demo-video harvard (assoc (config harvard) :start 1) (File. "/home/r/proj/genesis/render/harvard"))) (def result-base (File. "/home/r/proj/genesis-server/results")) (defn results-file [title] (File. result-base (str title ".result"))) (defn cache-results! [title] (spit (results-file title) (pr-str (vec (process-stream title (config title)))))) (defn results [title] (group-by :frame-num (read-string (slurp (results-file title))))) (def harvard-trace-vec (mapv (trace-by-frame "harvard-square-places.mp4") (range 1563))) (defn draw-bbs [title display-image input bounding-boxes] (let [input-im (mat->bufferedImage input) draw-squares (fn [im] (dorun (for [box bounding-boxes] (do (draw-square im (cond (= (:type box) "human") [30 70 190] (= (:type box) "object") [0 200 0] true [200 20 20]) (:left box) (:top box) (:width box) (:height box))))))] (do (draw-squares input-im) (display-image input-im) (.release input)))) (def harvard-places "harvard-square-places.mp4") (defn demo-draw-bbs [title record?] (let [display (view-image (if record? (File. "/home/r/proj/genesis/render/places")) "demo-places")] (dorun (map (partial draw-bbs title display) (image-stream title) (map (partial bounding-boxes title) (range (:end (config title)))))))) ;; (demo-draw-bbs "harvard-square-places.mp4" true) from this I can ;; see that this new "place" annotated trace mostly just has the same ;; constant pattern, repeated indefinately. It also has much worseq ;; bounding boxes around the humans than the previous video, failing ;; to identify most of the humans. So, just take the static pattern ;; and disregard the rest. ;; wow, the names are so retarded. They don't even have anything ;; useful! the whole point of this thing is to get what _particular_ ;; places the people are going to. They've chosen to just represent ;; every entrance as "door" and annotate all the trash cans and lamp ;; posts. Because we care whether someone goes by a lamp post or fire ;; hydrant, but not whether they go into the bank. ;; here's their stupid annotations. ;; (def harvard-place-locations ;; (filter (comp not #{"human" "object"} :type) ;; (nth (map (partial bounding-boxes harvard-places) ;; (range (:end (config harvard-places)))) 200))) (def harvard-place-locations "annotations with more reasonable names than Co57 defaults." [{:height 50, :width 10, :type "fire alarm", :id 225, :right 1042, :left 1032, :bottom 486, :top 436} {:height 116, :width 26, :type "crosswalk post", :id 214, :right 1082, :left 1056, :bottom 488, :top 372} {:height 178, :width 28, :type "light post", :id 212, :right 964, :left 936, :bottom 438, :top 260} {:height 88, :width 20, :type "crosswalk post", :id 205, :right 528, :left 508, :bottom 392, :top 304} {:height 52, :width 154, :type "magazine store", :id 228, :right 874, :left 720, :bottom 334, :top 282} {:height 92, :width 6, :type "traffic light post", :id 209, :right 778, :left 772, :bottom 346, :top 254} {:height 86, :width 62, :type "kiosk", :id 226, :right 954, :left 892, :bottom 362, :top 276} {:height 16, :width 8, :type "car stop", :id 223, :right 798, :left 790, :bottom 356, :top 340} {:height 24, :width 14, :type "car stop", :id 222, :right 514, :left 500, :bottom 438, :top 414} {:height 24, :width 12, :type "trash barrel", :id 217, :right 566, :left 554, :bottom 372, :top 348} {:height 128, :width 62, :type "door", :id 202, :right 80, :left 18, :bottom 514, :top 386} {:height 70, :width 10, :type "lamp post", :id 206, :right 552, :left 542, :bottom 378, :top 308} {:height 128, :width 42, :type "crosswalk post", :id 201, :right 322, :left 280, :bottom 520, :top 392} {:height 84, :width 34, :type "resturant door", :id 203, :right 142, :left 108, :bottom 480, :top 396} {:height 240, :width 40, :type "lamp post", :id 200, :right 40, :left 0, :bottom 538, :top 298} {:height 212, :width 20, :type "traffic light post", :id 213, :right 988, :left 968, :bottom 456, :top 244} {:height 132, :width 28, :type "light post", :id 211, :right 906, :left 878, :bottom 392, :top 260} {:height 194, :width 34, :type "lamp post", :id 204, :right 492, :left 458, :bottom 450, :top 256} {:height 24, :width 16, :type "trash barrel", :id 218, :right 846, :left 830, :bottom 366, :top 342} {:height 104, :width 16, :type "light post", :id 210, :right 816, :left 800, :bottom 362, :top 258} {:height 78, :width 44, :type "Citizens Bank door", :id 227, :right 1188, :left 1144, :bottom 480, :top 402} {:height 62, :width 14, :type "lamp post", :id 208, :right 674, :left 660, :bottom 318, :top 256} {:height 122, :width 20, :type "lamp post", :id 207, :right 560, :left 540, :bottom 378, :top 256} {:height 26, :width 14, :type "car stop", :id 221, :right 466, :left 452, :bottom 460, :top 434} {:height 34, :width 24, :type "trash barrel", :id 216, :right 472, :left 448, :bottom 456, :top 422} {:height 36, :width 22, :type "trash barrel", :id 224, :right 1044, :left 1022, :bottom 480, :top 444} {:height 278, :width 46, :type "lamp post", :id 215, :right 1278, :left 1232, :bottom 558, :top 280} {:height 36, :width 18, :type "fire hydrant", :id 220, :right 1214, :left 1196, :bottom 554, :top 518}])