annotate src/clojureDemo/appeture.clj @ 21:e72220627685 tip

0.002 inch discrepancy with target. going to test anyway
author Robert McIntyre <rlm@mit.edu>
date Mon, 30 Aug 2010 01:19:21 -0400
parents 6d9bdaf919f7
children
rev   line source
rlm@1 1 (ns clojureDemo.appeture)
rlm@1 2
rlm@1 3 (use 'clojure.contrib.repl-utils)
rlm@1 4 (use 'clojure.contrib.accumulators)
rlm@1 5
rlm@1 6 "right now this only will work on odd square arrays"
rlm@1 7
rlm@1 8 (def rrr {[0 0] 20 , [1 0] 20, [2 0] 20
rlm@1 9 [0 1] 0 , [1 1] 0, [2 1] 0
rlm@1 10 [0 2] 0 , [1 2] 0, [2 2] 0})
rlm@1 11
rlm@1 12 (def rrrr {[0 0] 20 , [1 0] 20, [2 0] 20 , [3 0] 20, [4 0] 20,
rlm@1 13 [0 1] 20 , [1 1] 20, [2 1] 20 , [3 1] 20, [4 1] 20,
rlm@1 14 [0 2] 0 , [1 2] 0, [2 2] 0 , [3 2] 0, [4 2] 0,
rlm@1 15 [0 3] 0 , [1 3] 0, [2 3] 0 , [3 3] 0, [4 3] 0,
rlm@1 16 [0 4] 0 , [1 4] 0, [2 4] 0 , [3 4] 0, [4 4] 0,})
rlm@1 17
rlm@1 18 (defn vector-mul
rlm@1 19 [mul vect]
rlm@1 20 (apply vector (map #(* mul %) vect)) )
rlm@1 21
rlm@1 22 (defn vector-sum
rlm@1 23 ([] 0)
rlm@1 24 ([& args]
rlm@1 25 (apply vector (reduce #(map + %1 %2) args))))
rlm@1 26
rlm@1 27 (defn vector-sub
rlm@1 28 [vector1 vector2]
rlm@1 29 (vector-sum vector1 (vector-mul -1 vector2)))
rlm@1 30
rlm@1 31 (defn vector-dot
rlm@1 32 [vector1 vector2]
rlm@1 33 (reduce + (map * vector1 vector2)))
rlm@1 34
rlm@1 35 (defn center
rlm@1 36 [window]
rlm@1 37 (let [coords (keys window)]
rlm@1 38 (vector-mul (/ 1 (count coords)) (apply vector-sum coords))))
rlm@1 39
rlm@1 40 (defn window-segmentate
rlm@1 41 [window line]
rlm@1 42 (let [center (center window)]
rlm@1 43 (letfn [(path [window] (filter (fn [point] (apply = (line center point))) (keys window)))
rlm@1 44 (top [window] (filter (fn [point] (apply > (line center point))) (keys window)))
rlm@1 45 (bottom [window] (filter (fn [point] (apply < (line center point))) (keys window)))]
rlm@1 46 {:top (top window) :bottom (bottom window) :line (path window)})))
rlm@1 47
rlm@1 48 (defn diag1
rlm@1 49 [window]
rlm@1 50 (window-segmentate window (fn [center point] (list (first (vector-sub point center)) (-(last (vector-sub point center)))))))
rlm@1 51
rlm@1 52 (defn diag2
rlm@1 53 [window]
rlm@1 54 (window-segmentate window (fn [center point] (list (first (vector-sub point center)) (last (vector-sub point center))))))
rlm@1 55
rlm@1 56 (defn vert
rlm@1 57 [window]
rlm@1 58 (window-segmentate window (fn [center point] (list (first (vector-sub point center)) 0))))
rlm@1 59
rlm@1 60 (defn horiz
rlm@1 61 [window]
rlm@1 62 (window-segmentate window (fn [center point] (list 0 (last (vector-sub point center))))))
rlm@1 63
rlm@1 64
rlm@1 65
rlm@1 66
rlm@1 67
rlm@1 68
rlm@1 69 (defn lines
rlm@1 70 [window]
rlm@1 71 (let [lines (list (vert window) (horiz window) (diag1 window) (diag2 window))]
rlm@1 72 lines))
rlm@1 73 ;This is the wrong model. Higher level processors should set these paramaters, and
rlm@1 74 ; juggle them around if they aren't getting anything they understand.
rlm@1 75
rlm@1 76
rlm@1 77
rlm@1 78 (defn stats-base
rlm@1 79 [sections window sel-fun]
rlm@1 80 (let [stats-top (add-items empty-mean-variance (map window (:top sections)))
rlm@1 81 stats-bottom (add-items empty-mean-variance (map window (:bottom sections)))]
rlm@1 82 (let [ var1 (:variance stats-top) mean1 (:mean stats-top) var2 (:variance stats-bottom) mean2 (:mean stats-bottom)]
rlm@1 83 (sel-fun var1 mean1 var2 mean2))))
rlm@1 84
rlm@1 85 (defn window-line
rlm@1 86 [window transformation detection]
rlm@1 87 (let [x-window (transformation window)]
rlm@1 88 (first (filter #(stats-base % x-window detection) (lines x-window)))))
rlm@1 89
rlm@1 90 (defn window-stats
rlm@1 91 ([window] (window-stats window identity))
rlm@1 92 ([window transformation]
rlm@1 93 (let [x-window (transformation window)]
rlm@1 94 (map (fn [line] (stats-base line x-window #(list %1 %2 %3 %4))) (lines x-window)))))
rlm@1 95
rlm@1 96
rlm@1 97
rlm@1 98
rlm@1 99 (comment
rlm@1 100
rlm@1 101 (do (use :reload-all 'clojureDemo.appeture) (in-ns 'clojureDemo.appeture))
rlm@1 102
rlm@1 103 )