Advanced handling of bot failures

src/crosscram/engine.clj

@@ -8,46 +8,89 @@ 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.
 
-(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
       (= pair [0 1]) {:bot-a 1 :bot-b 0 :draws 0}
       (= 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]
+  {:pre [(cast clojure.lang.IPending prm), (not (realized? prm))]}
+  ;; TODO: Is this the most appropriate timer?
+  (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 ^: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)
+        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))))
+
+(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))))))))

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))

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)))))

test/crosscram/test/engine.clj

@@ -1,62 +1,89 @@
 (ns crosscram.test.engine
   (:use [clojure.test]
+        [clojure.template :only (do-template)]
         [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]
   (let [moves (vec moves)]
     (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
   ;; -221
   (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, :player-id 1}))
+    (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-
   ;; -1-
   (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
   ;; --1
   (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)]
+        done (play game [bot-h bot-v])]
+    (is (= (count (:history done)) 4))
+    (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 (= (winner done) 0))))
+    (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))))