Othello from Paradigms of Artificial Intelligence Programming, re-written in Clojure

The Core Game and Command Line UI

One of my favourite computer science / programming books is Peter Norvig’s “Paradigms of Artificial Intelligence Programming: Case Studies in Common Lisp” (PAIP). And the extended Othello example had always fascinated me so when I was looking for something to write to help me learn Clojure it was an obvious candidate: re-write Norvig’s Othello in Clojure.

This is the result, it takes you up to the end of Section 18.2 of the book, which includes the core game and one simple strategy that makes random moves. In translating it into Clojure I tried to keep it as identical to the original except where Clojure (a Lisp-1) makes it easier to write in a different way from Common Lisp (a Lisp-2).

I used idiomatic Clojure and made use of the most appropriate Clojure data structures: arrays, sets and maps rather than lists. I did make three changes from the original:

  • The original used a list for the board. I use an array of arrays.
  • I split one of the original functions, get-move, because the original actually both got the move from the strategy and also made the move. So I split it into get-and-make-move and get-move, which just gets the move from the strategy.
  • The third change was not to use a function to generate the starting board but instead defined it by hand as I think this makes it easier to understand.

Finally, Common Lisp uses mutable data structures whereas Clojure’s are immutable. So this changed the copy-board strategy used by the PAIP version: in Clojure you don’t need to make explicit copies, that’s the default behaviour.

I’ve generally written ‘idiomatic Clojure’ but because my code is still evolving (there’s a lot more Othello still!) and because I generally prefer to avoid syntactic sugar (even if the result is greater conciseness) in favour of simplicity and obviousness I’ve generally, but not always, avoided the compound macros like if-let.

I’ve left in the forms I used whilst developing and testing the code (commented out, rather than using the #_ reader macro). Note that some of the variables’ names changed during development so some of the earlier testing code might still use the old names.

So without any more ado, here’s the code:


;;;;
;;;; OTHELLO GAME
;;;;

(ns othello.core
  (:gen-class))

;;;
;;; Othello board and functions to operate on them.
;;;

(def starting-position
  "Othello board setup in the starting position."
  '[
   [:edge :edge  :edge  :edge  :edge  :edge  :edge  :edge  :edge  :edge]
   [:edge :empty :empty :empty :empty :empty :empty :empty :empty :edge]
   [:edge :empty :empty :empty :empty :empty :empty :empty :empty :edge]
   [:edge :empty :empty :empty :empty :empty :empty :empty :empty :edge]
   [:edge :empty :empty :empty :white :black :empty :empty :empty :edge]
   [:edge :empty :empty :empty :black :white :empty :empty :empty :edge]
   [:edge :empty :empty :empty :empty :empty :empty :empty :empty :edge]
   [:edge :empty :empty :empty :empty :empty :empty :empty :empty :edge]
   [:edge :empty :empty :empty :empty :empty :empty :empty :empty :edge]
   [:edge :edge  :edge  :edge  :edge  :edge  :edge  :edge  :edge  :edge]])

(def full-board
  "Othello full board for testing."
  '[
   [:edge :edge  :edge  :edge  :edge  :edge  :edge  :edge  :edge  :edge]
   [:edge :empty :black :black :black :black :black :black :black :edge]
   [:edge :black :black :black :black :black :black :black :black :edge]
   [:edge :black :black :white :black :black :black :black :black :edge]
   [:edge :black :black :black :black :black :black :black :black :edge]
   [:edge :black :black :black :black :black :black :black :black :edge]
   [:edge :black :black :black :black :black :black :black :black :edge]
   [:edge :black :black :black :black :black :black :black :black :edge]
   [:edge :black :black :black :black :black :black :black :black :edge]
   [:edge :edge  :edge  :edge  :edge  :edge  :edge  :edge  :edge  :edge]])

(def all-directions
  "Defines the array of all possible directions from a square."
  [[-1 -1][0 -1][+1 -1]
   [-1  0]      [+1  0]
   [-1 +1][0 +1][+1 +1]])

(defn opponent
  "Returns the player's opponent."
  [player]
  (if (= player :black) :white :black))

(defn board-width [board] (count (board 0)))
(defn board-height [board] (count board))

(defn valid-move?
  "Valid moves are inside the board"
  [board [x y]]
  (and (< y (board-height board)) (< x (board-width board))))

