Clojure Connect Four - Part 1: Checking For A Winner

This post is part of the ongoing series about Connect four in Clojure:

• Clojure Connect Four - Part 1: Checking For A Winner

GitHub: naeg/clj-connect-four

Checking For A Winner

Figure 1: Schema of sequences

In order to win a Connect four game, one player has to connect four of his pieces in sequence. A sequence is either a row (blue), a column (red) or a diagonal, which is either ascending (violet) or descending (green).

Before we start taking a closer look at the different algorithms, I'll explain the utility functions used to experiment and play with the different algorithms. If you have no idea what Clojure or functional programming is about, you might want to read this article about Conways Game of Life in Clojure first.

(def player [" ", "X", "O"])

(def empty-board
  "Empty board with 6 rows and 7 columns."
  (vec (repeat 6 (vec (repeat 7 (player 0))))))

(defn get-y
  "Determines y-coordinate for given x-coordinate."
  [board x]
  (first (filter #(= (get-in board [% x]) (player 0))
                 (range 5 -1 -1))))

(defn insert
  "Inserts symbol for given player (either 1 or 2) at specified x."
  [board x player-num]
  (let [y (get-y board x)]
    (assoc-in board [y x] (player player-num))))

(defn print-board
  [board]
  (println [1 2 3 4 5 6 7])
  (doseq [row board] (println row)))

Line 1: A vector containing strings which represent either an empty field (" ") or a piece of a player ("X" or "O")

Line 5: Generating a vector containing 6 vectors which contain 7 empty fields.

Line 10-11: filter out empty fields starting at the bottom (y = 5) of the board. This returns a lazy sequence of which we just take the first item.

Line 16-17: Creating a variable binding for the y-coordinate using let and then assoc-in the symbol of the given player-num at given x- and calculated y-coordinate.

Line 22: Iterate over the rows of the board an println them using doseq.

As you probably can tell by the code and by looking at Figure 1, I decided to use [y,x] coordinates with [0,0] being at the top left corner.

Now it's getting exciting. I tried three different algorithms to check for a winner: The first one pre-calculates all possible winning combinations and then pulls out those which are relevant to the current turn. The second one uses a bitboard representation for the board and a bit-fiddling function to check whether a player has won. The last one is a logical solution using Clojure's core.logic, which brings Prolog-like problem solving to Clojure.

Algorithm 1: Pre-calculated Winning Combinations

In total there are 69 possible winning combinations. On each row you have 4 possibilities of connecting four and there are 6 rows (24 combinations). On each column you have 3 possibilities and there are 7 columns (21 combinations). There are 12 ascending and 12 descending diagonals, resulting in a total number of 69 possibilites. Not that much, so we can store all of them in a simple vector.

After each turn, we filter out those winning combinations which are relevant to the current turn and see whether the player has connected four in one of these combinations. The highest number of combinations a certain cell can contribute to is 13 (for example the cell [2,3]). This number drops fast towards the corners and at the corners, there are only 3 possible combinations left in which the cell can contribute (e.g. the cell [5,0]).

(defn get-diags
  "Generates diagonals of given starting position using given step-fn."
  [step-fn start-pos]
  (for [pos start-pos]
    (take 4 (iterate step-fn pos))))

(def win-combos
  "All 69 possible winning combinations."
  (let [rows (for [y (range 6), j (range 4)]
               (for [i (range 4)]
                 [y (+ i j)]))
        columns (for [x (range 7), j (range 3)]
                  (for [i (range 4)]
                    [(+ i j) x]))
        diagonals (concat
                   ; descending diagonals \
                   (get-diags (partial mapv inc)
                              (for [y (range 3), x (range 4)]
                                [y x]))
                   ; ascending diagonals /
                   (get-diags (fn [[y x]] [(inc y) (dec x)])
                              (for [y (range 3), x (range 3 7)]
                                [y x])))]
    (concat rows columns diagonals)))

