Othello from Paradigms of Artificial Intelligence Programming, re-written in Clojure Part 2: Strategies

Othello Strategies

This is the second part of my re-write of Norvig’s Othello, originally written in Common Lisp, in Clojure. In this part I show how I’ve implemented the various Othello playing strategies in Clojure.

One important thing to note is that, with the exception of the random and human player strategies, the strategies are static. By that I mean given the same board position they will always generate the same move. This means playing two of these strategies against each other will always end with the same result (switching which moves first may produce a different result)! Norvig notes this in Section 18.8 and shows how we can use random starting positions to evaluate strategies against each other.

As with Part One of this series I’ve left my test and experimental code in place but commented out (usually just using ; but occasionally using the #_ reader macro which, as you recall, causes the next form to be ignored). The same caveats apply: I may well have modified the code or changed names since writing the commented out elements so they may no longer work.

This takes us up to section 18.8 of PAIP (I’ve decided not to implement the tournament clock until after I have a working GUI).

;;;;
;;;; OTHELLO GAME STRATEGIES
;;;;

(ns othello.strategies
  (:use [othello.core]))

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

(defn maximiser
  "Return a strategy that will consider every legal move,
  apply eval-fn to each resulting board, and choose
  the move for which eval-fn returns the best score.
  FN takes two arguments: the board and the player-to-move."
  [eval-fn]
  (fn
    [board player]
    (let [moves (legal-moves board player)
          scores (map (fn [move]
                          (eval-fn (make-move board move player)
                                   player))
                          moves)
          best-index (first (apply max-key second (map-indexed vector scores)))]
      (nth moves best-index))))

;
; Calculates the weighted position of the given board for the given player
;

(def ^:const weights
                    [[0   0   0   0   0   0   0   0   0   0]
                     [0 120 -20  20   5   5  20 -20 120   0]
                     [0 -20 -40  -5  -5  -5  -5 -40 -20   0]
                     [0  20  -5  15   3   3  15  -5  20   0]
                     [0   5  -5   3   3   3   3  -5   5   0]
                     [0   5  -5   3   3   3   3  -5   5   0]
                     [0  20  -5  15   3   3  15  -5  20   0]
                     [0 -20 -40  -5  -5  -5  -5 -40 -20   0]
                     [0 120 -20  20   5   5  20 -20 120   0]
                     [0   0   0   0   0   0   0   0   0   0]])

(defn weight-this-square
  [player square-piece square-weight]
  (cond
         (= square-piece player) square-weight
         (= square-piece (opponent player))  (- square-weight)
         :else 0))

(defn weight-row
  [player row row-weights]
  (reduce + (map (partial weight-this-square player) row row-weights)))

(defn weighted-squares
  "An eval-fn to use with the maximiser function that will generate a
  strategy that maximises the weighted score (using weights)."
  [board player]
  (reduce + (map (partial weight-row player) board weights)))

;;
;; Minimax
;;

(def winning-value 100000)
(def losing-value -100000)
(def draw-value 0)

(defn- final-value
  "Is this a win, loss or draw for player?"
  [board player]
  (let [score (count-difference board player)]
  (cond
     (neg? score) losing-value
     (pos? score) winning-value
     :else draw-value)))

; (bigger [1 [1 2]] [10 [3 4]])

(defn- convert
  "Converts the value for an opposing player's
  evaluated move by negating the value component"
  [[value move]]
  [(- value) move])

(defn- bigger
  "Compares two [value move] and returns the one with the bigger value.
  Returns the second one (different move) if they have the same value."
  [[val-1 mv-1 :as val-mv-1] [val-2 mv-2 :as val-mv-2]]
  (if (> val-1 val-2)
    val-mv-1
    val-mv-2))

#_(declare minimax)

#_(defn- best-move
  "Returns the best move out of MOVES for the player
  as a 2 element array [value move]"
  [board moves player ply eval-fn]
  (reduce bigger
    (for [move moves] ; create a vector of 2 element vectors of value and move.
      [(- (first (minimax (make-move board move player)
                        (opponent player)
                        (dec ply)
                        eval-fn))) ; note that we deliberately do *not*
                                   ; use the move returned by minimax
                                   ; as that is the *opponent's* move.
      move])))

