Mercurial > cortex

comparison org/self_organizing_touch.clj @ 411:a331d5ff73e0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
saving progress for the night. completed self-organizing touch, still working on stream predicates.
author Robert McIntyre <rlm@mit.edu>
date Tue, 18 Mar 2014 23:04:48 -0400
parents e6a7e80f885a
children cc9957241076
comparison
equal deleted inserted replaced
410:e6a7e80f885a 411:a331d5ff73e0
78 78
79 (defn remove-similar 79 (defn remove-similar
80 [coll] 80 [coll]
81 (loop [result () coll (sort-by (comp - count) coll)] 81 (loop [result () coll (sort-by (comp - count) coll)]
82 (if (empty? coll) result 82 (if (empty? coll) result
83 (let [x (first coll) 83 (let [[x & xs] coll
84 xs (rest coll)
85 c (count x)] 84 c (count x)]
86 (if (some 85 (if (some
87 (fn [other-set] 86 (fn [other-set]
88 (let [oc (count other-set)] 87 (let [oc (count other-set)]
89 (< (- (count (union other-set x)) c) (* oc 0.1)))) 88 (< (- (count (union other-set x)) c) (* oc 0.1))))
90 xs) 89 xs)
91 (recur result xs) 90 (recur result xs)
92 (recur (cons x result) xs)))))) 91 (recur (cons x result) xs))))))
93
94 (defn rect-region [[x0 y0] [x1 y1]]
95 (vec
96 (for [x (range x0 (inc x1))
97 y (range y0 (inc y1))]
98 [x y])))
99 92
100 (def all-touch-coordinates 93 (def all-touch-coordinates
101 (concat 94 (concat
102 (rect-region [0 15] [7 22]) 95 (rect-region [0 15] [7 22])
103 (rect-region [8 0] [14 29]) 96 (rect-region [8 0] [14 29])
110 (assoc m k [0.0 0.1])) 103 (assoc m k [0.0 0.1]))
111 (zipmap all-touch-coordinates (repeat [0.1 0.1])) coords) 104 (zipmap all-touch-coordinates (repeat [0.1 0.1])) coords)
112 data 105 data
113 [[(vec (keys touched-region)) (vec (vals touched-region))]] 106 [[(vec (keys touched-region)) (vec (vals touched-region))]]
114 touch-display (view-touch)] 107 touch-display (view-touch)]
115 (touch-display data) 108 (repeatedly 5 #(touch-display data)) data))
116 (touch-display data)))
117 109
118 (defn learn-touch-regions [] 110 (defn learn-touch-regions []
119 (let [experiences (atom []) 111 (let [experiences (atom [])
120 world (apply-map 112 world (apply-map
121 worm-world 113 worm-world