Mercurial > lasercutter

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

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