(defn place-piece
   "Takes a board (a 2d array y high, x wide) and places the given piece at the required position
   and returns the new board.   Note that it does not apply the rules of Othello.
   Will throw exceptions if it is outside the board and can mess-up the board."
   [board [x y] player]
   (printf "Placing %s piece at [%d %d].\n" player x y)
   (assoc board y (assoc (board y) x player)))

 ; (print-board (place-piece starting-position [5 5] :black))

(defn get-piece
   "Returns the piece at the given co-ords in the given board"
   [board [x y]]
   ((board y) x))

 ;;
 ;; Implements the rules of Othello
 ;;

(defn find-bracketing-piece
   "Return the square co-ords [x y] of the bracketing piece,
   nil if there isn't one."
   [board [x y :as square] player [dx dy :as direction]]
   (cond
     (= (get-piece board square) player)
       square
     (= (get-piece board square) (opponent player))
       (recur board [(+ x dx) (+ y dy)] player direction)
     :else nil))

(defn would-flip?
   "Would this move result in any flips in this direction?
   If so, return the square of the bracketing piece."
   [board [x y] player [dx dy :as direction]]
   ;; A flip occurs if, starting at the adjacent square, c, there
   ;; is a string of at least one opponent pieces, bracketed by
   ;; one of player's pieces
   (let   [c-x (+ x dx)
           c-y (+ y dy)]
     (and (= (get-piece board [c-x c-y]) (opponent player))
          (find-bracketing-piece board [(+ c-x dx) (+ c-y dy)] player direction))))

(defn legal-move?
   "A legal move must be into an empty square, and it must flip at least one opponent piece"
   [board player move]
   (and (valid-move? board move)
        (= (get-piece board move) :empty)
        (some (partial would-flip? board move player) all-directions)))

(defn make-flips
   "Make any flips in the given direction"
   [board [x y :as square] player [dx dy :as direction]]
 ;  (printf "Checking flips for %s from square [%d %d] in direction [%d %d]\n" player x y dx dy)
   (let [bracketer (would-flip? board square player direction)]
 ; bracketer will be either an array or the boolean false.
     (if-not bracketer
       board
       (loop [brd board
              flip-x (+ x dx)
              flip-y (+ y dy)]
         (if (and (= flip-x (bracketer 0)) (= flip-y (bracketer 1)))
           brd
           (recur (place-piece brd [flip-x flip-y] player) (+ flip-x dx)(+ flip-y dy)))))))

(defn make-move
   "Update board to reflect move by a player"
   [board move player]
   ;; First make the move, then make any flips
   (loop [brd (place-piece board move player)
          idx 0]
     (if (>= idx (count all-directions))
        brd
        (recur (make-flips brd move player (all-directions idx)) (inc idx)))))

;(print-board b1)
;(print-board (make-move b1 [1 1] :white))
;(find-bracketing-piece initial-board [4 5] :black [0 -1])
;(print-board initial-board)
;(would-flip? initial-board [4 5] :black [0 -1])
;(print-board (make-move initial-board [4 5] :black))
;(would-flip? initial-board [0 0] :black [+1 +1])