(defn- minimax
  "Find the best move for PLAYER, according to EVAL-FN,
  searching PLY levels deep and backing up values."
  [board player ply eval-fn]
  (if (zero? ply)
    [(eval-fn board player) nil]
    (let [moves (legal-moves board player)]
      (if (empty? moves)
        (if (any-legal-move? board (opponent player))
          (convert (minimax board (opponent player) (dec ply) eval-fn))
          [(final-value board player) nil])
;        (best-move board moves player ply eval-fn)
        (reduce bigger
          (for [move moves] ; create a vector of 2 element vectors of value and move.
               [(- (first (minimax (make-move board move player)
                                   (opponent player)
                                   (dec ply)
                                   eval-fn))) ; note that we deliberately do *not*
                                              ; use the move returned by minimax
                                              ; as that is the *opponent's* move.
                  move]))

        ))))

;(minimax starting-position :black 8 weighted-squares)
;(final-value full-board :white)

(defn minimax-searcher
  "Returns a strategy function based on minimax."
  [ply eval-fn]
  (fn
    [board player]
    (nth (minimax board player ply eval-fn) 1)))

;(minimax-searcher 3 weighted-squares)

;;
;; Minimax with alpha-beta pruning.
;;

#_(declare alpha-beta)

#_(defn- best-move-alpha-beta
  "Returns the best move out of MOVES for the player
  as a 2 element array [value move]"
  [board moves player achievable cutoff ply eval-fn]
  (loop  [mvs moves
          current-achievable achievable
          best-move (first moves)]
    (if (empty? mvs)
      [current-achievable best-move]
      (let [move (first mvs)
            value (- (first (alpha-beta (make-move board move player)
                                        (opponent player) (- cutoff)
                                        (- achievable) (dec ply) eval-fn)))]
        (if (> value current-achievable)
          (if (>= value cutoff)
              [value move]
              (recur (rest mvs) value move))
          (recur (rest mvs) current-achievable best-move))))))

(defn alpha-beta
  "Find the best move, for PLAYER, according to EVAL-FN,
  searching PLY levels deep and backing up values,
  using cutoffs whenever possible."
  [board player achievable cutoff ply eval-fn]
  (if (zero? ply)
    [(eval-fn board player) nil]
    (let [moves (legal-moves board player)]
      (if (empty? moves)
        (if (any-legal-move? board (opponent player))
          ; player's turn skipped, opponent plays again
          (convert (alpha-beta board (opponent player)
                               (- cutoff) (- achievable)
                               (dec ply) eval-fn))
          ; Neither player nor opponent has a move: game over
          [(final-value board player) nil])
        ; player has at least one legal move, which is the best?
;        (best-move-alpha-beta board moves player achievable cutoff ply eval-fn)
        (loop  [mvs moves current-achievable achievable best-move (first moves)]
          (if (empty? mvs)
            [current-achievable best-move]
            (let [move (first mvs)
                  value (- (first (alpha-beta (make-move board move player)
                                              (opponent player) (- cutoff)
                                              (- achievable) (dec ply) eval-fn)))]
              (if (> value current-achievable)
                (if (>= value cutoff)
                  [value move]
                  (recur (rest mvs) value move))
                (recur (rest mvs) current-achievable best-move)))))

        ))))

; (minimax starting-position :black 8 weighted-squares)
;(time (trampoline (alpha-beta starting-position :black losing-value winning-value 8 weighted-squares)))

(defn alpha-beta-searcher
  "Returns a strategy that searches to PLY and uses EVAL-FN."
  [ply eval-fn]
  (fn
    [board player]
    (second (alpha-beta board player losing-value winning-value ply eval-fn))))

;;
;; Modified weighted-squares
;;

;; Bit boring

#_(defn modified-weighted-squares
  "Like WEIGHTED-SQUARES, but don't take off
  for moving near an occupied corner."
  [board player]

  (let [w (weighted-squares player board)]
    (dolist [corner [11 18 81 88]]
      (when-not (eql (bref board corner) :empty)
        (dolist [c (neighbours corner)]

                (when-not (eql (bref board c) :empty))
                  (incf w (* (- 5 (aref *weights* c))
                             (if (eql (bref bard c) player)
                               +1
                               -1))))))
    w))

Next

I’m currently working on using a Clojure wrapper for Swing, SeeSaw, to build a GUI for Othello. This uses an atom to hold the current board state with a watcher to update the display of the board when the board changes. My currently problem is handling the mismatch between repaint!, paint and reference watchers! Hopefully that won’t prove insoluble without having to resort to a non-functional solution (such as dynamic scope vars to pass values around). Readers familiar with PAIP will note that Norvig doesn’t implement a GUI (his focus is AI of course) but one of the big reasons I chose Clojure over Common Lisp was precisely the ability to build a standard, native-looking GUI application; something that’s not possible on Common Lisp because the ANSI standard doesn’t cover GUIs.

Advertisement

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.