This text used to be in a more tutorial-like format, but has been partially rewritten to be more concise. Are you looking for the original version? In that case, click here to download the original posts in Markdown format

Prelude

I’m very certain many of the readers play board games against computer AIs; however, I have not noticed a large level of public awareness about the mechanics of said AIs. It is rather intriguing, since it is actually quite easy to build a simple AI opponent. These AI opponents are not very powerful though; depending on the game, a professional will be able to hold their ground with little effort.

One marked limitation is the ineffectiveness of brute force in some games. Brute force AIs calculate all possible moves starting from a certain position to a certain depth in the game tree (a tree describing the possible turns/changes in the game from a certain point), and then deciding the best course of action. The algorithm I’m going to use is based on that; select the best solution out of a given set. However, in some games the amount of possible different moves from a position is so high that a brute-force AI quickly becomes very inefficient: for instance, in Go the average amount of possible moves per turn is 250 (according to researcher Victor Allis), which quickly leads to a very high amount of possibilities within a very few turns.

Therefore, modern AIs use more effective methods; for example, AlphaGo, the AI that beat the Go master Lee Se-dol used neural networks which enabled it to “learn” from the training games presented to it, and therefore have an effective strategy markedly beyond raw calculation.

On the other hand, the game I’m going to discuss now has the average move per turn count of just 10. And that is..

Haskellversi - Othello AI in Haskell

Screenshot of the product

In this post, I hope to showcase a simple, yet fully functional model of the Othello board game. This model shall also have an AI that one can play against, or put to play against itself, if that’s what one likes :D. For those unaware of the rules of the game, a short description is linked in the further reading list.

Unlike with many games, I decided to select a somewhat more unusual language, Haskell for the job. For those unaware, Haskell is a purely functional programming language markedly different from more “common” languages like Python and Java; casually, this difference could be described as Haskell functions being more alike to mathematical functions. Generally, functions in mathematics can cause no side effects to their environment, and always return the same result with the same input. This is not something one should be scared of though, as the basics are fairly easy to get started with.

Even though I tried to ensure that the code is reasonably simple, straightforward and well-commented, I have to remark that my experience in Haskell isn’t (wasn’t when I wrote this in 2017) nearly as consistent as in several other programming languages (plus that a big part of the code was written quickly during late night) - all comments on improvements are highly welcome. You will also likely get most out of this code when you know some Haskell already. It will be, in particular, useful for setting up the appropriate build environment, as they vary wildly depending on what kind of a Haskell environment you use.

You will need a reasonably modern computer (for GLOSS, an OpenGL based graphics library). The appropriate dependencies should be relatively straightforward to figure out though.

The full source is available also on GitLab

Program and annotations

The entire code fits neatly into one file. I’ll be presenting the file from top to bottom, stopping at appropriate points to provide further context and information for particular segments.

Types

First, we’ll declare appropriate types and structures. These should be fairly self explanatory.

We also utilize a Haskell array library to have a fixed-size board that can be accessed directly using an index; in this case, a tuple containing coordinates. Not all datatypes can be used as an index; they must be instances of a special Ix class, which requires that there is a suitable mapping between a range of objects and integers.

