changeset 411:a331d5ff73e0

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
files org/self_organizing_touch.clj org/worm_learn.clj
diffstat 2 files changed, 22 insertions(+), 31 deletions(-) [+]
line wrap: on
line diff
     1.1 --- a/org/self_organizing_touch.clj	Tue Mar 18 22:29:03 2014 -0400
     1.2 +++ b/org/self_organizing_touch.clj	Tue Mar 18 23:04:48 2014 -0400
     1.3 @@ -80,8 +80,7 @@
     1.4    [coll]
     1.5    (loop [result () coll (sort-by (comp - count) coll)]
     1.6      (if (empty? coll) result
     1.7 -        (let  [x  (first coll)
     1.8 -               xs (rest coll)
     1.9 +        (let  [[x & xs] coll
    1.10                 c (count x)]
    1.11            (if (some
    1.12                 (fn [other-set]
    1.13 @@ -91,12 +90,6 @@
    1.14              (recur result xs)
    1.15              (recur (cons x result) xs))))))
    1.16  
    1.17 -(defn rect-region [[x0 y0] [x1 y1]]
    1.18 -  (vec
    1.19 -   (for [x (range x0 (inc x1))
    1.20 -         y (range y0 (inc y1))]
    1.21 -     [x y])))
    1.22 -
    1.23  (def all-touch-coordinates
    1.24    (concat
    1.25     (rect-region [0  15] [7  22])
    1.26 @@ -112,8 +105,7 @@
    1.27          data
    1.28          [[(vec (keys touched-region)) (vec (vals touched-region))]]
    1.29          touch-display (view-touch)]
    1.30 -    (touch-display data)
    1.31 -    (touch-display data)))
    1.32 +    (repeatedly 5 #(touch-display data)) data))
    1.33  
    1.34  (defn learn-touch-regions []
    1.35    (let [experiences (atom [])
     2.1 --- a/org/worm_learn.clj	Tue Mar 18 22:29:03 2014 -0400
     2.2 +++ b/org/worm_learn.clj	Tue Mar 18 23:04:48 2014 -0400
     2.3 @@ -144,28 +144,27 @@
     2.4  (defn touch-average [[coords touch]]
     2.5    (/ (average (map first touch)) (average (map second touch))))
     2.6  
     2.7 -(def worm-segment-touch-bottom
     2.8 -  [[8 15] [8 16] [8 17] [8 18] [8 19] [8 20] [8 21] [8 22] [9 15]
     2.9 -   [9 16] [9 17] [9 18] [9 19] [9 20] [9 21] [9 22] [10 15] [10 16]
    2.10 -   [10 17] [10 18] [10 19] [10 20] [10 21] [10 22] [11 15] [11 16]
    2.11 -   [11 17] [11 18] [11 19] [11 20] [11 21] [11 22] [12 15] [12 16]
    2.12 -   [12 17] [12 18] [12 19] [12 20] [12 21] [12 22] [13 15] [13 16]
    2.13 -   [13 17] [13 18] [13 19] [13 20] [13 21] [13 22] [14 15] [14 16]
    2.14 -   [14 17] [14 18] [14 19] [14 20] [14 21] [14 22]])
    2.15 +(defn rect-region [[x0 y0] [x1 y1]]
    2.16 +  (vec
    2.17 +   (for [x (range x0 (inc x1))
    2.18 +         y (range y0 (inc y1))]
    2.19 +     [x y])))
    2.20  
    2.21 +(def worm-segment-touch-bottom (rect-region [8 15] [14 22]))
    2.22  
    2.23 -
    2.24 -(defn floor-contact [[coords contact :as touch]]
    2.25 -  (let [raw-average
    2.26 -        (average
    2.27 -         (map
    2.28 -          first
    2.29 -          (vals
    2.30 -           (select-keys
    2.31 -            (zipmap coords contact)
    2.32 -            ))))]
    2.33 -    (Math/abs (- 1. (* 10 raw-average)))))
    2.34 -
    2.35 +(defn contact
    2.36 +  "Determine how much contact a particular worm segment has with
    2.37 +   other objects. Returns a value between 0 and 1, where 1 is full
    2.38 +   contact and 0 is no contact."
    2.39 +  [[coords contact :as touch]]
    2.40 +  (-> (zipmap coords contact)
    2.41 +      (select-keys worm-segment-touch-bottom)
    2.42 +      (vals)
    2.43 +      (#(map first %))
    2.44 +      (average)
    2.45 +      (* 10)
    2.46 +      (- 1)
    2.47 +      (Math/abs)))
    2.48  
    2.49  (defn wiggling?
    2.50    "Is the worm wiggling?"
    2.51 @@ -251,7 +250,7 @@
    2.52               ;;(if (straight? @experiences)    (println "Straight"))
    2.53               ;; (println-repl
    2.54               ;;  (apply format "%.2f %.2f %.2f %.2f %.2f\n"
    2.55 -             ;;         (map floor-contact touch-data)))
    2.56 +             ;;         (map contact touch-data)))
    2.57               
    2.58               )
    2.59             (muscle-display