Tic-tac-toe maps with diagrams

Inspired by Randall Munroe, here are some handy guides to optimal tic-tac-toe play, created with the diagrams EDSL. Click the images to open (zoomable) PDF versions.

I hacked this up in just a few hours. How did I do it? First, some code for solving tic-tac-toe (no graphics involved here, just game trees and minimax search):

> {-# LANGUAGE PatternGuards, ViewPatterns #-}
> 
> module Solve where
> 
> import Data.Array
> import Data.Tree
> import Data.Function (on)
> import Data.List (groupBy, maximumBy)
> import Data.Maybe (isNothing, isJust)
> import Data.Monoid
> import Control.Applicative (liftA2)
> import Control.Arrow ((&&&))
> import Control.Monad (guard)
> 
> data Player = X | O
>   deriving (Show, Eq, Ord)
> 
> next X = O
> next O = X
> 
> data Result = Win Player Int [Loc] -- ^ This player can win in n moves
>             | Cats                 -- ^ Tie game
>   deriving (Show, Eq)
> 
> compareResultsFor :: Player -> (Result -> Result -> Ordering)
> compareResultsFor X = compare `on` resultToScore
>     where resultToScore (Win X n _) = (1/(1+fromIntegral n))
>           resultToScore Cats        = 0
>           resultToScore (Win O n _) = (-1/(1+fromIntegral n))
> compareResultsFor O = flip (compareResultsFor X)
> 
> type Loc = (Int,Int)
> type Board = Array Loc (Maybe Player)
> 
> emptyBoard :: Board
> emptyBoard = listArray ((0,0), (2,2)) (repeat Nothing)
> 
> showBoard :: Board -> String
> showBoard = unlines . map showRow . groupBy ((==) `on` (fst . fst)) . assocs
>   where showRow = concatMap (showPiece . snd)
>         showPiece Nothing  = " "
>         showPiece (Just p) = show p
> 
> data Move = Move Player Loc
>   deriving Show
> 
> makeMove :: Move -> Board -> Board
> makeMove (Move p l) b = b // [(l, Just p)]
> 
> data Game = Game Board           -- ^ The current board state.
>                  Player          -- ^ Whose turn is it?
>                  [Move]          -- ^ The list of moves so far (most
>                                  --   recent first).
>   deriving Show
> 
> initialGame = Game emptyBoard X []
> 
> -- | The full game tree for tic-tac-toe.
> gameTree :: Tree Game
> gameTree = unfoldTree (id &&& genMoves) initialGame
> 
> -- | Generate all possible successor games from the given game.
> genMoves :: Game -> [Game]
> genMoves (Game board player moves) = newGames
>   where validLocs = map fst . filter (isNothing . snd) . assocs $ board
>         newGames  = [Game (makeMove m board) (next player) (m:moves)
>                       | p <- validLocs
>                       , let m = Move player p
>                     ]
> 
> -- | Simple fold for Trees.  The Data.Tree module does not provide
> --   this.
> foldTree :: (a -> [b] -> b) -> Tree a -> b
> foldTree f (Node a ts) = f a (map (foldTree f) ts)
> 
> -- | Solve the game for player @p@: prune all but the optimal moves
> --   for player @p@, and annotate each game with its result (given
> --   best play).
> solveFor :: Player -> Tree Game -> Tree (Game, Result)
> solveFor p = foldTree (solveStep p)
> 
> -- | Given a game and its continuations (including their results),
> --   solve the game for player p.  If it is player p's turn, prune all
> --   continuations except the optimal one for p. Otherwise, leave all
> --   continuations.  The result of this game is the result of the
> --   optimal choice if it is p's turn, otherwise the worst possible
> --   outcome for p.
> solveStep :: Player -> Game -> [Tree (Game, Result)] -> Tree (Game, Result)
> solveStep p g@(Game brd curPlayer moves) conts
>   | Just res <- gameOver g = Node (g, res) []
> 
>   | curPlayer == p = let c   = bestContFor p conts
>                          res = inc . snd . rootLabel $ c
>                      in  Node (g, res) [c]
>   | otherwise      = Node (g, bestResultFor (next p) conts) conts
> 
> bestContFor :: Player -> [Tree (Game, Result)] -> Tree (Game, Result)
> bestContFor p = maximumBy (compareResultsFor p `on` (snd . rootLabel))
> 
> bestResultFor :: Player -> [Tree (Game, Result)] -> Result
> bestResultFor p = inc . snd . rootLabel . bestContFor p
> 
> inc :: Result -> Result
> inc (Win p n ls) = Win p (n+1) ls
> inc Cats         = Cats
> 
> -- | Check whether the game is over, returning the result if it is.
> gameOver :: Game -> Maybe Result
> gameOver (Game board _ _)
>   = getFirst $ mconcat (map (checkWin board) threes) `mappend` checkCats board
> 
> checkWin :: Board -> [Loc] -> First Result
> checkWin board = First
>                . (>>= winAsResult)      -- Maybe Result
>                . mapM strength          -- Maybe [(Loc, Player)]
>                . map (id &&& (board!))  -- [(Loc, Maybe Player)]
> 
> winAsResult :: [(Loc, Player)] -> Maybe Result
> winAsResult (unzip -> (ls,ps))
>   | Just p <- allEqual ps = Just (Win p 0 ls)
> winAsResult _ = Nothing
> 
> checkCats :: Board -> First Result
> checkCats b | all isJust (elems b) = First (Just Cats)
>             | otherwise            = First Nothing
> 
> allEqual :: Eq a => [a] -> Maybe a
> allEqual = foldr1 combine . map Just
>   where combine (Just x) (Just y) | x == y = Just x
>                                   | otherwise = Nothing
>         combine Nothing _         = Nothing
>         combine _ Nothing         = Nothing
> 
> strength :: Functor f => (a, f b) -> f (a,b)
> strength (a, f) = fmap ((,) a) f
> 
> threes :: [[Loc]]
> threes = rows ++ cols ++ diags
>   where rows     = [ [ (r,c) | c <- [0..2] ] | r <- [0..2] ]
>         cols     = [ [ (r,c) | r <- [0..2] ] | c <- [0..2] ]
>         diags    = [ [ (i,i) | i <- [0..2] ]
>                    , [ (i,2-i) | i <- [0..2] ]
>                    ]

Once we have a solved game tree, we can use it to generate a graphical map as follows.

> {-# LANGUAGE NoMonomorphismRestriction #-}
> 
> -- Maps of optimal tic-tac-toe play, inspired by similar maps created
> -- by Randall Munroe, http://xkcd.com/832/
> 
> import Diagrams.Prelude hiding (Result)
> import Diagrams.Backend.Cairo.CmdLine
> 
> import Data.List.Split (chunk)                   -- cabal install split
> import Data.Maybe (fromMaybe, catMaybes)
> import qualified Data.Map as M
> import Data.Tree
> import Control.Arrow (second, (&&&), (***))
> import Data.Array (assocs)
> 
> import Solve
> 
> type D = Diagram Cairo R2
> 
> x, o :: D
> x = (stroke $ fromVertices [P (-1,1), P (1,-1)] <> fromVertices [P (1,1), P (-1,-1)])
>   # lw 0.05
>   # lineCap LineCapRound
>   # scale 0.4
>   # freeze
>   # centerXY
> o = circle
>   # lw 0.05
>   # scale 0.4
>   # freeze
> 
> -- | Render a list of lists of diagrams in a grid.
> grid :: Double -> [[D]] -> D
> grid s = centerXY
>        . vcat' with {catMethod = Distrib, sep = s}
>        . map (hcat' with {catMethod = Distrib, sep = s})
> 
> -- | Given a mapping from (r,c) locations (in a 3x3 grid) to diagrams,
> --   render them in a grid, surrounded by a square.
> renderGrid :: M.Map Loc D -> D
> renderGrid g
>   = (grid 1
>   . chunk 3
>   . map (fromMaybe (phantom x) . flip M.lookup g)
>   $ [ (r,c) | r <- [0..2], c <- [0..2] ])
> 
>     `atop`
>     square # lw 0.02 # scale 3 # freeze
> 
> -- | Given a solved game tree, where the first move is being made by
> --   the player for whom the tree is solved, render a map of optimal play.
> renderSolvedP :: Tree (Game, Result) -> D
> renderSolvedP (Node (Game _ p _, _) [])   -- cats game, this player does not
>     = renderPlayer (next p) # scale 3     -- get another move; instead of
>                                           -- recursively rendering this game
>                                           -- just render an X or an O
> renderSolvedP (Node (Game board player1 _, _)
>                     [g'@(Node (Game _ _ (Move _ loc : _), res) conts)])
>     = renderResult res <>    -- Draw a line through a win
>       renderGrid cur   <>    -- Draw the optimal move + current moves
>       renderOtherP g'        -- Recursively render responses to other moves
> 
>   where cur = M.singleton loc (renderPlayer player1 # lc red)  -- the optimal move
>               <> curMoves board                                -- current moves
> 
> renderSolvedP _ = error "renderSolvedP should be called on solved trees only"
> 
> -- | Given a solved game tree, where the first move is being made by the
> --   opponent of the player for whom the tree is solved, render a map of optimal
> --   play.
> renderOtherP :: Tree (Game, Result) -> D
> renderOtherP (Node _ conts)
>     -- just recursively render each game arising from an opponent's move in a grid.
>   = renderGrid . M.fromList . map (getMove &&& (scale (1/3) . renderSolvedP)) $ conts
>   where getMove (Node (Game _ _ (Move _ m : _), _) _) = m
> 
> -- | Extract the current moves from a board.
> curMoves :: Board -> M.Map Loc D
> curMoves = M.fromList . (map . second) renderPlayer . catMaybes . map strength . assocs
> 
> -- | Render a line through a win.
> renderResult :: Result -> D
> renderResult (Win _ 0 ls) = winLine # freeze
>   where winLine :: D
>         winLine = stroke (fromVertices (map (P . conv) ls))
>                           # lw 0.2
>                           # lc blue
>                           # lineCap LineCapRound
>         conv (r,c) = (fromIntegral $ c - 1, fromIntegral $ 1 - r)
> renderResult _ = mempty
> 
> renderPlayer X = x
> renderPlayer O = o
> 
> xMap = renderSolvedP . solveFor X $ gameTree
> oMap = renderOtherP  . solveFor O $ gameTree
> 
> main = defaultMain (pad 1.1 xMap)
>        -- defaultMain (pad 1.1 oMap)
About these ads
This entry was posted in haskell, projects and tagged , , , , . Bookmark the permalink.

12 Responses to Tic-tac-toe maps with diagrams

  1. Yitz says:

    Glad that you were inspired by Randall for this. But just to get the sources right, the original version of the diagrams (AFAIK) are in the book “Winning Ways for your Mathematical Plays” by Berlekamp, Conway, and Guy, first published in 1982.

  2. Tom Rathbone says:

    Very interesting and some neat graphics, I wonder if the representation of the board could be simplified a little, using an isomorphic game for the representation.

    Quoting from wikipedia: “There is a game that is isomorphic to tic-tac-toe, but on the surface appears completely different. Two players in turn say a number between one and nine. A particular number may not be repeated. The game is won by the player who has said three numbers whose sum is 15. Plotting these numbers on a 3×3 magic square shows that the game exactly corresponds with tic-tac-toe, since three numbers will be arranged in a straight line if and only if they total 15. This can be helpful in programming computer adaptations of the game, by assigning the squares of the grid to their corresponding number on the magic square.”

  3. Eric I. says:

    I can’t help but notice that your diagram and that on xkcd propose different optimal strategies. If you as X take a corner, and your opponent takes the center, the next move differs. Your diagram suggests taking a side adjacent to the corner X. xkcd suggests taking the opposite corner from your first corner.

    Which is optimal?

    • Brent says:

      They are both optimal: with best play, both lead to a draw. I suppose you could also try to take into account “which move gives your opponent the most opportunities to make a mistake” but this is rather hard to measure (and it probably depends on your opponent). In some situations there is only one optimal move (e.g. if you must move to block your opponent from winning) but in many other situations there are several equally good moves. It so happens that my program made different choices among equally good moves than Randall did.

      • Eric I. says:

        Although with Randall’s strategy my opponent does seem to have to think two moves ahead for their second move. If on my second move I take the opposite corner, then my opponent must take a non-corner square. If they take a corner square they’re doomed.

        With your strategy the opponent, after taking the middle square on their first move, simply needs to take the square that prevents you from getting the third in a row each time. That’s the extent of their forethought.

        Therefore I think Randall’s is slightly superior as it requires a little more sophistication from the opponent.

        Your thoughts?

        • Brent says:

          That’s true. I suppose we could formalize this by saying that when the best we can do is a draw, we prefer positions in which we remain as many moves away from winning as possible.

          It wouldn’t be too hard to update my solver to take this into account. It would just require storing some extra information along with the Cats constructor — something like whether or not each player has two pieces in a row — and then taking this information into account when selecting the best move at each step.

  4. The game I wrote requires 2 players, no AI or logic was given that the program can play. I am just a student, I still think that you will like it. Here is the link to the game (If you want to call it a game)

    Can I get the link to download your game and play it. I am not understanding the code or the logic from the images. Will you please provide the link to the game?

    • Brent says:

      Hi Tanmay, there is nothing to download, it is not a game you can play, if you run the code it generates the pictures shown above, which show an optimal strategy for playing tic-tac-toe. If it is your turn you pick the largest red symbol, then wait for your opponent to play and zoom into the part of the board where they played, and so on.

  5. So you did not download my game, did not test my program……I thought I will get some inspiration from you. Ok, never mind. I am following your blog. I will keep reading and will keep trying to understand. Where can I get info about you?

  6. Andreas says:

    Hello my friend

    All you have written seem very helpful but I can’t understand in which language is the code written in and if you wrote what you wrote the completed tic-tac-toe decision tree will appear?

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s