Connect4 – implementing the representation and core mechanics in F#

In this part of the Connect4-series I want to show you my implementation of the game representation and mechanics. Of course we finally want to use the AlphaBeta-algorithm for it so keep this in mind.

Representation of the game and it’s state

The representation of the board is based on array of columns (as we drop a game-piece in a column this makes sense) and the columns themselves are just an array of cells – each one having the option to contain a game-piece of either White or Black (I finally choose to draw the pieces in Yellow and Red but I like to think of game-pieces in black/white where the human plays white against the black computer).

// Definitions for Board-Positions
type Column = int
type Row = int
type Coordinate = Column * Row

type Player =
    | White
    | Black

/// a cell on the board might be occupied by a players stone (Some ...) or empty (None)
type BoardCell = Player option

/// complete BoardColumn is a array of Cells (one per row)
type BoardColumn = BoardCell array

/// complete BoardState is a array of all it's columns
type BoardState = BoardColumn array

Next is the representation of the game for our search-tree. As I wanted the name GameState to stand for the the current state – i.e. has a player won, is it a draw, … and I didn’t like the sound of GameNode I choose to name these GameSituation (note I included a value Turn, indicating which players has to set a piece in the situation):

/// a game-situation is a boardstate with the current player
type GameSituation = { Board : BoardState; Turn : Player }

/// the current game State
type GameState =
    | StillRunning
    | WhiteWon
    | BlackWon
    | Remis

Finally here are a couple of helper-methods we will use on occasion:

/// some helper functions
module GameSearchSpace =

    /// switch the player
    let nextPlayer (player : Player) =
        match player with
        | White -> Black
        | Black -> White

    /// Player to Ratingtype
    let getLayerRateType (game : GameSituation) =
        match game.Turn with
        | White -> LayerRateType.Max
        | Black -> LayerRateType.Min

    /// create a search-space
    let Create(create, rate) =
        { CreateChildStates = create; RateState = rate }

    /// create a game-node
    let Node (state, turn) = { Board = state; Turn = turn }

    /// create a game-root
    let Root (state) = Node (state, Player.White)

I think the only difficult part is the Create-method – it takes a function that gets a list of moves for a given GameSituation (a list of GameSituation ) and a function to rate a GameSituation and wraps them into a search-space for our algorithm.

Some basic operations on the board

    /// creates a empty board with nrCols-Columns and rowsPerCol-Cells per Column
    let initialize nrCols rowsPerCol : BoardState =
        Array.create nrCols (Array.create rowsPerCol None)

    /// gets the number of columns from a BoardState
    let dimColumns (board : BoardState) : int =
        Array.length board

    /// gets the number of Rows from a BoardState
    let dimRows (board : BoardState) : int =
        Array.length (board.[0])

    /// gets a piece at coordinate from a BoardState
    let getPieceAt (board : BoardState) 1)c,r) : Coordinate) : Player option =
        board..[r]


Lines and higher-order functions on the board
This is a bit more interesting. Of course ...continue
        let vert = [0..nrCols-1] |> List.map (fun c -> (c,0) |> getCoordLine board (0, 1))
        let diag1 = [nrRows-1..-1..0] |> List.map (fun r -> (0,r) |> getCoordLine board (1, 1))
        let diag1' = [1..nrCols-1] |> List.map (fun c -> (c,0) |> getCoordLine board (1, 1))
        let diag2 = [0..nrRows-1] |> List.map (fun r -> (0,r) |> getCoordLine board (1, -1))
        let diag2' = [1..nrCols-1] |> List.map (fun c -> (c,nrRows-1) |> getCoordLine board (1, -1))
        List.concat [ horz; vert; diag1; diag1'; diag2; diag2' ]