{-#LANGUAGE InstanceSigs#-} -- Permit type declarations in instance definitions

module Main where
 -- Fixed-size arrays indexed by an Ix instance
import Data.Array
 -- Haskell doesn't have a NULL type per se, so Maybe can be used to describe a result that may not have a definite value
import Data.Maybe
 -- Folds/recursive combining of some foldable entities (e.g lists, sets) to one
import Data.Foldable
 -- Our graphics library
import Graphics.Gloss
 -- We need access to events, so we use the game mode.
import Graphics.Gloss.Interface.Pure.Game

type UnitScore = Int
type Coordinate = (Int, Int)

-- A player is either a Red or a Blue. Derive default comparison and show
data Player = Red | Blue deriving (Eq, Show)

-- Define the state of each spot on a board; either it is empty, or it may have a player's button placed on it.
data BoardPosition = Empty | Placed Player deriving (Eq, Show)

-- Define a simple model for a board; an array indexed by 2-dimensional coordinates and containing board positions.
data Board = Board {
    boardGrid :: Array Coordinate (BoardPosition) -- Implicitly create a function called 'boardGrid', which extracts the grid array itself from a Board value
}  

Scoring

One particular observation, we use a Minimax style of move determination. As such, we need a way to score states, and for that, we declare a score where we either Win, Lose, or have some Indeterminate score which can be compared

-- Score type for a board score. A board is Win, if it is a certain win for a given player, and Lose if it is a certain loss. If it is neither, it is Indeterminate, with a score denoting its "goodness"
data BoardScore = Win | Indeterminate UnitScore | Lose deriving (Eq, Show)


-- Define a order for a board score. For least complexity, define ordering as a set of comparative properties between different scores
instance Ord BoardScore where
    (<=) :: BoardScore -> BoardScore -> Bool
    (<=) Lose _ = True -- Lose is the smallest and definitely equal
    (<=) (Indeterminate _) Lose = False -- Indeterminate is never less or equal to a win
    (<=) (Indeterminate _) Win = True -- Indeterminate is always less than a win
    (<=) (Indeterminate a) (Indeterminate b) = (a <= b) -- For two indeterminates, their respective ordering depends on their scores
    (<=) Win Win = True -- Win is equal with a win
    (<=) Win _ = False -- Otherwise, no

Moving on, back to types..

-- Grid size
gameGridSize :: Int
gameGridSize = 8

And some baseline constants

-- Starting pieces, where appropriate. First coordinate is X, second Y
startPieces :: (Int, Int) -> BoardPosition
startPieces (3,3) = Placed Red
startPieces (4,4) = Placed Red
startPieces (3,4) = Placed Blue
startPieces (4,3) = Placed Blue
startPieces _ = Empty -- If no other coordinate matches, it is an empty square.

-- Which turns the AI plays? Empty list means humans play both turns. It is also permissible to have the AI play both turns
aiPlays :: [Player]
aiPlays = [Blue]

-- How many turns the AI is approximately allowed to analyze?
-- The time taken for a search should be approximately constant; larger the amount, more turns the AI can take to determine the best option, and therefore more time is spent.
aiSearchDepth = 3000

Basic properties

Looking above, our AI has a predetermined limitation of how much it can search before giving up. This can be adjusted to one’s liking, although it comes with the definite trade-off of moves taking more time with larger search spaces.

Below, we have some basic board property determination functions; count of pieces, who is the current winner if any, piece at some position, etc..

-- Returns a count of pieces on a board - red first, blue second
pieceCount :: Board -> (Int, Int)
pieceCount board = foldr (counter) (0,0) (elems (boardGrid board)) -- Recursively add the score together position by position  
    where
        -- A function to define how the total score changes per position found
        counter :: BoardPosition -> (Int, Int) -> (Int, Int)
        counter pos (red, blue) = case (pos) of
                                    Empty -> (red, blue) -- No change
                                    Placed Red -> (red+1, blue) -- One more for red
                                    Placed Blue -> (red, blue+1) -- One more for blue

-- Calculate the winner using the traditional rules - who has most pieces, wins. If we can not determine one, return Nothing
winningPlayer :: Board -> Maybe Player
winningPlayer board
    | draw = Nothing
    | otherwise = if redCount > blueCount then Just Red else Just Blue
    where
        draw = (blueCount == redCount)
        (redCount, blueCount) = pieceCount board


-- Function that gets a piece from a coordinate
pieceAtCoordinate :: Board -> Coordinate -> BoardPosition
pieceAtCoordinate board coordinate = (boardGrid board) ! coordinate 

-- Function that checks if a given coordinate is within the given board
coordinateInBounds :: Board -> Coordinate -> Bool
coordinateInBounds board coord = inRange (bounds (boardGrid board)) coord

-- Define an initial board
initialBoard = Board (array ((0,0), (gameGridSize-1, gameGridSize-1)) (gridComprehension (\point -> (point, startPieces point))))

-- A helper function for grid comprehension - map some function over the game grid       
gridComprehension :: (Coordinate -> x) -> [x]
gridComprehension func = [(func (a,b)) | a <- [0..gameGridSize-1], b <- [0..gameGridSize-1]]       

-- Definition of the opposing player for a given player
opposingPlayer :: Player -> Player
opposingPlayer Red = Blue
opposingPlayer Blue = Red

Moves

After that, move determination logic

-- Returns a list of pieces that should be changed to the player's color on a board when clicking on some point. If the list is empty, the move is not valid
getMovesOnPoint :: Board -> Player -> Coordinate -> [Coordinate]
getMovesOnPoint board player base_coord
     -- Not a valid base coordinate, invalid
    | isValidBaseCoord == False = []
     -- Not valid, must be an empty location
    | basePiece /= (Empty) = []
     -- No valid directions, no result
    | null (resultingDirections) = []
     -- Include our base coord, and return
    | otherwise = base_coord:resultingDirections
    where
        resultingDirections = concat (map (walkAndMark) directionsToCheck)

        walkAndMark :: Coordinate -> [Coordinate]
        walkAndMark direction = walkAndMarkIntr (baseX+dirX,baseY+dirY) direction [] where
            (dirX,dirY) = direction

        -- Walk and mark - walk in a direction and mark down the found coordinates. If it terminates on a placed piece of the opposing player, return the list. If to our player or empty, nothing
        walkAndMarkIntr :: Coordinate -> Coordinate -> [Coordinate] -> [Coordinate]
        walkAndMarkIntr currentPos direction listOfFound
            -- At the end, do not include the terminating piece
            | isEndPiece = listOfFound
            | isValidTraversalPiece = walkAndMarkIntr (curX+dirX,curY+dirY) direction (currentPos:listOfFound)
            -- Not a valid end piece nor a traversal piece
            | otherwise = [] 
            where
                (curX,curY) = currentPos
                (dirX,dirY) = direction
                isEndPiece = isValidPos && ((pieceAtCoordinate board currentPos) == (Placed player))
                isValidTraversalPiece = isValidPos && ((pieceAtCoordinate board currentPos) == (Placed (opposingPlayer player)))
                isValidPos = (coordinateInBounds board currentPos)
         -- Which relative directions we need to check?
        directionsToCheck = [(-1,-1), (-1,0), (-1,1), (0,-1), (0,1), (1,-1), (1,0), (1,1)]

        (baseX,baseY) = base_coord
        isValidBaseCoord = coordinateInBounds board base_coord
        basePiece = pieceAtCoordinate board base_coord 

-- Returns a list containing lists of coordinates for applying moves. The first item in the list is always the piece clicked
movesAvailableForPlayer :: Board -> Player -> [[Coordinate]]
movesAvailableForPlayer board player = filteredResults -- Return the resulting list as defined below
    where
        filteredResults = filter (\lst -> (null lst) == False) mappedCoords
        mappedCoords = gridComprehension (getMovesOnPoint board player)

-- Determines if no moves are possible at all on a given board
noMovesPossibleAtAll :: Board -> Bool
noMovesPossibleAtAll board = null $ (movesAvailableForPlayer board Red) ++ (movesAvailableForPlayer board Blue)

-- Applies a move; in practice, this means setting the pieces at coordinates given to the player wanted         
applyMove :: Board -> Player -> [Coordinate] -> Board
applyMove board player move_list = Board ((boardGrid board) // (map (\coord -> (coord, Placed player)) move_list))

Take your time digesting all that; the gist is that moves are stored as lists containing coordinates to change, and applying is simply changing all coordinates listed to contain the button of our color. We also need to use a recursive algorithm to “walk” from our starting points, enabling us to determine if there’s any valid move at that point.

AI

Next up, AI

-- Get's the AI's choice of a move
getAIsMove :: Board -> Player -> [Coordinate]
getAIsMove board main_player = case (moves) of
    [] -> []
    _ -> getBestMove moves
    where
        moves = movesAvailableForPlayer board main_player
    
        getBestMove mvs = fst (maximumBy (\a b -> compare (snd a) (snd b)) $ (map (\move -> (move, (getNestedScore (applyMove board main_player move) (opposingPlayer main_player) (aiSearchDepth - (length moves)) False))) mvs))
        -- Calculates a nested score. This is a classic Minimax algorithm for decisionmaking
        getNestedScore :: Board -> Player -> Int -> Bool -> BoardScore
        getNestedScore brd plr depth_allowed maximizing
             -- If this is a game-over scenario, or we are out of moves, the terminal score is a must 
            | gameAtEnd || (futureNestedScore < 0) = terminalScore
             -- If we cannot move forward, change the turn and look from the other party's viewpoint
            | (null currentPlrMoves) = getNestedScore brd (opposingPlayer plr) (futureNestedScore) (not maximizing)
             -- If we want to maximize our score, get the maximum score available
            | maximizing = maximum (Lose:(map (\move -> getNestedScore (applyMove brd plr move) (opposingPlayer plr) (futureNestedScore) (not maximizing)) currentPlrMoves))
             -- On the other hand, if we want the least good score for the player whose score we should minimize, calculate that here
            | otherwise = minimum (Win:(map (\move -> getNestedScore (applyMove brd plr move) (opposingPlayer plr) (futureNestedScore) (not maximizing)) currentPlrMoves))
            where
                futureNestedScore = if (length currentPlrMoves == 0) then (depth_allowed-1) else (depth_allowed - (length currentPlrMoves)) `div` (length currentPlrMoves) -- Innovate - subtract the amount of further turns, and then allocate the rest for nested processing
            
                terminalScore -- Terminal score for our main player; this way, minimization and maximization always have a reasonable result
                     -- Endgame, at this point we know the wins and the losses
                    | gameAtEnd, redCount /= blueCount = if (main_player == Red && (redCount > blueCount)) then Win else Lose
                    | otherwise = Indeterminate ((if (main_player == Red) then 1 else -1) * (redCount-blueCount))
                
                (redCount,blueCount) = pieceCount brd
                
                 -- Is this game at its end? Enforce that 
                gameAtEnd = (null (currentPlrMoves)) && (null (opposingPlrMoves)) && plr == main_player
                -- Moves for both parties
                currentPlrMoves = movesAvailableForPlayer brd plr
                opposingPlrMoves = movesAvailableForPlayer brd (opposingPlayer plr)

That’s the AI in its gist. What that code implements is a slightly optimized Minimax algorithm; it tries to maximize our score, while minimizing the opponents score. If it is not possible to advance any further from some point, a terminal score is calculated, giving a comparable value to the score. Optimization comes in by not having a simple depth criteria, but actually taking account the amount of possibilities per turn, enabling turns with just a few choices to be more thoroughly processed.

UI

Last but not least, UI code. Here, we implement a way to render the current grid state, and apply moves in response to user input to the appropriate places on the screen.

-- The resolution of the window
resolutionX :: Int
resolutionX = 700
resolutionY :: Int
resolutionY = 700

-- As the rendering is from the centre, in what way the coordinates should be translated to return them back to left lower edge-based positioning
centreAdjustmentX :: Int
centreAdjustmentX = -1 * (resolutionX `div` 2)
centreAdjustmentY :: Int
centreAdjustmentY = -1 * (resolutionY `div` 2)

gridAbsoluteLeftX :: Int
gridAbsoluteLeftX = 50 -- From left edge
gridAbsoluteLeftY :: Int
gridAbsoluteLeftY = 100 -- From bottom
gridBoxSize :: Int
gridBoxSize = 45 -- How large a single square is?

circleSize :: Float
 -- Radius of the circle
circleSize = 20

-- From which coordinate the text is rendered, X
textBottomLeftX = 50 
-- From which coordinate the text is rendered, Y 
textBottomLeftY = 100  

{- GUI code starts from here-}
data GameWorld = World {
    gameBoard :: Board, -- Board in this current state?
    playerTurn :: Player, -- Whose turn it is
    passedOnLastTurn :: Bool, -- Was there a pass on the last turn?
    bothStalled :: Bool, -- Has the game stalled, AKA two passes in a row, meaning game over
    ticks :: Float -- Ticks counter to count how long to wait until AI kicks into action
}

-- Initial world contains an initial board state, starting on Red, no passes or stall and starting at zero ticks.
initialWorld = World initialBoard Red False False 0.0 

-- Tries to locate the coordinates the mouse did click. If available, return Just it, otherwise Nothing
getClickTarget :: (Float, Float) -> Maybe Coordinate
getClickTarget (clickX, clickY)
    | dividedX < 0 || dividedX >= gameGridSize = Nothing -- Invalid coordinates
    | dividedY < 0 || dividedY >= gameGridSize = Nothing
    
    | otherwise = Just (dividedX, dividedY)
    
    where
        -- dividedX, dividedY should directly correspond to grid coordinates
        dividedX :: Int
        -- Div is an integer division; Haskell is remarkably strict about types, so we need to explicitly accept the loss of precision associated
        dividedX = (translatedClickX) `div` gridBoxSize 
        dividedY :: Int
        dividedY = (gameGridSize-1) - (translatedClickY `div` gridBoxSize)
        translatedClickX :: Int
        translatedClickX = (round clickX) - centreAdjustmentX - gridAbsoluteLeftX
        translatedClickY :: Int
        translatedClickY = (round clickY) - centreAdjustmentY - gridAbsoluteLeftY

-- Rendering is a bit tricky, as the render is centered to the center of the window and not to the sides! We then need to adjust these down
renderWorld :: GameWorld -> Picture
renderWorld world = Translate (fromIntegral centreAdjustmentX) (fromIntegral centreAdjustmentY) (Pictures (concat [boardRender, gridList, [textRender]])) where

    winningPlayerText :: Maybe Player -> String
    winningPlayerText (Just Red) = "Red wins"
    winningPlayerText (Just Blue) = "Blue wins"
    winningPlayerText Nothing = "Draw"

    textRender = Scale 0.15 0.15 $ (Translate textBottomLeftX textBottomLeftY $ Color white (Text (
                case () of _
                            | noMovesPossibleAtAll (gameBoard world) -> winningPlayerText (winningPlayer (gameBoard world))
                            | null (movesAvailableForPlayer (gameBoard world) (playerTurn world)) -> "No possible positions for you, " ++ (show $ playerTurn world) ++ ", passing"
                            | playerTurn (world) == Blue -> "Turn for Blue"
                            | playerTurn (world) == Red -> "Turn for Red"
                            | otherwise -> ""
                )))


    -- Board state
    boardRender = [Translate (fst $ gridPosForAssoc placedButton) (snd $ gridPosForAssoc placedButton) $ Color (colorForAssoc placedButton) (Circle circleSize) | placedButton <- placedButtons]
        where 
            gridPosForAssoc :: (Coordinate, BoardPosition) -> (Float, Float)
            gridPosForAssoc assoc = (actualX, actualY) where
                 (coordX, coordY) = fst assoc

                 actualX :: Float
                 actualX = fromIntegral $ gridAbsoluteLeftX + ((coordX*gridBoxSize) + (gridBoxSize `div` 2))
                 actualY :: Float
                 actualY = fromIntegral $ gridAbsoluteLeftY + ((((gameGridSize-1)-(coordY))*gridBoxSize) + (gridBoxSize `div` 2))


            colorForAssoc :: (Coordinate, BoardPosition) -> Color
            colorForAssoc assoc = if (snd assoc) == Placed Red then red else blue
            placedButtons = filter (\asc -> snd (asc) /= Empty) (assocs (boardGrid (gameBoard world)))


    -- List comprehension to form the drawings for the grid
    gridDrawingFunction (gridX, gridY) = whiteBox (fromIntegral $ gridAbsoluteLeftX+(gridBoxSize*gridX),fromIntegral $ gridAbsoluteLeftY + (gridBoxSize*gridY)) (fromIntegral $ gridAbsoluteLeftX+(gridBoxSize*(gridX+1)),fromIntegral $ gridAbsoluteLeftY+(gridBoxSize*(gridY+1)))
    gridList = gridComprehension gridDrawingFunction

    -- A helper function for rendering a white box
    whiteBox startPoint endPoint = Color white (Line points) where
        (endX, endY) = endPoint
        (startX, startY) = startPoint
        points = [(startX, startY), (endX, startY), (endX, endY), (startX, endY), (startX, startY)]


handleEvent :: Event -> GameWorld -> GameWorld
handleEvent (EventKey (MouseButton RightButton) Down _ _) _ = initialWorld
handleEvent (EventKey (MouseButton LeftButton) Down _ clickPos) world
    -- Both players have passed, so the game's over
    | bothStalled world = world 
    --  AI plays this turn
    | elem (playerTurn world) (aiPlays) = world
    -- No valid position
    | Nothing <- possibleClickPos = world 
    -- We have a position,  evaluate it
    | Just coordinate <- possibleClickPos = evaluatePlayerTurn world coordinate
    where
        evaluatePlayerTurn :: GameWorld -> Coordinate -> GameWorld
        evaluatePlayerTurn wrld crd
            -- No valid moves
            | null (moveOnPoint) = wrld
            -- Apply a move and change the turn to the opposing player; also reset any pass counters and the ticker
            | otherwise = World (appliedBoard) (opposingPlayer (playerTurn wrld)) False False 0 
            where
                appliedBoard = applyMove (gameBoard wrld) (playerTurn wrld) moveOnPoint
                moveOnPoint = getMovesOnPoint (gameBoard wrld) (playerTurn wrld) crd 
        possibleClickPos = getClickTarget clickPos
-- Rest do not affect the world
handleEvent _ world = world 

timerTick :: Float -> GameWorld -> GameWorld
timerTick tick_diff (World board turn passedOnLast bothStalled curTicks)
    | tick_diff+curTicks < 1.0 = World board turn passedOnLast bothStalled (curTicks+tick_diff)
    | otherwise = evaluateTickTurn 
    where
        evaluateTickTurn = case () of _
                                         -- Both have stalled, do not do anything
                                        | bothStalled -> tickResetWorld
                                         -- Pass, unable to make a turn
                                        | null (movesAvailableForPlayer board turn) -> World board (opposingPlayer turn) True (passedOnLast) 0
                                         -- AI does not play this turn
                                        | notElem turn (aiPlays) -> tickResetWorld
                                        | otherwise -> World (applyMove board turn possibleAIturn) (opposingPlayer turn) False False 0
        
        -- No changes apart from the ticks resetting on tickResetWorld
        tickResetWorld = World board turn passedOnLast bothStalled 0
        possibleAIturn = getAIsMove board turn

main = play -- This program is a GLOSS game..
        (InWindow "Haskellversi" (resolutionX,resolutionY) (20,20)) -- In a window of a suitable size
         black -- With a black background
         24 -- 24fps
         initialWorld -- Initial state
         renderWorld -- Render images using renderWorld
         handleEvent -- Handle events using handleEvent
         timerTick -- Timer effects via timerTick..

That’s just about it. May seem complicated at first, but once you study it, I hope it should become easier to understand - at least for me, the creator, it did :)

What one should have got out of this?

I think this set of posts demonstrates one of the more interesting aspects of Haskell; for games which are highly deterministic, Haskell can very nicely express the logic required to alter the state in a concise form. While UI rendering could certainly be less messy, the core game logic (in my opinion) is still very straightforward and expressed well in Haskell. The AI is also reasonably fast, being able to analyze a fair depth even using the simplest of methods.

Also, you now have a perfectly functional game whose internals you can study and alter at will to your interests :)

Possible improvements and modifications

  • Improved AI; the one presented here, as I stated, is one of the simplest possible. There could be marked improvements using alpha-beta pruning, which does more analysis to see if a branch is worth investigating. There’s also the possibility of making a more advanced library with strategies and opening sets.. but that’s beyond the scope of this text.
  • Improved user interface - the one here is markedly simple, and should be fairly easy to replace, considering the whole game itself is constructed using pure functions, not requiring IO monads.
  • Randomness: as someone with a keen eye must have certainly noticed, there’s absolutely no randomness whatsoever in the AI. Adding such randomness would require either using IO, or carrying a RNG state through functions; both undesirable for this post due to the desire for simplicity.
  • A novel way to play the game: you now have a 2D interface. Haskell has plenty of libraries - perhaps you can, say, invent a HTTP service for playing Othello with you? Doesn’t even necessarily require JavaScript, if you render static pages for each board state.
  • Comedic changes: during testing, I once changed the AI so that it plays as poorly as possible. Try to do the same - it is easier than you may think ;)

The End

Again, thank for your interest - I hope this was as interesting to follow for you as it was to make for me. Be sure to comment!

The canonical version with the full source is available on GitLab

Further reading