(defn check-board
  "Checks whether the newly inserted coin has won."
  [board coords]
  (let [win-combo
        (first (drop-while (fn [coll]
                             (apply not= (map #(get-in board %) coll)))
                    (filter #(some #{coords} %) win-combos)))]
    (if (empty? win-combo) nil [(get-in board coords) win-combo])))

Line 4-5: Going over each coordinate in start-pos using for and then take the values of 4 subsequent calls of the given step-fn function.

Line 9-14: Using list comprehensions to generate the 24 row and 21 column combinations and binding them to variables (rows and cols) using let.

Line 15-23: concatenate the result of applying our function get-diags on the starting positions of  the diagonals and giving each a special step-fn function:

Line 17: Mapping calls to inc on both variables in [y,x] and return a vector (therefore mapv). partial because we don't supply the collection, on which this mapping shall happen, yet.

Line 21: Creating a function which takes [y,x] coordinates and increments y and decrements x.

Line 24: concatenate all those vectors into one single vector.

Line 30-32: filter out all the winning combinations which contain the given coords (by using some). drop-while returns the first winning combination which is false for the condition function: apply not= on the value of the coordinates in the board (obtaining them with get-in). So if they all have the same value (e.g. "X"), this returns false and drop-while drops that combination.

Line 33: Return nil (instead of an empty lazy sequence) if win-combo is empty?. Otherwhise return the symbol of the winning player and the win-combo.

Algorithm 2: Bitboard

This is a Clojure implementation of the algorithm used in The Fhourstones Benchmark by John Tromp.

Figure 2: Bitboard representation

Since this solution implies adding a bitboard for each player, we have to change the utility functions and definitions to support this new representation. We'll use the vector board for game state and longs for the boards of the players.

If a player inserts a piece into a column, the first free bit of that column (see Figure 2; also note how the y/x axis swapped) inside the long will be set to 1 (all cells default to 0 of course). For example, if player one starts with inserting his first piece in the fourth column, the bit 21 on his bitboard is set to 1.

It's also important for the bit-shifting later on that the bits at 6, 13, 20, 27, 34, 41 and >=48 are always 0 (the board is therefore surrounded by 0s).

(def empty-board 
  "Create vector board of 6x7 for game state and
   empty bitboards for each player (just 0s)."
  [(vec (repeat 6 (vec (repeat 7 (player 0))))), 0, 0])

(defn bit-insert
  "Sets the bit of the given bitboard at position (y, x)."
  [bitboard y x]
  (bit-set bitboard (+ (* x 7) y)))

; Thanks to John for simplifying this one
(defn insert
  "Inserts symbol for given player (either 1 or 2) at specified x
  and sets according bit on his bitboard."
  [boards x player-num]
  (let [y (get-y (boards 0) x)
        vec-board (assoc-in (boards 0) [y x] (player player-num))
        bitboard1 (if (= player-num 1)
                    (bit-insert (boards 1) (- 5 y) x)
                    (boards 1))
        bitboard2 (if (= player-num 2)
                    (bit-insert (boards 2) (- 5 y) x)
                    (boards 2))]
        [vec-board bitboard1 bitboard2]))

(defn bit-print-board
  [bitboard sym]
  (println [1 2 3 4 5 6 7])
  (doseq [bit-row (for [y (range 5 -1 -1)]
                    (for [x (range 0 43 7)]
                      (+ x y)))]
    (println (mapv #(if (bit-test bitboard %) sym "-") bit-row))))

(defn print-boards
  "Print the vector and both bitboards."
  [boards]
  (println [1 2 3 4 5 6 7])
  (doseq [row board] (println row))       (println)
  (bit-print-board (boards 1) (player 1)) (println)
  (bit-print-board (boards 2) (player 2)) (println))

Line 9: Adjust given [y x] coordinates to the bitboard representation (Figure 2) and bit-set that bit on the bitboard.

Line 18-24: Check for each bitboard whether it has to be changed or simply returned unmodified. Change is achieved through our bit-insert. At the end just return all three boards in a vector.

Line 32: mapping a function which either printlns the given symbol or "-", depening on whether the bit is set (bit-test).

Line 29-31: List comprehension calculating all bit numbers of the bitboard (see Figure 2).

Now the actual checking, which is a bit more complex. Here is the code and the explanation is below it:

(defn bit-check
  [c x]
  (bit-and c (bit-shift-right c x)))

(defn check-board
  "Checks whether given bitboard has won."
  [bitboard]
  (let [positions [6 7 8 1]
        coords (mapv (partial bit-check bitboard) positions)]
    (apply bit-or (map bit-check coords (map #(* 2 %) positions)))))

I'll try to explain this algorithm by the aid of an example where a row is a winning combination. The bitboard looks like this:

[0 0 0 0 0 0 0]
[0 0 0 0 0 1 0]
[1 0 1 0 0 0 0]
[0 1 0 0 0 1 0]
[1 1 0 1 1 1 1]
[0 1 1 0 1 0 0]

The number representing this board is 9552816915338. Let's see what those bit-operations actually do.

First step:

(bit-and bitboard (bit-shift-right bitboard 7)

[0 0 0 0 0 0 0]   [0 0 0 0 0 0 0]   [0 0 0 0 0 0 0]
[0 0 0 0 0 1 0]   [0 0 0 0 1 0 0]   [0 0 0 0 0 0 0]
[1 0 1 0 0 0 0] & [0 1 0 0 0 0 0] = [0 0 0 0 0 0 0]
[0 1 0 0 0 1 0]   [1 0 0 0 1 0 0]   [0 0 0 0 0 0 0]
[1 1 0 1 1 1 1]   [1 0 1 1 1 1 0]   [1 0 0 1 1 1 0]
[0 1 1 0 1 0 0]   [1 1 0 1 0 0 0]   [0 1 0 0 0 0 0]

Second step:

(bit-and bitboard (bit-shift-right bitboard (* 2 7)))

[0 0 0 0 0 0 0]   [0 0 0 0 0 0 0]   [0 0 0 0 0 0 0]
[0 0 0 0 0 0 0]   [0 0 0 0 0 0 0]   [0 0 0 0 0 0 0]
[0 0 0 0 0 0 0] & [0 0 0 0 0 0 0] = [0 0 0 0 0 0 0]
[0 0 0 0 0 0 0]   [0 0 0 0 0 0 0]   [0 0 0 0 0 0 0]
[1 0 0 1 1 1 0]   [0 1 1 1 0 0 0]   [0 0 0 1 0 0 0]
[0 1 0 0 0 0 0]   [0 0 0 0 0 0 0]   [0 0 0 0 0 0 0]

As you can see the second row, which contains four connected pieces, results into [0 0 0 1 0 0 0] and is therefore the winning combination. All the other rows results into 0.

About the code:

Line 9: Doing the first step for diagonals, column and row.

Line 10: Joining together the result of the second step for diagonals, column and row with bit-or.

Algorithm 3: Logic

Figure 3: Board indices for logic solution

The idea here is to create indices for each cell that is owned by a player. The indices are in the form [y,x] => 10*y + x. Therefore: [2,3] => 23. By doing so, I can use core.logic to search for certain patterns within those numbers. There are four patterns which could lead to a victory: A sequence of four numbers where each number is higher by 1 than the number before (row), each number is higher by 10 (column), each number is higher by 11 (descending diagonal) or each number is higher by 9 (ascending diagonal).

(ns check-board-logic
  (:require [clojure.core.logic :as l]))

(defn diff-pattern
  "Declares that each lvar is higher by diff to the previous lvar."
  [lvars diff]
  (l/everyg (fn [[i j]] (l/+fd j diff i))
            (partition 2 1 lvars)))

(defn check-board
  "Checks whether player with the given symbol has won."
  [board sym]
  (let [indices (mapv (fn [[y x]] (+ (* y 10) x))
                      (filter #(= (get-in board %) sym)
                        (for [y (range 6), x (range 7)] [y x])))]
    (l/run 1 [a b c d diff]
      (l/infd a b c d (apply l/domain indices))
      (l/infd diff (l/domain 1 10 11 9))
      (diff-pattern [a b c d] diff))))

Line 1-2: Creating own namespace since we have to :require clojure.core.logic. Functions from within core.logic can then be accessed with l/function.

Line 7-8: everyg ensures that the given goal succeeds on all elements of the given collection. The goal is that each given pair of logic variables has a difference of diff between them. This is ensured by +fd stating that j equals to adding diff to i. The collection is the partition of the given lvars to be pairs of subsequent logic variables.

Line 13-15: filter the whole board for only those cells matching the given symbol. mapv the function which transforms the coordinates to indices (as described before) over all the cells owned by the player.

Line 16: run a core.logic solution search with 5 logic variables. At this point, the logic variables don't hold a value. Later on they can be everything or nothing - they just have to fit the goals we use.

Line 17: Rule describing that each logic variable (a, b, c and d) can only hold the value of one number inside indices. infd therefore assigns the given logic variables the domain containing the numbers of indices.

Line 18: Making sure that the logic variable diff holds the value of the difference for one possible pattern.

Line 19: Stating that the sequence of logic variables [a b c d] has the difference diff between each subsequent element.

core.logic now tries to give [a b c d] and diff values which satisfy all the goals. If there is a winner, it responds with the pattern inside of those numbers.

Performance

I'm not doing a lot of benchmarking in general, but I'll use those different algorithms on a few different boards so you get a vague feeling about their performance. We will create a function insert-pieces which takes a check-board function and a collection of [x, player-num] pairs.

(defn insert-pieces
  [check-board-fn xs-and-nums]
  (check-board-fn (reduce (fn [board [x player-num]]
                            (insert board x player-num))
                          empty-board xs-and-nums)))

; some [x player-num]s for testing:
(def test-row  [[0 1] [0 2] [1 1] [1 2] [2 1] [2 2] [3 1]])

(def test-col  [[1 1] [2 2] [1 1] [2 2] [1 1] [2 2] [1 1]])

(def test-desc [[4 1] [3 2] [3 1] [4 2] [2 1] [4 2] [3 1]
                [2 2] [2 1] [1 2] [1 1] [1 2] [1 1]])

(def test-asc  [[3 1] [4 2] [4 1] [5 2] [5 1] [6 2]
                [5 1] [6 2] [6 1] [0 2] [6 1]])
;;; usage:
; algorithm 1: win-combos
(insert-pieces #(time (check-board % [y x])) ; [y x] coordinates of newest piece
               test-*)

; algorithm 2: bitboard
(insert-pieces #(time (bit-check-board (% 1)))
               test-*)

; algorithm 3: logic
(insert-pieces #(time (check-board % "X"))
               test-*)

Execution times for test-row: ;;; test-row ; algorithm 1: win-combos "Elapsed time: 0.084578 msecs" [" " ([2 0] [2 1] [2 2] [2 3])] ; algorithm 2: bitboard "Elapsed time: 0.045677 msecs" 1 ; algorithm 3: logic "Elapsed time: 0.651759 msecs" ([53 52 51 50 1])

Board for test-row: [1 2 3 4 5 6 7] [ ] [ ] [ ] [ ] [O O O ] [X X X X ]

Execution times for test-col: ;;; test-col ; algorithm 1: win-combos "Elapsed time: 0.122432 msecs" ["X" ([2 1] [3 1] [4 1] [5 1])] ; algorithm 2: bitboard "Elapsed time: 0.051683 msecs" 128 ; algorithm 3: logic "Elapsed time: 0.948235 msecs" ([51 41 31 21 10])

Board for test-col: [1 2 3 4 5 6 7] [ ] [ ] [ X ] [ X O ] [ X O ] [ X O ]

Execution times for test-desc: ;;; test-desc ; algorithm 1: win-combos "Elapsed time: 0.188921 msecs" ["X" ([2 1] [3 2] [4 3] [5 4])] ; algorithm 2: bitboard "Elapsed time: 0.051543 msecs" 1024 ; algorithm 3: logic "Elapsed time: 1.18807 msecs" ([54 43 32 21 11])

Board for test-desc: [1 2 3 4 5 6 7] [ ] [ ] [ X ] [ O X X O ] [ X O X O ] [ O X O X ]

Execution times for test-asc: ;;; test-asc ; algorithm 1: win-combos "Elapsed time: 0.174882 msecs" ["X" ([2 6] [3 5] [4 4] [5 3])] ; algorithm 2: bitboard "Elapsed time: 0.050844 msecs" 2097152 ; algorithm 3: logic "Elapsed time: 1.028203 msecs" ([53 44 35 26 9])

Board for test-asc: [1 2 3 4 5 6 7] [ ] [ ] [ X] [ X X] [ X X O] [O X O O O]

As you can see, the bitboard solution is the fastest and has a rather constant time of about ~0.05 msecs, because it's always checking the whole board.

The win-combo algorithm is the second fastest and it mostly depends on the coordinates of the newly inserted piece, since this determines how many checks it has to do.

The slowest, but still fairly fast, logic solution depends on how many pieces have already been inserted into the board, because it searches over all those coordinates for a pattern.

Conclusion

First, I want to thank the guys in #clojure on Freenode who helped me quite a bit. Clojure has such a friendly and patient community.

In the next post I'll hopefully write about the different AI's I have implemented as opponents for this game, but this might take quite some time since I have to read a lot of stuff about AI first. That's also the reason why I'm not sure which algorithm I'll use for checking the board (I'd like to use the same for everything).

In the meantime, feel free to add me on Google+, write me an email (see G+ profile) if you have any questions, read my other posts and comment below or discuss this article here:

• Reddit: r/coding
• HackerNews