The next one will be a bit tricky. It’s a fold doing the following: It will take 4-windows of coordinates out of our lines (4-windows in the sense of (1,2,3,4,5,..) –> ([1,2,3,4], [2,3,4,5],  …) and “fold” a state over it. So we will give a initial state (for example 0.0 for the rating) and a curried function taking the state and a (coordinate/game-piece option) array (the 4-window of the coordinates zipped with the piece at this coordinate on the board) and returning a new state and a flag (true/false) indicating if we should move on with the next 4-window or if the fold just stop. The result of this will be the last produced state. As you see the code is indeed smaller than my pathetic try to explain it (that’s the power/curse of higher-order functions…):

    let foldLine (board : BoardState) (foldFun : 'state -> (Coordinate*Player option)[] -> ('state * bool)) (line : Coordinate list) (initialState : 'state) =
        let windows = line |> Seq.windowed 4 |> Seq.map (Array.map (fun coord -> coord, (getPieceAt board coord))) |> Seq.toList
        let rec fold state ws =
            match ws with
            | []     -> (state, true)
            | w::ws' -> let state',cont = foldFun state w
                        if cont then fold state' ws' else (state', false)
        fold initialState windows

The next one is just the same only taking the hole board instead of a single line (and of course using this foldLine-method):

    let foldBoard (board : BoardState) (foldFun : 'state -> (Coordinate*Player option)[] -> ('state * bool)) (initialState : 'state) =
        let foldL = foldLine board foldFun
        let rec fold acc lines =
            match lines with
            | []        -> acc
            | l::lines' -> let (value, cont) = foldL (Seq.head lines) acc
                           if cont then fold value lines' else value
        board |> getCoordLines |> fold initialState

get a rating for a game-situation

As I already mentioned in the Minimax-article: this is normally the tricky part in creating a strong computer-player. For our simple game we don’t have to know all that much of the strategies – I simply search for 4-windows (yeah the fold above) having only empty cells or cells with pieces of the same color and giving them a value of 1 for two stones of a color (and 2 empty cells), 10 for 3 stones of a color (and 1 empty cell) and a whooping 100,000 if we have a winner (4 stones of a color) – in this last case we can stop the folding!

Please note (this is important): the win-situation must be big enough so that it will be bigger than every conceivable non-win-situation or the algorithm might ignore his win situation or underestimate a players standing.

As it’s important the scoring is for the white player – for the black-player (black pieces) just adjust the numbers by negating them Zwinkerndes Smiley

    let private wonValue = 100000.0

    let rateBoard (forPlayer : Player) (board : BoardState) : float =
        let countPieceTypes pieces =
            let foldCount (plus, minus, neutral) (_, piece) =
                match piece with
                | None                       -> (plus, minus, neutral+1)
                | Some s when s = forPlayer  -> (plus+1, minus, neutral)
                | _                          -> (plus, minus+1, neutral)
            pieces |> Array.fold foldCount (0,0,0)
        let rateWindow acc pieces =
            match countPieceTypes pieces with
            | (2,0,_) -> (acc + 1.0, true)
            | (3,0,_) -> (acc + 10.0, true)
            | (4,0,_) -> (wonValue, false)
            | (0,2,_) -> (acc - 1.0, true)
            | (0,3,_) -> (acc - 10.0, true)
            | (0,4,_) -> (-wonValue, false)
            | _       -> (acc, true)
        foldBoard board rateWindow 0.0

Now it’s easy to decide if we have win-situation (just look for the rating):

    let isWinSituation (board : BoardState) : Player option =
        match rateBoard Player.White board with
        | v when v = wonValue  -> Some Player.White
        | v when v = -wonValue -> Some Player.Black
        | _                    -> None

finding possible moves and execute a move

For of course we just have to find columns containing still empty cells to find all possible moves ( a move being just the same as the column-number where we will drop our stone):

    let getFreeRowPos (board : BoardState) (col : Column) : Row option =
        board.[col] |> Array.tryFindIndex Option.isNone

    let isMovePossible (board : BoardState) (col : Column) : bool =
        col |> getFreeRowPos board |> Option.isSome

    let getPossibleMoves (board : BoardState) : Column list =
        let cols = dimColumns board
        let foldFun acc col =
            match isMovePossible board col with
            | false -> acc
            | true  -> col:: acc
        [0..cols-1] |> List.fold foldFun []

Using this and the isWinSituation from above we can now decide on the game situation:

    let hasGameEnded (board : BoardState) : GameState =
        match board |> isWinSituation with
        | Some Black -> BlackWon
        | Some White -> WhiteWon
        | None       -> if board |> getPossibleMoves |> List.isEmpty
                        then Remis
                        else StillRunning

And make a move to a column:

    let makeMove (game : GameSituation) (col : Column) : GameSituation =
        let insert (row : Row) =
            let cols = dimColumns game.Board
            let rows = dimRows game.Board
            let pieceAt (c, r) = if (c, r) = (col, row) then Some game.Turn else game.Board..[r]
            Array.init cols (fun c -> Array.init rows (fun r -> pieceAt (c,r)))
        match getFreeRowPos game.Board col with
        | None     -> failwith "move impossible"
        | Some row -> GameSearchSpace.Node (insert row, GameSearchSpace.nextPlayer game.Turn)

Finally we put all of this together to create our search space.

We only have to pay attention so that we don’t create further moves when the game has already ended (checking the win-situation):

    let createMoves (game : GameSituation) : GameSituation list =
        if game.Board |> isWinSituation |> Option.isSome then []
        else game.Board |> getPossibleMoves |> List.map (makeMove game)

    let searchSpace  cols rows =
        GameSearchSpace.Create (createMoves, (fun game -> (rateBoard Player.White game.Board)))

That’s it – the last innocent looking method will create a search-space, we can use with our search-algorithms – but more on this in the next post…

References   [ + ]

1. c,r) : Coordinate) : Player option = board..[r]