(defn count-pieces
  "Counts the number of player's pieces on the board."
  [board player]
  (reduce + (map (fn [row] (count (filter #(= % player) row))) board)))

(defn count-difference
  "Returns the difference between the player's and opponent's pieces on the board"
  [board player]
  (- (count-pieces board player) (count-pieces board (opponent player))))

; (count-difference initial-board :black)

;;;
;;; View
;;;

(defn name-of
  [player]
  ({:black "Black" :white "White"} player))

(defn print-board
  "Print a board along with some statistics"
  [board]
  (newline)
  (print "\t    1  2  3  4  5  6  7  8  ") ; hard-coded :(
  (print (name-of :black))
  (print "=")
  (print (count-pieces board :black))
  (print " ")
  (print (name-of :white))
  (print "=")
  (print (count-pieces board :white))
  (print " ")
  (println (count-difference board :black))

  (dotimes [row (count board)]
    (printf "%d\t" (* row 10))
    (doseq [cell (board row)]
      (print ({:black " ◉ " :white " ◎ " :edge " * "} cell " . ")))
    (newline)(newline)))

;(print-board initial-board)

;;
;; Strategies
;;

(defn legal-moves
  "Return an array of legal moves for player"
  [board player]
  (for [row [1 2 3 4 5 6 7 8] column [1 2 3 4 5 6 7 8]
      :when (legal-move? board player [column row])]
      [column row]))

;(legal-moves starting-position :black)
;(legal-moves full-board :black)
;(random-strategy full-board :black)
;(legal-moves full-board :black)

(defn random-strategy
  "Returns a random legal move:
  simple, but not very effective Othello playing strategy."
  [board player]
  (rand-nth (legal-moves board player)))

;(rand-nth [[0 1][1 1][1 2][2 3]])
;(rand-nth (legal-moves initial-board :black))
;(random-strategy initial-board :black)

;;;
;;; The main game loop and auxilliary functions.
;;;

(defn get-move
  "Call the player's strategy function to get a move.
  Keep calling until a valid and legal move is returned
  and pass that back.
  There is no way to escape without the strategy returning
  a valid and legal move."
  [board strategy player]
  (let [[x y :as move] (strategy board player)]
    (if (and (valid-move? board move) (legal-move? board player move))
      move ; return the move
      (do
        (printf "!Attempted illegal move [%d %d] by %s.\n" x y player)
        (recur board strategy player)))))

(defn get-and-make-move
  "Gets a valid and legal move from the strategy
  and then makes it, returning the new board.
  This does what the PAIP 'get-move' function did."
  [board strategy player print?]
  (when print? (print-board board))
  (let [[x y :as move] (get-move board strategy player)]
    (if print? (printf "%s moves to [%d %d]\n" (name-of player) x y))
    (make-move board move player))) ; return the new board

;(get-move initial-board random-strategy :black true)
;(make-move board move player)
;(print-board (get-and-make-move initial-board random-strategy :black true))
;(board-height initial-board)

(def all-moves
  "An array of all possible moves on an 8x8 Othello board.
  Is the same as every square. Was called all-squares in PAIP."
  (for [row [1 2 3 4 5 6 7 8] column [1 2 3 4 5 6 7 8]]
    [column row]))

(defn any-legal-move?
  "Does the player have any legal moves in this position (board)?"
  [board player]
  (some (partial legal-move? board player) all-moves))

; (any-legal-move? full-board :black)

(defn next-to-play
  "Compute the player to move next, or nil if nobody can move."
  [board previous-player print?]
  (let [opp (opponent previous-player)]
    (cond (any-legal-move? board opp) opp
          (any-legal-move? board previous-player)
           (do
             (if print? (printf "%s has no moves and must pass.\n" (name-of opp)))
              previous-player)
           :else nil))) ; neither player can make a legal move

;(next-to-play full-board :white true)
;(next-to-play starting-position :black true)
;(any-legal-move? full-board :black)
;(any-legal-move? starting-position :black)
;(print-board full-board)
;(any-legal-move? starting-position :white)
;(any-legal-move? full-board :black)
; (next-to-play full-board :white true)
;(if-not nil (printf "game over"))
; (next-to-play starting-position :white true)
; (next-to-play initial-board :white true)

(defn result-string
  "Converts the result into a string for display."
  [result]
  (cond
     (neg? result) "White wins."
     (pos? result) "Black wins."
     :else "Game is a draw."
   ))

(defn othello
  "Play a game of Othello.
  Return the score, where a positive
  difference means black (the first player) wins."
  ; Note that it assumes that :black plays first and that there must be a valid first move.
  [black-strategy white-strategy
   & {:keys [print? initial-board] :or {print? true initial-board starting-position}}]
  (loop [board (get-and-make-move initial-board black-strategy :black print?)
         player :black]
    (let [next-player (next-to-play board player print?)]
      (if-not next-player
        (let [result (count-difference board :black)]
          (when print?
            (printf "GAME OVER. Final result:\n")
            (print-board board)
            (print (result-string result))
            (newline))
          result) ; return the result, +ve is a black win
        (recur (get-and-make-move board
                                  ({:black black-strategy :white white-strategy} next-player)
                                  next-player print?)
               next-player)))))

;(next-to-play full-board :black true)
;(count-pieces full-board :white)
;({:black black-strategy :white white-strategy} :black)

; (othello random-strategy random-strategy) ; use this to try it
(defn -main
  "For playing a game of Othello at the command line."
  []
  (othello random-strategy random-strategy))

Next

In my next post we’ll get to some actual AI: Othello game-playing strategies.

About these ads

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s