cortex: org/worm_learn.clj comparison

comparison org/worm_learn.clj @ 548:0b891e0dd809

version 0.2 of thesis complete.

author	Robert McIntyre <rlm@mit.edu>
date	Thu, 01 May 2014 23:41:41 -0400
parents	01934317b25b
children

comparison

equal deleted inserted replaced

-:5d89879fc894
+:0b891e0dd809
 (use 'clojure.pprint)
 (use 'clojure.set)
 (dorun (cortex.import/mega-import-jme3))
 (rlm.rlm-commands/help)
 (load-bullet)
+(defn bin [digits]
+(fn [angles]
+(->> angles
+(flatten)
+(map (juxt #(Math/sin %) #(Math/cos %)))
+(flatten)
+(mapv #(Math/round (* % (Math/pow 10 (dec digits))))))))
 (def hand "Models/test-creature/hand.blend")
 (defn worm-model []
 (load-blender-model "Models/worm/worm.blend"))
 (vec
 (for [x (range x0 (inc x1))
 y (range y0 (inc y1))]
 [x y])))
+(def all-touch-coordinates
+(concat
+(rect-region [0  15] [7  22])
+(rect-region [8   0] [14 29])
+(rect-region [15 15] [22 22])))
 (def worm-segment-bottom (rect-region [8 15] [14 22]))
 (defn contact
 "Determine how much contact a particular worm segment has with
 other objects. Returns a value between 0 and 1, where 1 is full
 (->> activity (fft) (take 20) (map #(Math/abs %))
 (max-indexed) (first) (<= 2)))]
 (or (accept? (take 64 base-activity))
 (accept? (take 64 (drop 20 base-activity))))))))
 (def worm-segment-bottom-tip (rect-region [15 15] [22 22]))
 (def worm-segment-top-tip (rect-region [0 15] [7 22]))
 (defn grand-circle?
 head-touch (worm-touch 4)]
 (and (< 0.1 (contact worm-segment-bottom-tip tail-touch))
 (< 0.1 (contact worm-segment-top-tip    head-touch))))))
+(defn draped?
+"Is the worm:
+-- not flat (the floor is not a 'chair')
+-- supported (not using its muscles to hold its position)
+-- stable (not changing its position)
+-- touching something (must register contact)"
+[experiences]
+(let [b2-hash (bin 2)
+touch (:touch (peek experiences))
+total-contact
+(reduce
++
+(map #(contact all-touch-coordinates %)
+(rest touch)))]
+(println total-contact)
+(and (not (resting? experiences))
+(every?
+zero?
+(-> experiences
+(vector:last-n 25)
+(#(map :muscle %))
+(flatten)))
+(-> experiences
+(vector:last-n 20)
+(#(map (comp b2-hash flatten :proprioception) %))
+(set)
+(count) (= 1))
+(< 0.03 total-contact))))
 (declare phi-space phi-scan debug-experience)
 (def standard-world-view
 (Quaternion. -0.11555642, 0.88188726, -0.2854942, -0.3569518)])
 (def degenerate-worm-view
 [(Vector3f. -0.0708936, -8.570261, 2.6487997)
 (Quaternion. -2.318909E-4, 0.9985348, 0.053941682, 0.004291452)])
+(defn summon-chair
+"Create a chair in the world for the worm"
+[world]
+(let [chair (box 0.5 0.5 0.5 :position (Vector3f. 0 -5 -2)
+:mass 350. :color ColorRGBA/Pink)]
+(add-element world chair (.getRootNode world))))
 (defn worm-world-defaults []
 (let [direct-control (worm-direct-control worm-muscle-labels 40)]
 (merge direct-control
 {:view worm-side-view
 :record nil
 :experiences (atom [])
 :experience-watch debug-experience
 :worm worm
-:end-frame nil})))
+:end-frame nil
+:keybindings
+(merge (:keybindings direct-control)
+{"key-b" (fn [world pressed?]
+(if pressed? (summon-chair world)))})})))
 (defn dir! [file]
 (if-not (.exists file)
 (.mkdir file))
 file)
 (.addProcessor (.getViewPort world) pssm)))
 (defn debug-experience
 [experiences text]
 (cond
+(draped? experiences)       (.setText text "Draped")
 (grand-circle? experiences) (.setText text "Grand Circle")
 (curled? experiences)       (.setText text "Curled")
 (wiggling? experiences)     (.setText text "Wiggling")
 (resting? experiences)      (.setText text "Resting")
 :else                       (.setText text "Unknown")))
 :motor-control
 (motor-control-program worm-muscle-labels do-all-the-things)
 :experiences experiences})))
 @experiences))
-(defn bin [digits]
-(fn [angles]
-(->> angles
-(flatten)
-(map (juxt #(Math/sin %) #(Math/cos %)))
-(flatten)
-(mapv #(Math/round (* % (Math/pow 10 (dec digits))))))))
 ;; k-nearest neighbors with spatial binning. Only returns a result if
 ;; the propriceptive data is within 10% of a previously recorded
 ;; result in all dimensions.
 (defn gen-phi-scan [phi-space]
 (let [bin-keys (map bin [3 2 1])
 ;; tests
 ;;(infer-nils [1 nil 1 1]) [1 1 1 1]
 ;;(infer-nils [1 1 1 nil]) [1 1 1 0]
 ;;(infer-nils [nil 2 1 1]) [2 2 1 1]
 (defn empathy-demonstration []
 (let [proprio (atom ())]
 (fn
 [experiences text]
 (swap! proprio (partial cons phi-indices))
 (let [exp-thread (longest-thread (take 300 @proprio))
 empathy (mapv phi-space (infer-nils exp-thread))]
 (println-repl (vector:last-n exp-thread 22))
 (cond
+(draped? empathy)       (.setText text "Draped")
 (grand-circle? empathy) (.setText text "Grand Circle")
 (curled? empathy)       (.setText text "Curled")
 (wiggling? empathy)     (.setText text "Wiggling")
 (resting? empathy)      (.setText text "Resting")
 :else                   (.setText text "Unknown")))))))
 (merge
 (worm-world-defaults)
 {:experiences experiences})))
 @experiences))
 (def phi-scan (gen-phi-scan phi-space)))
+(defn empathy-experiment-0 [record]
+(.start (worm-world :record record)))
 (defn empathy-experiment-1 [record]
 (.start (worm-world :experience-watch (empathy-demonstration)
 :record record :worm worm*)))

Mercurial > cortex

comparison org/worm_learn.clj @ 548:0b891e0dd809