1.1 --- a/org/worm_learn.clj	Wed Mar 19 21:46:58 2014 -0400
     1.2 +++ b/org/worm_learn.clj	Wed Mar 19 22:02:06 2014 -0400
     1.3 @@ -253,48 +253,8 @@
     1.4    (swap! experiences #(conj % data)))
     1.5  
     1.6  
     1.7 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     1.8 -;;;;;;;;   Phi-Space   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     1.9 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.10  
    1.11 -(defn generate-phi-space []
    1.12 -  (let [experiences (atom [])]
    1.13 -    (run-world
    1.14 -     (apply-map 
    1.15 -      worm-world
    1.16 -      (merge
    1.17 -       (worm-world-defaults)
    1.18 -       {:end-frame 700
    1.19 -        :motor-control
    1.20 -        (motor-control-program worm-muscle-labels do-all-the-things)
    1.21 -        :experiences experiences})))
    1.22 -    @experiences))
    1.23 -  
    1.24 -
    1.25 -(defn bin [digits]
    1.26 -  (fn [angles]
    1.27 -    (->> angles
    1.28 -         (flatten)
    1.29 -         (map (juxt #(Math/sin %) #(Math/cos %)))
    1.30 -         (flatten)
    1.31 -         (mapv #(Math/round (* % (Math/pow 10 (dec digits))))))))
    1.32 -
    1.33 -;; k-nearest neighbors with spatial binning.
    1.34 -(defn gen-phi-scan [phi-space]
    1.35 -  (let [bin-keys (reverse (map bin (range 4)))
    1.36 -        bin-maps
    1.37 -        (map (fn [bin-key phi-space]
    1.38 -               (group-by (comp bin-key :proprioception) phi-space))
    1.39 -             bin-keys (repeat phi-space))
    1.40 -        lookups (map (fn [bin-key bin-map]
    1.41 -                      (fn [proprio] (bin-map (bin-key proprio))))
    1.42 -                    bin-keys bin-maps)]
    1.43 -    (fn lookup [proprio-data]
    1.44 -      (some #(% proprio-data) lookups))))
    1.45 -
    1.46 -
    1.47 -
    1.48 -
    1.49 +(declare phi-space phi-scan)
    1.50  
    1.51  (defn worm-world
    1.52    [& {:keys [record motor-control keybindings view experiences
    1.53 @@ -339,6 +299,9 @@
    1.54                experiences {:touch touch-data
    1.55                             :proprioception proprioception-data
    1.56                             :muscle muscle-data})
    1.57 +             (if-let [res (phi-scan proprioception-data)]
    1.58 +               (println-repl "lookup successful --" (count res))
    1.59 +               (println-repl "lookup failed"))
    1.60               (cond
    1.61                (grand-circle? @experiences) (println "Grand Circle")
    1.62                (curled? @experiences)       (println "Curled")
    1.63 @@ -357,3 +320,46 @@
    1.64  
    1.65  
    1.66  
    1.67 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.68 +;;;;;;;;   Phi-Space   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.69 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.70 +
    1.71 +(defn generate-phi-space []
    1.72 +  (let [experiences (atom [])]
    1.73 +    (run-world
    1.74 +     (apply-map 
    1.75 +      worm-world
    1.76 +      (merge
    1.77 +       (worm-world-defaults)
    1.78 +       {:end-frame 700
    1.79 +        :motor-control
    1.80 +        (motor-control-program worm-muscle-labels do-all-the-things)
    1.81 +        :experiences experiences})))
    1.82 +    @experiences))
    1.83 +  
    1.84 +
    1.85 +(defn bin [digits]
    1.86 +  (fn [angles]
    1.87 +    (->> angles
    1.88 +         (flatten)
    1.89 +         (map (juxt #(Math/sin %) #(Math/cos %)))
    1.90 +         (flatten)
    1.91 +         (mapv #(Math/round (* % (Math/pow 10 (dec digits))))))))
    1.92 +
    1.93 +;; k-nearest neighbors with spatial binning.
    1.94 +(defn gen-phi-scan [phi-space]
    1.95 +  (let [bin-keys (map bin [3 2 1])
    1.96 +        bin-maps
    1.97 +        (map (fn [bin-key phi-space]
    1.98 +               (group-by (comp bin-key :proprioception) phi-space))
    1.99 +             bin-keys (repeat phi-space))
   1.100 +        lookups (map (fn [bin-key bin-map]
   1.101 +                      (fn [proprio] (bin-map (bin-key proprio))))
   1.102 +                    bin-keys bin-maps)]
   1.103 +    (fn lookup [proprio-data]
   1.104 +      (some #(% proprio-data) lookups))))
   1.105 +
   1.106 +(defn init []
   1.107 +  (def phi-space (generate-phi-space))
   1.108 +  (def phi-scan (gen-phi-scan phi-space))
   1.109 +  )