Mercurial > cortex
diff 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 |
line wrap: on
line diff
1.1 --- a/org/worm_learn.clj Mon Apr 28 15:10:59 2014 -0400 1.2 +++ b/org/worm_learn.clj Thu May 01 23:41:41 2014 -0400 1.3 @@ -20,8 +20,18 @@ 1.4 (dorun (cortex.import/mega-import-jme3)) 1.5 (rlm.rlm-commands/help) 1.6 1.7 + 1.8 (load-bullet) 1.9 1.10 +(defn bin [digits] 1.11 + (fn [angles] 1.12 + (->> angles 1.13 + (flatten) 1.14 + (map (juxt #(Math/sin %) #(Math/cos %))) 1.15 + (flatten) 1.16 + (mapv #(Math/round (* % (Math/pow 10 (dec digits)))))))) 1.17 + 1.18 + 1.19 (def hand "Models/test-creature/hand.blend") 1.20 1.21 (defn worm-model [] 1.22 @@ -162,6 +172,12 @@ 1.23 y (range y0 (inc y1))] 1.24 [x y]))) 1.25 1.26 +(def all-touch-coordinates 1.27 + (concat 1.28 + (rect-region [0 15] [7 22]) 1.29 + (rect-region [8 0] [14 29]) 1.30 + (rect-region [15 15] [22 22]))) 1.31 + 1.32 (def worm-segment-bottom (rect-region [8 15] [14 22])) 1.33 1.34 (defn contact 1.35 @@ -221,8 +237,6 @@ 1.36 (or (accept? (take 64 base-activity)) 1.37 (accept? (take 64 (drop 20 base-activity)))))))) 1.38 1.39 - 1.40 - 1.41 (def worm-segment-bottom-tip (rect-region [15 15] [22 22])) 1.42 1.43 (def worm-segment-top-tip (rect-region [0 15] [7 22])) 1.44 @@ -238,6 +252,36 @@ 1.45 (< 0.1 (contact worm-segment-top-tip head-touch)))))) 1.46 1.47 1.48 +(defn draped? 1.49 + "Is the worm: 1.50 + -- not flat (the floor is not a 'chair') 1.51 + -- supported (not using its muscles to hold its position) 1.52 + -- stable (not changing its position) 1.53 + -- touching something (must register contact)" 1.54 + [experiences] 1.55 + (let [b2-hash (bin 2) 1.56 + touch (:touch (peek experiences)) 1.57 + total-contact 1.58 + (reduce 1.59 + + 1.60 + (map #(contact all-touch-coordinates %) 1.61 + (rest touch)))] 1.62 + (println total-contact) 1.63 + (and (not (resting? experiences)) 1.64 + (every? 1.65 + zero? 1.66 + (-> experiences 1.67 + (vector:last-n 25) 1.68 + (#(map :muscle %)) 1.69 + (flatten))) 1.70 + (-> experiences 1.71 + (vector:last-n 20) 1.72 + (#(map (comp b2-hash flatten :proprioception) %)) 1.73 + (set) 1.74 + (count) (= 1)) 1.75 + (< 0.03 total-contact)))) 1.76 + 1.77 + 1.78 (declare phi-space phi-scan debug-experience) 1.79 1.80 1.81 @@ -254,6 +298,13 @@ 1.82 [(Vector3f. -0.0708936, -8.570261, 2.6487997) 1.83 (Quaternion. -2.318909E-4, 0.9985348, 0.053941682, 0.004291452)]) 1.84 1.85 +(defn summon-chair 1.86 + "Create a chair in the world for the worm" 1.87 + [world] 1.88 + (let [chair (box 0.5 0.5 0.5 :position (Vector3f. 0 -5 -2) 1.89 + :mass 350. :color ColorRGBA/Pink)] 1.90 + (add-element world chair (.getRootNode world)))) 1.91 + 1.92 (defn worm-world-defaults [] 1.93 (let [direct-control (worm-direct-control worm-muscle-labels 40)] 1.94 (merge direct-control 1.95 @@ -262,7 +313,11 @@ 1.96 :experiences (atom []) 1.97 :experience-watch debug-experience 1.98 :worm worm 1.99 - :end-frame nil}))) 1.100 + :end-frame nil 1.101 + :keybindings 1.102 + (merge (:keybindings direct-control) 1.103 + {"key-b" (fn [world pressed?] 1.104 + (if pressed? (summon-chair world)))})}))) 1.105 1.106 (defn dir! [file] 1.107 (if-not (.exists file) 1.108 @@ -291,6 +346,7 @@ 1.109 (defn debug-experience 1.110 [experiences text] 1.111 (cond 1.112 + (draped? experiences) (.setText text "Draped") 1.113 (grand-circle? experiences) (.setText text "Grand Circle") 1.114 (curled? experiences) (.setText text "Curled") 1.115 (wiggling? experiences) (.setText text "Wiggling") 1.116 @@ -390,14 +446,6 @@ 1.117 :experiences experiences}))) 1.118 @experiences)) 1.119 1.120 -(defn bin [digits] 1.121 - (fn [angles] 1.122 - (->> angles 1.123 - (flatten) 1.124 - (map (juxt #(Math/sin %) #(Math/cos %))) 1.125 - (flatten) 1.126 - (mapv #(Math/round (* % (Math/pow 10 (dec digits)))))))) 1.127 - 1.128 ;; k-nearest neighbors with spatial binning. Only returns a result if 1.129 ;; the propriceptive data is within 10% of a previously recorded 1.130 ;; result in all dimensions. 1.131 @@ -467,7 +515,7 @@ 1.132 ;;(infer-nils [1 nil 1 1]) [1 1 1 1] 1.133 ;;(infer-nils [1 1 1 nil]) [1 1 1 0] 1.134 ;;(infer-nils [nil 2 1 1]) [2 2 1 1] 1.135 - 1.136 + 1.137 1.138 (defn empathy-demonstration [] 1.139 (let [proprio (atom ())] 1.140 @@ -479,6 +527,7 @@ 1.141 empathy (mapv phi-space (infer-nils exp-thread))] 1.142 (println-repl (vector:last-n exp-thread 22)) 1.143 (cond 1.144 + (draped? empathy) (.setText text "Draped") 1.145 (grand-circle? empathy) (.setText text "Grand Circle") 1.146 (curled? empathy) (.setText text "Curled") 1.147 (wiggling? empathy) (.setText text "Wiggling") 1.148 @@ -497,6 +546,11 @@ 1.149 @experiences)) 1.150 (def phi-scan (gen-phi-scan phi-space))) 1.151 1.152 +(defn empathy-experiment-0 [record] 1.153 + (.start (worm-world :record record))) 1.154 + 1.155 + 1.156 + 1.157 (defn empathy-experiment-1 [record] 1.158 (.start (worm-world :experience-watch (empathy-demonstration) 1.159 :record record :worm worm*)))