Merge branch 'gnarly-refactoring'

This commit is contained in:
Richard Harrington 2013-08-03 16:09:09 -04:00
commit e3c96eaa25
7 changed files with 348 additions and 248 deletions

82
src/robotwar/brain.clj Normal file
View File

@ -0,0 +1,82 @@
(ns robotwar.brain
(:use [clojure.string :only [join]]
[clojure.pprint :only [pprint]]
[robotwar.kernel-lexicon]))
(def op-map (into {} (for [op robotwar.kernel-lexicon/op-commands]
[op (case op
"/" #(int (Math/round (float (/ %1 %2))))
"#" not=
(-> op read-string eval))])))
(defn read-register
"a function to query the robot housing this brain, for information
from the registers. takes a reg-name, a robot and a world,
and returns the running of the register's read function on the world."
[{read :read} world]
(read world))
(defn write-register
"a function to create a new world when the brain pushes data to a register.
takes a reg-name, a robot, a world, and data,
and returns the running of the register's write function on the data and the world."
[{write :write} world data]
(write world data))
(defn init-brain
"initialize the brain, meaning all the internal state variables that go along
with the robot program when it's running, except for the registers,
which are queried from the world (or the robot -- haven't decided yet)."
[program]
{:acc 0
:instr-ptr 0
:call-stack []
:program program})
(defn resolve-arg [{arg-val :val arg-type :type} registers labels world]
"resolves an instruction argument to a numeric value
(either an arithmetic or logical comparison operand, or an instruction pointer)."
(case arg-type
:label (labels arg-val)
:number arg-val
:register (read-register (registers arg-val) world)
nil))
(defn step-brain
"takes a `world` and a pathway to a brain in that world, called `brain-path`.
Only the brain (the internal state of the robot)
will be different when we pass it back, for all of the operations
except 'TO', which may also alter the external state of the robot, or the wider world.
(returns the current state of the world untouched if the instruction pointer
has gone beyond the end of the program. TODO: maybe have an error for that."
[robot world]
(let [{:keys [registers brain]} robot
{:keys [program acc instr-ptr call-stack]} brain
{:keys [instrs labels]} program]
;(println acc instr-ptr call-stack instrs labels program brain robot)
(if (>= instr-ptr (count instrs))
world
(let [[{command :val} arg] ((:instrs program) instr-ptr)
resolve #(resolve-arg % registers labels world)
assoc-world-brain #(assoc-in world [:robots (:idx robot) :brain] (into brain %))]
(case command
"GOTO" (assoc-world-brain {:instr-ptr (resolve arg)})
"GOSUB" (assoc-world-brain {:instr-ptr (resolve arg)
:call-stack (conj call-stack (inc instr-ptr))})
"ENDSUB" (assoc-world-brain {:instr-ptr (peek call-stack)
:call-stack (pop call-stack)})
("IF", ",") (assoc-world-brain {:instr-ptr (inc instr-ptr)
:acc (resolve arg)})
("+" "-" "*" "/") (assoc-world-brain {:instr-ptr (inc instr-ptr)
:acc ((op-map command) acc (resolve arg))})
("=" ">" "<" "#") (if ((op-map command) acc (resolve arg))
(assoc-world-brain {:instr-ptr (inc instr-ptr)})
(assoc-world-brain {:instr-ptr (+ instr-ptr 2)}))
"TO" (write-register
(registers (:val arg))
(assoc-world-brain {:instr-ptr (inc instr-ptr)})
acc))))))

View File

@ -1,35 +1,29 @@
(ns robotwar.core (ns robotwar.core
(:use [clojure.pprint] (:use [clojure.pprint]
(robotwar foundry robot world game-lexicon))) (robotwar foundry brain robot world game-lexicon brain-test)))
(def src-code1 " START ; this is a hacky place for messing with stuff. currently imports
0 TO A ; all the test data from brain-test, and the function below uses
TEST ; some of those variables to
IF A > 2 GOTO START ; pretty-print a robot-state with line numbers for the program instructions,
GOSUB INCREMENT
GOTO TEST
100 TO A
INCREMENT
A + 1 TO A
ENDSUB
200 TO A ")
(def src-code2 "WAIT GOTO WAIT")
(def src-code3 "500 TO RANDOM RANDOM RANDOM RANDOM")
(def world (init-world 30 30 (map #(assemble reg-names %) [src-code1 src-code2 src-code3])))
(def step (fn [initial-state n]
(nth (iterate tick-robot initial-state) n)))
; pretty-prints a robot-state with line numbers,
; and only the registers you want. Very convenient. ; and only the registers you want. Very convenient.
;
; it takes a world-tick number and a robot index number, and prettyprints a robot
; with line numbers for the program instructions, and only the registers specified.
; (also it only prints the values of the registers, not the register-maps with
; their ugly full system-names of the read and write functions.) Very convenient.
(def ppt (fn [program n & reg-keys] (def get-robot (fn [world-tick-idx robot-idx]
(let [state (step (init-robot-state program {}) n)] ((:robots (get-world world-tick-idx robot-idx)) robot-idx)))
(pprint (into (assoc-in
state
[:program :instrs]
(zipmap (range) (get-in state [:program :instrs])))
{:registers (select-keys (:registers state) reg-keys)})))))
(def ppt (fn [world-tick-idx robot-idx & [reg-keys]]
(let [{:keys [brain registers] :as robot} (get-robot world-tick-idx robot-idx)]
(pprint
(into robot
{:brain (assoc-in
brain
[:program :instrs]
(sort (zipmap (range) (get-in brain [:program :instrs]))))
:registers (sort (into {} (for [[reg-name reg-map]
(select-keys registers reg-keys)]
{reg-name (:val reg-map)})))})))))

View File

@ -1,82 +1,79 @@
(ns robotwar.robot (ns robotwar.robot
(:use [clojure.string :only [join]] (:use [clojure.string :only [join]]
(robotwar kernel-lexicon game-lexicon))) (robotwar brain game-lexicon)))
; TODO: remove the game-lexicon dependency above, when it's no longer needed ; TODO: Fill out this module.
; (i.e. when we've moved the resolve-register logic out of this module) ; Probably it will consist mostly of
; 0) An init function, to initialize all the fields containing
(def op-map (zipmap op-commands ; the external robot information. I think this should be
(map (fn [op] ; SEPARATE FROM THE REGISTERS, even the ones that are similar.
(case op ; 1) Specialty read and write functions for the registers
"/" #(int (Math/round (float (/ %1 %2)))) ; 2) Code to deal with the flag when the robot fires a shot (probably this
"#" not= ; will just involve passing the flag up to the world)
(-> op read-string eval))) ; 3) Something else I can't remember. Maybe put some of the init-register
op-commands))) ; and default-register and register-handling-in-general code in this
; module, instead of in brain. Something to think about.
(defn resolve-register [registers reg] ; 4) GENERAL NOTES: A) CHANGE STRINGS TO KEYWORDS EARLY ON.
(case reg ; B) CHANGE SOME OF THESE MODULE LOADINGS FROM
"RANDOM" (rand-int (registers reg)) ; "USE" TO "REFER", SO THAT THEY HAVE TO USE
"DATA" (registers (reg-names (registers "INDEX"))) ; FULLY-QUALIFIED NAMES. THAT MIGHT MAKE THINGS
(registers reg))) ; A BIT CLEARER. THE NAMES CAN BE SHORTENED QUITE A BIT,
; WHEN LOADED INTO THE MODULES.
(defn resolve-arg [{arg-val :val arg-type :type} registers labels] ;
"resolves an instruction argument to a numeric value ;(defn make-default-read [register]
(either an arithmetic or logical comparison operand, or an instruction pointer)." ; "takes a register and returns the default version of its :read function,
(case arg-type ; which ignores the `world` parameter and just returns
:label (labels arg-val) ; the :val field from the register."
:number arg-val ; (fn [_]
:register (resolve-register registers arg-val) ; (:val register)))
nil)) ;
;(defn make-default-write [robot-idx reg-name]
(def registers-with-effect-on-world #{"SHOT" "RADAR" "SPEEDX" "SPEEDY"}) ; "takes a robot-idx and a reg-name to locate a register, and
; returns the default version of that register's :write function,
(defn tick-robot ; which takes a world parameter and a data value and returns the
"takes as input a data structure representing all that the robot's brain ; world with the data value assoc'd into it."
needs to know about the world: ; (fn [world data]
; (assoc-in world [:robots robot-idx :registers reg-name :val] data)))
1) The robot program, consisting of a vector of two-part instructions ;
(a command, followed by an argument or nil) as well as a map of labels to ;(def default-data 0)
instruction numbers ;
2) The instruction pointer (an index number for the instruction vector) ;(defn default-register [robot-idx reg-name]
3) The value of the accumulator, or nil ; (init-register
4) The call stack (a vector of instruction pointers to lines following ; reg-name))
GOSUB calls) ;
5) The contents of all the registers ;
;(defn init-robot
After executing one instruction, tick-robot returns the updated verion of all of the above, ; [program x y]
plus an optional :action field, to notify the world if the SHOT, SPEEDX, SPEEDY or RADAR ; {:pos-x x
registers have been pushed to." ; :pos-y y
; :veloc-x 0
[{:keys [acc instr-ptr call-stack registers program] :as state}] ; :veloc-y 0
(let [[{command :val} {unresolved-arg-val :val :as arg}] ((program :instrs) instr-ptr) ; :accel-x 0
resolve #(resolve-arg % registers (program :labels))] ; :accel-y 0
(case command ; :damage 100})
"GOTO" (into state {:instr-ptr (resolve arg)}) ;
"GOSUB" (into state {:instr-ptr (resolve arg) ;(defn init-world
:call-stack (conj call-stack (inc instr-ptr))}) ; "initialize all the variables for a robot world"
"ENDSUB" (into state {:instr-ptr (peek call-stack) ; [width height programs]
:call-stack (pop call-stack)}) ; {:width width
("IF", ",") (into state {:instr-ptr (inc instr-ptr) ; :height height
:acc (resolve arg)}) ; :shells []
("+" "-" "*" "/") (into state {:instr-ptr (inc instr-ptr) ; :robots (vec (map-indexed (fn [idx program]
:acc ((op-map command) acc (resolve arg))}) ; {:brain (init-brain
("=" ">" "<" "#") (if ((op-map command) acc (resolve arg)) ; program
(into state {:instr-ptr (inc instr-ptr)}) ; reg-names
(into state {:instr-ptr (+ instr-ptr 2)})) ; {(init-register "X"
"TO" (let [return-state (into state {:instr-ptr (inc instr-ptr) ; default-read
:registers (into registers {unresolved-arg-val acc})})] ; default-write
(if (registers-with-effect-on-world unresolved-arg-val) ; (rand-int width))
(conj return-state {:action unresolved-arg-val}) ; (init-register "Y"
return-state))))) ; default-read
; default-write
(defn init-robot-state ; (rand-int height))})
"initialize all the state variables that go along ; :icon (str idx)})
with the robot program when it's running. ; programs))})
(Optionally, pass in a hash-map of register names and values)." ;
[program reg-names & [registers]] ;(defn tick-robot
{:program program ; [robot world]
:acc 0 ; (let [ticked (tick-brain robot world)]
:instr-ptr 0 ; ))
:registers (into (zipmap reg-names (repeat 0))
registers)
:call-stack []})

View File

@ -1,40 +1,47 @@
(ns robotwar.world (ns robotwar.world
(:use [clojure.string :only [join]] (:use [clojure.string :only [join]]
(robotwar foundry robot))) (robotwar foundry brain robot game-lexicon)))
;
(defn init-world ;(defn init-world
"initialize all the variables for a robot world" ; "initialize all the variables for a robot world"
[width height programs] ; [width height programs]
{:width width ; {:width width
:height height ; :height height
:shells [] ; :shells []
:robots (map-indexed (fn [idx program] ; :robots (vec (map-indexed (fn [idx program]
{:internal-state (init-robot-state program ; {:brain (init-brain
{"X" (rand-int width) ; program
"Y" (rand-int height)}) ; reg-names
:external-state {:icon (str idx)}}) ; {(init-register "X"
programs)}) ; default-read
; default-write
(defn tick-world ; (rand-int width))
"TODO" ; (init-register "Y"
[world-state]) ; default-read
; default-write
(defn arena-text-grid ; (rand-int height))})
"outputs the arena, with borders" ; :icon (str idx)})
[{:keys [width height robots]}] ; programs))})
(let [horiz-border-char "-" ;
vert-border-char "+" ;(defn tick-world
header-footer (apply str (repeat (+ width 2) horiz-border-char)) ; "TODO"
field (for [y (range height), x (range width)] ; [world-state])
(some (fn [{{{robot-x "X" robot-y "Y"} :registers} :internal-state ;
{icon :icon} :external-state}] ;(defn arena-text-grid
(if (= [x y] [robot-x robot-y]) ; "outputs the arena, with borders"
icon ; [{:keys [width height robots]}]
" ")) ; (let [horiz-border-char "-"
robots))] ; vert-border-char "+"
(str header-footer ; header-footer (apply str (repeat (+ width 2) horiz-border-char))
"\n" ; field (for [y (range height), x (range width)]
(join "\n" (map #(join (apply str %) (repeat 2 vert-border-char)) ; (some (fn [{{{robot-x "X" robot-y "Y"} :registers} :internal-state, icon :icon}]
(partition width field))) ; (if (= [x y] [robot-x robot-y])
"\n" ; icon
header-footer))) ; " "))
; robots))]
; (str header-footer
; "\n"
; (join "\n" (map #(join (apply str %) (repeat 2 vert-border-char))
; (partition width field)))
; "\n"
; header-footer)))

View File

@ -0,0 +1,106 @@
(ns robotwar.brain-test
(:use [clojure.test]
[robotwar.brain])
(:require (robotwar foundry game-lexicon)))
(def src-codes [ ; program 0: multi-use program
" START
0 TO A
TEST
IF A > 2 GOTO START
GOSUB INCREMENT
GOTO TEST
100 TO A
INCREMENT
A + 1 TO A
ENDSUB
200 TO A "
; program 1: to test RANDOM register
" 1000 TO RANDOM
RANDOM RANDOM RANDOM RANDOM RANDOM
RANDOM RANDOM RANDOM RANDOM RANDOM "
; program 2: to test INDEX/DATA pair of registers
" 300 TO A
1 TO INDEX
DATA " ])
(def len (count src-codes))
(def idx-range (range len))
(def robot-register-maps
(for [idx idx-range]
(into {} (for [reg-name robotwar.game-lexicon/reg-names]
(let [path-to-val [:robots idx :registers reg-name :val]]
{reg-name {:read (fn [world]
(get-in world path-to-val))
:write (fn [world data]
(assoc-in world path-to-val data))
:val 0}})))))
(def brains (map (comp init-brain (partial robotwar.foundry/assemble robotwar.game-lexicon/reg-names))
src-codes))
(def robots (vec (map (fn [idx brain robot-registers]
{:idx idx
:brain brain
:registers robot-registers})
idx-range
brains
robot-register-maps)))
(def initial-world {:robots robots})
(def worlds (map first (iterate (fn [[{robots :robots :as world} idx]]
[(step-brain (robots idx) world) (mod (inc idx) len)])
[initial-world 0])))
(def get-world (fn [world-tick-idx robot-idx]
(let [world-idx (+ (* world-tick-idx len) robot-idx)]
(nth worlds world-idx))))
(deftest branching-test
(testing "comparison statement should cause jump in instr-ptr"
(is (= (get-in (get-world 4 0) [:robots 0 :brain :instr-ptr])
5))))
(deftest arithmetic-test
(testing "addition"
(is (= (get-in (get-world 7 0) [:robots 0 :brain :acc])
1))))
(deftest gosub-test
(testing "gosub should move instr-ptr and add the return-ptr to the call stack"
(is (let [{:keys [instr-ptr call-stack]} (get-in (get-world 5 0) [:robots 0 :brain])]
(= [instr-ptr call-stack]
[9 [6]])))))
(deftest endsub-test
(testing "endsub pops instr-ptr off call stack and goes there"
(is (let [{:keys [instr-ptr call-stack]} (get-in (get-world 9 0) [:robots 0 :brain])]
(= [instr-ptr call-stack]
[6 []])))))
(deftest push-test
(testing "pushing number to register"
(is (= (get-in (get-world 8 0) [:robots 0 :registers "A" :val])
1))))
;(deftest random-test
; (testing "push to random register and pull from it to receive a number
; of unequal numbers less than the number that was pushed"
; (is (let [random-pairs (map (fn [n]
; (let [{{random "RANDOM"} :registers, acc :acc}
; (nth random-check-history n)]
; [random acc]))
; (range 3 13))]
; (and (every? #{1000} (map first random-pairs))
; (every? #(< -1 % 1000) (map second random-pairs))
; (apply not= (map second random-pairs)))))))
;
;(deftest index-data-pair-test
; (testing "registers whose index numbers are pushed to INDEX can
; be referenced by accessing DATA"
; (is (= (get-in (nth index-data-check-history 5) [:registers "A"])
; 300))))

View File

@ -1,8 +1,8 @@
(ns robotwar.foundry-test (ns robotwar.foundry-test
(:require [clojure.test :refer :all] (:use (clojure [string :only [join]]
[robotwar.foundry :refer :all] [test])
[robotwar.game-lexicon :refer :all]) [robotwar.foundry])
(:use [clojure.string :only [join]])) (:require [robotwar.game-lexicon]))
(def line1 "IF DAMAGE # D GOTO MOVE ; comment or something") (def line1 "IF DAMAGE # D GOTO MOVE ; comment or something")
(def line2 "AIM-17 TO AIM ; other comment") (def line2 "AIM-17 TO AIM ; other comment")
@ -212,47 +212,47 @@
(deftest parse-token-register (deftest parse-token-register
(testing "parsing register token" (testing "parsing register token"
(is (= (parse-token reg-names {:token-str "AIM"}) (is (= (parse-token robotwar.game-lexicon/reg-names {:token-str "AIM"})
{:val "AIM", :type :register})))) {:val "AIM", :type :register}))))
(deftest parse-token-command-word (deftest parse-token-command-word
(testing "parsing command token (word)" (testing "parsing command token (word)"
(is (= (parse-token reg-names {:token-str "GOTO"}) (is (= (parse-token robotwar.game-lexicon/reg-names {:token-str "GOTO"})
{:val "GOTO", :type :command})))) {:val "GOTO", :type :command}))))
(deftest parse-token-command-operator (deftest parse-token-command-operator
(testing "parsing command token (operator)" (testing "parsing command token (operator)"
(is (= (parse-token reg-names {:token-str "#"}) (is (= (parse-token robotwar.game-lexicon/reg-names {:token-str "#"})
{:val "#", :type :command})))) {:val "#", :type :command}))))
(deftest parse-token-number (deftest parse-token-number
(testing "parsing number token" (testing "parsing number token"
(is (= (parse-token reg-names {:token-str "-17"})) (is (= (parse-token robotwar.game-lexicon/reg-names {:token-str "-17"}))
{:val -17, :type :number}))) {:val -17, :type :number})))
(deftest parse-token-label (deftest parse-token-label
(testing "parsing label token" (testing "parsing label token"
(is (= (parse-token reg-names {:token-str "SCAN"}) (is (= (parse-token robotwar.game-lexicon/reg-names {:token-str "SCAN"})
{:val "SCAN", :type :label})))) {:val "SCAN", :type :label}))))
(deftest parse-token-error (deftest parse-token-error
(testing "parsing error token" (testing "parsing error token"
(is (= (parse-token reg-names {:token-str "-GOTO"}) (is (= (parse-token robotwar.game-lexicon/reg-names {:token-str "-GOTO"})
{:val "Invalid word or symbol", :type :error})))) {:val "Invalid word or symbol", :type :error}))))
(deftest parse-tokens-minus-sign (deftest parse-tokens-minus-sign
(testing "parsing tokens with a binary minus sign" (testing "parsing tokens with a binary minus sign"
(is (= (parse reg-names lexed-tokens2) (is (= (parse robotwar.game-lexicon/reg-names lexed-tokens2)
parsed-tokens2)))) parsed-tokens2))))
(deftest parse-tokens-negative-sign (deftest parse-tokens-negative-sign
(testing "parsing tokens with a unary negative sign" (testing "parsing tokens with a unary negative sign"
(is (= (parse reg-names lexed-tokens3) (is (= (parse robotwar.game-lexicon/reg-names lexed-tokens3)
parsed-tokens3)))) parsed-tokens3))))
(deftest parse-tokens-error (deftest parse-tokens-error
(testing "parsing tokens with an invalid operator" (testing "parsing tokens with an invalid operator"
(is (= (parse reg-names lexed-tokens4) (is (= (parse robotwar.game-lexicon/reg-names lexed-tokens4)
parsed-tokens4)))) parsed-tokens4))))
(def minus-sign-disambiguated-tokens2 parsed-tokens2) (def minus-sign-disambiguated-tokens2 parsed-tokens2)
@ -294,17 +294,17 @@
(deftest assemble-test-success (deftest assemble-test-success
(testing "compiling successfully" (testing "compiling successfully"
(is (= (assemble reg-names (join "\n" [line1 line2 line3])) (is (= (assemble robotwar.game-lexicon/reg-names (join "\n" [line1 line2 line3]))
multi-line-assembled)))) multi-line-assembled))))
(deftest assemble-test-failure (deftest assemble-test-failure
(testing "assemble results in error" (testing "assemble results in error"
(is (= (assemble reg-names (join "\n" [line1 line2 line3 line4])) (is (= (assemble robotwar.game-lexicon/reg-names (join "\n" [line1 line2 line3 line4]))
multi-line-assembled-error)))) multi-line-assembled-error))))
(deftest preserving-line-and-pos-metadata-test (deftest preserving-line-and-pos-metadata-test
(testing "line and pos metadata preserved through assembly process" (testing "line and pos metadata preserved through assembly process"
(is (= (meta (get-in (assemble reg-names (join "\n" [line1 line2 line3])) (is (= (meta (get-in (assemble robotwar.game-lexicon/reg-names (join "\n" [line1 line2 line3]))
[:instrs 8 1])) [:instrs 8 1]))
{:line 3, :pos 14})))) {:line 3, :pos 14}))))

View File

@ -1,86 +0,0 @@
(ns robotwar.robot-test
(:use [clojure.test]
(robotwar foundry robot game-lexicon)))
(def src-codes [ ; program 0: multi-use program
" START
0 TO A
TEST
IF A > 2 GOTO START
GOSUB INCREMENT
GOTO TEST
100 TO A
INCREMENT
A + 1 TO A
ENDSUB
200 TO A "
; program 1: to test RANDOM register
" 1000 TO RANDOM
RANDOM
RANDOM
RANDOM
RANDOM
RANDOM
RANDOM
RANDOM
RANDOM
RANDOM
RANDOM "
; program 2: to test INDEX/DATA pair of registers
" 300 TO A
1 TO INDEX
DATA " ])
(def robot-history #(iterate tick-robot (init-robot-state (assemble reg-names %) {})))
(def robot-histories (map robot-history src-codes))
(def multi-use-history (nth robot-histories 0))
(def random-check-history (nth robot-histories 1))
(def index-data-check-history (nth robot-histories 2))
(deftest branching-test
(testing "comparison statement should cause jump in instr-ptr"
(is (= (:instr-ptr (nth multi-use-history 4))
5))))
(deftest arithmetic-test
(testing "addition"
(is (= (:acc (nth multi-use-history 7))
1))))
(deftest gosub-test
(testing "gosub should move instr-ptr and add the return-ptr to the call stack"
(is (let [{:keys [instr-ptr call-stack]} (nth multi-use-history 5)]
(= [instr-ptr call-stack]
[9 [6]])))))
(deftest endsub-test
(testing "endsub pops instr-ptr off call stack and goes there"
(is (let [{:keys [instr-ptr call-stack]} (nth multi-use-history 9)]
(= [instr-ptr call-stack]
[6 []])))))
(deftest push-test
(testing "pushing number to register"
(is (= (get-in (nth multi-use-history 8) [:registers "A"])
1))))
(deftest random-test
(testing "push to random register and pull from it to receive a number
of unequal numbers less than the number that was pushed"
(is (let [random-pairs (map (fn [n]
(let [{{random "RANDOM"} :registers, acc :acc}
(nth random-check-history n)]
[random acc]))
(range 3 13))]
(and (every? #{1000} (map first random-pairs))
(every? #(< -1 % 1000) (map second random-pairs))
(apply not= (map second random-pairs)))))))
(deftest index-data-pair-test
(testing "registers whose index numbers are pushed to INDEX can
be referenced by accessing DATA"
(is (= (get-in (nth index-data-check-history 5) [:registers "A"])
300))))