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

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