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 )
|