Lines and higher-order functions on the board

This is a bit more interesting. Of course we will have to decide if there are 4 pieces of a single player in a direct line (horizontal, vertical or in one of the diagonals). On top of that I will rate a board based on the number of possible win configurations (see below) so I need a way to find all those lines and some kind of Fold to use with this.

Let’s do this step-by-step. The first helper is a function that – given a start coordinate and a direction (a pair of integers being the steps in columns/rows, so that for example (1,0) = direction left->right and (1,-1) = left/bottom->right/top) creates a list of coordinates – all on the board – starting from the start coordinate and moving in the given direction:

    let getCoordLine (board : BoardState) (deltaCol : int, deltaRow : int) (start : Coordinate) : Coordinate list =
        let nrCols = dimColumns board
        let nrRows = dimRows board
        let nextPos ((c,r) : Coordinate) = (c + deltaCol, r + deltaRow)
        let inBoard ((c,r) : Coordinate) = 0 <= c && c < nrCols && 0 <= r && r < nrRows
        let rec moveAlong accu pos = if inBoard pos then moveAlong (pos::accu) (nextPos pos) else accu
        start |> moveAlong [] |> List.rev

Note that the inBoard method checks if the position is still on the board and the moveAlong-method creates the coordinate list recursively in a reversed order (because of the accumulator-technique) so we have to reverse it again before handing it back.

Next we need a helper that simply gives us a list of all the possible lines on the board. This just concatenates the various horizontal, vertical and diagonal lines together into a list. Note the way the diagonals are created – as we only need windows of 4-coordinates from a line you could optimize this further (some diagonals here will have only 1,2,3 coordinates) but for clarity’s sake I include those too as it helps us read the code (no strange Range-endpoints) and don’t get to many performance-issues for our goal.

    let getCoordLines (board : BoardState) : Coordinate list list =
        let nrCols = dimColumns board
        let nrRows = dimRows board
        let horz = [0..nrRows-1] |> List.map (fun r -> (0,r) |> getCoordLine board (1, 0