From 653444b413037f195255c08632730b5aedce449c Mon Sep 17 00:00:00 2001 From: Tim McCormack Date: Fri, 6 Jul 2012 01:46:19 -0400 Subject: [PATCH 1/4] Handle bot-fails: History events are maps now instead of dominoes. * cc.game/move takes events instead of dominoes * #'winner moves from cc.engine to cc.game * In cc.engine, #'play becomes iterate over a fn from game -> game * #'play-symmetric and #'play now take vector of players --- src/crosscram/engine.clj | 89 +++++++++++++++++++++++++--------- src/crosscram/game.clj | 79 ++++++++++++++++++++++++------ src/crosscram/main.clj | 9 ++-- test/crosscram/test/engine.clj | 36 +++++--------- test/crosscram/test/game.clj | 25 +++++++--- 5 files changed, 165 insertions(+), 73 deletions(-) diff --git a/src/crosscram/engine.clj b/src/crosscram/engine.clj index 55fdddd..736004f 100644 --- a/src/crosscram/engine.clj +++ b/src/crosscram/engine.clj @@ -20,11 +20,6 @@ gives the second player a transposed view of the board.)" ;; TODO: Strip metadata from returned dominoes. Player could be storing state ;; there or otherwise be up to no good. -(def over? - "Returns true if there are no horizontal moves possible, false otherwise. -Takes a board as argument." - (complement game/can-move?)) - (defn score [game1 game2] (let [pair [game1 game2]] (cond @@ -32,22 +27,68 @@ Takes a board as argument." (= pair [1 0]) {:bot-a 0 :bot-b 1 :draws 0} :else {:bot-a 0 :bot-b 0 :draws 1}))) -(defn winner [game] - (mod (dec (count (:history game))) 2)) - -(defn play [game bot-a bot-b] - "Play a game and return the resulting game-state." - (loop [g game - bot-funs (cycle [bot-a bot-b])] - (if (over? (:board g)) - g - (let [new-game (game/rotate-game (game/move g ((first bot-funs) g)))] - (recur new-game (rest bot-funs)))))) - -(defn play-symmetric [game bot-a bot-b games-to-play] - (loop [scoreboard {}] - (if (= games-to-play (apply + (vals scoreboard))) - scoreboard - (let [g1 (winner (play game bot-a bot-b)) - g2 (winner (play game bot-b bot-a))] - (recur (merge-with + scoreboard (score g1 g2))))))) +(defn- timeit + "Run a thunk and deliver the elapsed time in nanoseconds to a promise." + [thunk prm] + ;; TODO: Is this the most appropriate timer? + {:pre [(cast clojure.lang.IPending prm), (not (realized? prm))]} + (let [start (System/nanoTime)] + (try (thunk) + (finally + (let [end (System/nanoTime)] + (deliver prm (- end start))))))) + +(defn- result->event + "Given a bot-call result and an event base (:duration and :player-id filled +in), produce an event." + [game result evbase] + (if (contains? result :value) + (let [val (:value result)] + (if (game/valid-domino? val) + (let [candom (game/canonical-domino val)] + (if (game/valid-move? (:board game) candom) + (assoc evbase :type :move, :move candom) + (assoc evbase :type :invalid-move, :move candom))) + (assoc evbase :type :player-error, :return val))) + (assoc evbase :type :player-error, :error (:error result)))) + +(defn play-step + "Step the game forward by one move. " + [game player-fns] + (let [next-player (:player-id game) + evbase {:player-id next-player}] + (if (game/can-move? (:board game)) + (let [player-fn (get player-fns (mod next-player 2)) + timer (promise) + result (try + {:value (timeit #(player-fn game) timer)} + (catch Exception e {:error e})) + event (result->event game result (assoc evbase :duration @timer))] + (-> game + (game/conj-event event) + (game/rotate-game) + (assoc :over? (not (= :move (:type event)))))) + (-> game + (game/conj-event (assoc evbase :type :cant-move)) + (game/rotate-game (- next-player)) + (assoc :over? true))))) + +(defn play + "Play a game. Returns the final game state, in original orientation." + [game player-fns] + {:pre [(vector? player-fns)]} + (first (drop-while (complement :over?) (iterate #(play-step % player-fns) + game)))) + +(defn play-symmetric + "Play two bots in on a board of the given dimensions for a set number of +rounds. Return a winnings count map with keys :bot-a, :bot-b, and :draws." + [dims [bot-a bot-b] num-rounds] + ;; TODO: Define a player type, and pass those in, not bot fns + (let [compete #(game/winner (play (game/make-game dims 0) [%1 %2]))] + (loop [scoreboard {}] + (if (<= num-rounds (apply + (vals scoreboard))) + scoreboard + (let [g1 (compete bot-a bot-b) + g2 (compete bot-b bot-a)] + (recur (merge-with + scoreboard (score g1 g2)))))))) diff --git a/src/crosscram/game.clj b/src/crosscram/game.clj index acc338a..205eed7 100644 --- a/src/crosscram/game.clj +++ b/src/crosscram/game.clj @@ -1,33 +1,61 @@ (ns crosscram.game "Game knowledge. +## Terms + In this documentation, \"vector\" means any indexed, sequential collection. +## Boards + A board is a 2-dimensional matrix. Create with #'board, access with #'location-empty? A cell on the board is addressed by a vector of [row column], zero-indexed. These may also be called coordinates or squares. +## Dominoes + A domino is a vector of two squares: [[r0 c0] [r1 c1]]. The order of the squares in a vector is not important, but the game engine will not alter it. -A move is simply a domino. +## Moves + +A move is simply a domino. A \"valid move\" is in reference to a board, +whereas a domino may be judged valid or not without reference to anything. + +## History + +A game history is a vector of events. An event is a map of :type (:move, +:invalid-move, :player-error, :cant-move) and possibly other keys +depending on :type. A :move is a valid move that can be placed on the current +board; an :invalid-move is a valid domino that cannot be played on this board, +including mis-oriented dominoes. A :player-error is a throw or a returned value +that is not a domino. :cant-move occurs when the game is over -- the player +has not been consulted. A completed game's history ends with a non-:move event. -A game history is a vector of moves. The index of each move is called -its ordinal; the move at index 0 was the first move. A new game will have -an empty history vector. +* :player-id - 0 or 1 +* :duration - bot's elapsed time (nanoseconds), for all but :cant-move +* :move - played domino (canonicalized), for :move or :invalid-move +* :error - with :player-error, the thrown error (if applicable) +* :return - with :player-error, the returned value (if applicable) + +The index of each event is called its ordinal; the event at index 0 was +the first event. A new game will have an empty history vector. The board contains an alternate view of history. Each cell contains either the ordinal (from the history vector) of the move that covered that square, -or nil if the square is open. +or nil if the square is open. Future work may add additional cell value types, +but open squares will remain logical-false for the foreseeable future. + +## Gamestate A gamestate value (which is provided to the bot) is a map of: :board - a board value, as defined above :dims - a vector of [row-count column-count] :history - a history value, as defined above :player-id - 0 or 1, indicating which player's view this is +:over? - indicates the game is over and the last history event records this This will sometimes simply be called a game value.") @@ -98,6 +126,19 @@ perspective. (Unary form defaults to 1.) Player ID will be used modulo 2." [x] (and (integer? x) (pos? x))) +;;;; History + +(defn rotate-event + "Rotate a history event from player 0's perspective to the specified player's +perspective. (Unary form defaults to 1.) Player ID will be used modulo 2." + ([event] + (rotate-event event 1)) + ([event player-id] + {:pre [(:type event)]} + (if (#{:move :invalid-move} (:type event)) + (update-in event [:move] rotate-domino player-id) + event))) + ;;;; Boards (defn make-board @@ -125,6 +166,7 @@ perspective. (Unary form defaults to 1.) Player ID will be used modulo 2." ([board] (rotate-board board 1)) ([board player-id] + {:pre [(vector? board)]} (if (zero? (mod player-id 2)) board (transpose board)))) @@ -147,7 +189,7 @@ moves, rotate the board first." (defn lookup-square "Discover if a board position is empty. Given a location [r c] on a board, return the ordinal of the move that filled it, or nil if empty. Invalid -coordinates produce ::outside-board value." +coordinates produce :crosscram.game/outside-board value." [board square] (get-in board square ::outside-board)) @@ -186,14 +228,14 @@ for the indicated player. The player ID may be 0 or 1." :history [] :player-id player-id})) -(defn move - "Add a move (a domino) to a game." - [game move] - (let [ord (count (:history game)) - board (place-domino (:board game) move ord)] - (-> game - (assoc-in [:history ord] (canonical-domino move)) - (assoc :board board)))) +(defn conj-event + "Apply a history event to a game. Requires canonicalized dominoes." + [game event] + (let [event-ord (count (:history game)) + updated (if (= :move (:type event)) + (update-in game [:board] place-domino (:move event) event-ord) + game)] + (update-in updated [:history] conj event))) (defn rotate-game "Rotate a game from player 0's perspective to the specified player's @@ -202,9 +244,16 @@ NOTE: This updates the :player-id key as well." ([game] (rotate-game game 1)) ([game player-id] + {:pre [(:board game)]} (if (zero? (mod player-id 2)) game {:board (rotate-board (:board game) player-id) :dims (let [[r c] (:dims game)] [c r]) - :history (vec (map rotate-domino (:history game))) + :history (vec (map rotate-event (:history game))) :player-id (mod (+ (:player-id game) player-id) 2)}))) + +(defn winner + "Returns the ID of the winning player of a finished game." + [game] + {:pre [(:over? game)]} + (mod (count (:history game)) 2)) diff --git a/src/crosscram/main.clj b/src/crosscram/main.clj index c4ecae7..896ed9e 100644 --- a/src/crosscram/main.clj +++ b/src/crosscram/main.clj @@ -1,6 +1,5 @@ (ns crosscram.main - (:require [crosscram.engine :as engine] - [crosscram.game :as game])) + (:require [crosscram.engine :as engine])) (defn- load-player "Fetch a player map from a namespace, or nil. The map will contain: @@ -22,8 +21,8 @@ (let [dims [(Integer/parseInt rows) (Integer/parseInt columns)] num-games (Integer/parseInt num-games) scores (engine/play-symmetric - (game/make-game dims 0) - (:make-move fns-a) - (:make-move fns-b) + dims + [(:make-move fns-a) + (:make-move fns-b)] num-games)] (println "Scores:" scores))))) diff --git a/test/crosscram/test/engine.clj b/test/crosscram/test/engine.clj index 27334a7..6bd0e18 100644 --- a/test/crosscram/test/engine.clj +++ b/test/crosscram/test/engine.clj @@ -3,17 +3,6 @@ [crosscram.engine]) (:require [crosscram.game :as game])) -(deftest test-over - (let [game-not-over (-> (game/make-game [2 3] 0) - (game/move [[1 0] [1 1]])) - game-over (-> game-not-over - (game/rotate-game) - (game/move [[2 0] [2 1]]) - (game/rotate-game) - (game/move [[0 0] [0 1]]))] - (is (not (over? (:board game-not-over)))) - (is (over? (:board game-over))))) - (defn calvinist "Make a bot that will return exactly this sequence of moves." [& moves] @@ -28,18 +17,19 @@ (let [bot-h (calvinist [[0 0] [0 1]] [[1 1] [1 2]]) bot-v (calvinist [[3 0] [3 1]]) game (game/make-game [2 4] 0) - done (play game bot-h bot-v)] - (is (= (count (:history done)) 3)) - (is (= (winner done) 0))) + done (play game [bot-h bot-v])] + (is (= (count (:history done)) 4)) + (is (= (-> done :history peek :type) :cant-move)) + (is (= (game/winner done) 0))) ;; Completely filled board ;; 0013 ;; 2213 (let [bot-h (calvinist [[0 0] [0 1]] [[1 0] [1 1]]) bot-v (calvinist [[2 0] [2 1]] [[3 0] [3 1]]) game (game/make-game [2 4] 0) - done (play game bot-h bot-v)] - (is (= (count (:history done)) 4)) - (is (= (winner done) 1))) + done (play game [bot-h bot-v])] + (is (= (count (:history done)) 5)) + (is (= (game/winner done) 1))) ;; Vertical wins, vertical spaces remain ;; 00- ;; -1- @@ -47,9 +37,9 @@ (let [bot-h (calvinist [[0 0] [0 1]]) bot-v (calvinist [[1 1] [1 2]]) game (game/make-game [3 3] 0) - done (play game bot-h bot-v)] - (is (= (count (:history done)) 2)) - (is (= (winner done) 1))) + done (play game [bot-h bot-v])] + (is (= (count (:history done)) 3)) + (is (= (game/winner done) 1))) ;; Horizontal wins, horizontal spaces remain ;; 22- ;; 001 @@ -57,6 +47,6 @@ (let [bot-h (calvinist [[1 0] [1 1]] [[0 0] [0 1]]) bot-v (calvinist [[2 1] [2 2]]) game (game/make-game [3 3] 0) - done (play game bot-h bot-v)] - (is (= (count (:history done)) 3)) - (is (= (winner done) 0)))) + done (play game [bot-h bot-v])] + (is (= (count (:history done)) 4)) + (is (= (game/winner done) 0)))) diff --git a/test/crosscram/test/game.clj b/test/crosscram/test/game.clj index e2a50f3..ac13870 100644 --- a/test/crosscram/test/game.clj +++ b/test/crosscram/test/game.clj @@ -78,6 +78,12 @@ (is (= (rotate-domino d 0) d)) (is (= (rotate-domino d 1) (rotate-domino d -3))) (is (= (rotate-domino d 4) (rotate-domino d 18)))) + (let [in {:type :move :player-id 0 :move [[0 2] [1 2]] :duration 1} + out {:type :move :player-id 0 :move [[2 0] [2 1]] :duration 1}] + (is (= (rotate-event in) out)) + (is (= (rotate-event in) (rotate-event in 1))) + (is (= (rotate-event in 0) in)) + (is (= (rotate-event in -1) (rotate-event in 3)))) (let [p [[3 4] [2 4]] b57 (make-board [5 7]) move0 (place-domino b57 p 0)] @@ -115,12 +121,14 @@ {:board (make-board [3 2]), :dims [3 2], :history [], :player-id 1})) (let [game-base (make-game [2 3] 0) move-0 [[0 0] [1 0]] - game-0 (move game-base move-0) + event-0 {:type :move :player-id 0 :move move-0 :duration 1} + game-0 (conj-event game-base event-0) move-1 [[0 1] [0 2]] - game-1 (move game-0 move-1)] + event-1 {:type :move :player-id 1 :move move-1 :duration 1} + game-1 (conj-event game-0 event-1)] (is (= (:board game-0) (place-domino (make-board [2 3]) move-0 0))) - (is (= (:history game-0) [move-0])) - (is (= (:history game-1) [move-0 move-1])) + (is (= (:history game-0) [event-0])) + (is (= (:history game-1) [event-0 event-1])) ;; rotations (is (= (rotate-game game-1 0) game-1)) (is (= (rotate-game game-1) @@ -130,5 +138,10 @@ (is (= (rotate-game game-1 1) {:board (rotate-board (:board game-1) 1) :dims [3 2] - :history [(rotate-domino move-0 1) (rotate-domino move-1 1)] - :player-id 1})))) + :history [(rotate-event event-0 1) (rotate-event event-1 1)] + :player-id 1})) + ;; conj other events (left out: :invalid-move, :player-error) + (let [end-0 {:type :cant-move :player-id 0}] + (is (= (:board game-0) (:board (conj-event game-0 end-0)))) + (is (= (inc (count (:history game-0))) + (count (:history (conj-event game-0 end-0)))))))) From 1539ab4e2573dd4753d6618d41dd0ff38b989770 Mon Sep 17 00:00:00 2001 From: Tim McCormack Date: Fri, 6 Jul 2012 17:53:55 -0400 Subject: [PATCH 2/4] deduplicate and test event generation --- src/crosscram/engine.clj | 45 +++++++++++++++++++--------------- test/crosscram/test/engine.clj | 23 ++++++++++++++++- 2 files changed, 47 insertions(+), 21 deletions(-) diff --git a/src/crosscram/engine.clj b/src/crosscram/engine.clj index 736004f..e81ac29 100644 --- a/src/crosscram/engine.clj +++ b/src/crosscram/engine.clj @@ -52,33 +52,38 @@ in), produce an event." (assoc evbase :type :player-error, :return val))) (assoc evbase :type :player-error, :error (:error result)))) -(defn play-step - "Step the game forward by one move. " +(defn ^:internal call-bot + "Ask the bot for a move. (Assumes a move is available.) Returns an event." + [game player-fn] + {:pre [(:board game), (fn? player-fn)]} + (let [timer (promise) + result (try {:value (timeit #(player-fn game) timer)} + (catch Exception e {:error e}))] + (result->event game result {:player-id (:player-id game) + :duration @timer}))) + +(defn ^:internal play-step + "Step the game forward by one move. Rotates the board to be ready for +the next player, or returns to original orientation when game is over." [game player-fns] (let [next-player (:player-id game) - evbase {:player-id next-player}] - (if (game/can-move? (:board game)) - (let [player-fn (get player-fns (mod next-player 2)) - timer (promise) - result (try - {:value (timeit #(player-fn game) timer)} - (catch Exception e {:error e})) - event (result->event game result (assoc evbase :duration @timer))] - (-> game - (game/conj-event event) - (game/rotate-game) - (assoc :over? (not (= :move (:type event)))))) - (-> game - (game/conj-event (assoc evbase :type :cant-move)) - (game/rotate-game (- next-player)) - (assoc :over? true))))) + event (if (game/can-move? (:board game)) + (call-bot game (get player-fns (mod next-player 2))) + {:type :cant-move, :player-id next-player}) + over? (not= (:type event) :move) + rotate-by (if over? (- next-player) 1)] + (-> game + (game/conj-event event) + (game/rotate-game rotate-by) + (assoc :over? over?)))) (defn play "Play a game. Returns the final game state, in original orientation." [game player-fns] {:pre [(vector? player-fns)]} - (first (drop-while (complement :over?) (iterate #(play-step % player-fns) - game)))) + (first (drop-while (complement :over?) + (iterate #(play-step % player-fns) + game)))) (defn play-symmetric "Play two bots in on a board of the given dimensions for a set number of diff --git a/test/crosscram/test/engine.clj b/test/crosscram/test/engine.clj index 6bd0e18..bef367a 100644 --- a/test/crosscram/test/engine.clj +++ b/test/crosscram/test/engine.clj @@ -1,5 +1,6 @@ (ns crosscram.test.engine (:use [clojure.test] + [clojure.template :only (do-template)] [crosscram.engine]) (:require [crosscram.game :as game])) @@ -10,6 +11,26 @@ (fn [game] (get moves (quot (count (:history game)) 2))))) +(deftest stepping + (do-template + [domino event*] (let [move (call-bot (game/make-game [2 4] 0) + (calvinist domino))] + (is (number? (:duration move))) + (is (= (:player-id move) 0)) + (is (= (dissoc move :duration :player-id) event*))) + [[0 0] [0 1]] {:type :move, :move [[0 0] [0 1]]} + [[5 0] [5 1]] {:type :invalid-move, :move [[5 0] [5 1]]} + 'xyz {:type :player-error, :return 'xyz}) + (let [player-threw (call-bot (game/make-game [2 4] 0) + (fn [&_] (throw (ArithmeticException.))))] + (is (number? (:duration player-threw))) + (is (= (:player-id player-threw) 0)) + (is (= (:type player-threw) :player-error)) + (is (= (set (keys player-threw)) #{:type :player-id :duration :error})) + (is (= (class (:error player-threw)) ArithmeticException))) + ;; {:type :cant-move} is missing because call-bot is not invoked for that + ) + (deftest termination ;; Horizontal wins, some spaces remain ;; 00-1 @@ -19,7 +40,7 @@ game (game/make-game [2 4] 0) done (play game [bot-h bot-v])] (is (= (count (:history done)) 4)) - (is (= (-> done :history peek :type) :cant-move)) + (is (= (-> done :history peek) {:type :cant-move, :player-id 1})) (is (= (game/winner done) 0))) ;; Completely filled board ;; 0013 From bc959941492dbdd2ca394bb15f2c082304ed7a8e Mon Sep 17 00:00:00 2001 From: Tim McCormack Date: Fri, 6 Jul 2012 18:03:20 -0400 Subject: [PATCH 3/4] Test all termination events. --- test/crosscram/test/engine.clj | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/test/crosscram/test/engine.clj b/test/crosscram/test/engine.clj index bef367a..af372ce 100644 --- a/test/crosscram/test/engine.clj +++ b/test/crosscram/test/engine.clj @@ -70,4 +70,20 @@ game (game/make-game [3 3] 0) done (play game [bot-h bot-v])] (is (= (count (:history done)) 4)) - (is (= (game/winner done) 0)))) + (is (= (game/winner done) 0))) + ;; error cases + (let [bot-h (calvinist [[1 0] [1 1]] [[5 0] [5 1]]) + bot-v (calvinist [[2 1] [2 2]]) + done (play (game/make-game [3 3] 0) [bot-h bot-v])] + (is (= (count (:history done)) 3)) + (is (= (-> done :history peek :type) :invalid-move))) + (let [bot-h (calvinist [[1 0] [1 1]] 'xyz) + bot-v (calvinist [[2 1] [2 2]]) + done (play (game/make-game [3 3] 0) [bot-h bot-v])] + (is (= (count (:history done)) 3)) + (is (= (-> done :history peek :type) :player-error))) + (let [bot-h (calvinist [[1 0] [1 1]]) + bot-v (fn [& _] (throw (Exception.))) + done (play (game/make-game [3 3] 0) [bot-h bot-v])] + (is (= (count (:history done)) 2)) + (is (= (-> done :history peek :type) :player-error)))) From 9befa696b5c0e25c61ac43090ec9f6a825c9aa2d Mon Sep 17 00:00:00 2001 From: Tim McCormack Date: Sat, 7 Jul 2012 11:49:55 -0400 Subject: [PATCH 4/4] Clarify comments and docstring re: invalid bot responses. --- src/crosscram/engine.clj | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/src/crosscram/engine.clj b/src/crosscram/engine.clj index e81ac29..48fb9b5 100644 --- a/src/crosscram/engine.clj +++ b/src/crosscram/engine.clj @@ -8,15 +8,12 @@ by 1 but the row coordinates are equal. That is, every player plays horizontal, and sees the other player as playing vertical. (The game engine gives the second player a transposed view of the board.)" +If a bot returns an invalid move or an invalid domino or simply throws +an exception, the bot will lose that game." (:require [crosscram.game :as game])) -;; TODO(timmc:2012-05-23) Decide on tournament rules for bots throwing -;; exceptions, returning nil, returning bad dominoes... - -;; TODO(timmc:2012-05-24) Wait, how would we even decide which player won a -;; 3-player game? Last player to place a tile before someone fails, or last -;; player standing after successive elimination? - +;; TODO(timmc:2012-05-24) In a 3-player game, the winner is the last +;; player standing after successive elimination. ;; TODO: Strip metadata from returned dominoes. Player could be storing state ;; there or otherwise be up to no good. @@ -30,8 +27,8 @@ gives the second player a transposed view of the board.)" (defn- timeit "Run a thunk and deliver the elapsed time in nanoseconds to a promise." [thunk prm] - ;; TODO: Is this the most appropriate timer? {:pre [(cast clojure.lang.IPending prm), (not (realized? prm))]} + ;; TODO: Is this the most appropriate timer? (let [start (System/nanoTime)] (try (thunk) (finally