Haskell - how to generate next move in tic tac toe game with list monad

Question

I am implementing a tic tac toe game for n * n board in Haskell and i need to generate all board configurations that i can get from next move.

I have board defined as follows:

data Cell = E
      | X  
      | O 
      deriving (Eq,Show)

type Row a = [a]
type Board = Row (Row Cell)

iniBoard :: Int -> Board
iniBoard n = let row = replicate n E in replicate n row

I can determine, whether given board configuration is winning for player x, so i have

win :: Cell -> Board -> Bool
win E _   = False
win x brd = any full $ diags brd ++ rows brd ++ cols brd
where
    diags brd = mainDiag : [secondDiag]
    mainDiag = zipWith (!!) brd [0..]
    secondDiag = zipWith (!!) revBrd [0..]
    revBrd = do
        xs <- brd
        return (reverse xs)
    rows = id
    cols = transpose
    full xs = all (==x) xs

But i have no idea, how to generate all board configurations that player x can make as next move.

I understand, that i need to traverse all cells and check, if cell is empty, then i can place mark here and return new configuration. If i have already winning configuration, then there is no next move, and i must return empty list

I have a code like this:

nxt :: Cell -> Board -> [Board]
nxt x brd = do
if (win x brd || win (switch x) brd)
    then
        []
    else
        undefined

How can i do it, using list monad? Thanks for help!

Answer 1

with

picks :: [x] -> [([x], x, [x])]
picks [] = []
picks (x : xs) = ([] , x, xs) : [(x : sy, y, ys) | (sy, y, ys) <- picks xs]

(which is a tweaked version of this), all possible next boards are

import Data.List.Split (chunksOf)

next :: Int -> Cell -> Board -> [Board]
next n who b =  
    picks (concat b) >>= \(sy, y, ys) ->
             case y of E -> [chunksOf n $ sy ++ [who] ++ ys] ;
                       _ -> []

where who is one of X or O, or course.

This is nothing more than a filter to keep the empties, and a map over those that have filtered through, at the same time. It is even simpler with list comprehensions,

next n who b = [ chunksOf n $ sy ++ [who] ++ ys
                 | (sy, E, ys) <- picks $ concat b ]

The picks function picks all possible cells, one after another, in the concatenated rows, while preserving also a prefix and a suffix; chunksOf n rebuilds the board from one long row of cells, in chunks of n cells in a row. So the overall effect is a list of all possible boards where E got replaced with who.

More efficient picks would build its prefixes (sy) in reversed order; creating a list of what is known as "zippers". Then on rebuilding they would have to be correspondingly reversed.

edit: as the list comprehension shows, it could've been written with do notation in the first place:

next n who b =  do 
    (sy, E, ys) <- picks $ concat b
    return (chunksOf n $ sy ++ [who] ++ ys])

In do notation a pattern mismatch is translated into a call to fail, which, in list monad, causes an element to be skipped while the computation as a whole continues without failing.

edit2: a Data.List-based code which does it in one pass over the input, is

import Data.List (mapAccumL)

-- mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
next who b = concat . snd $ mapAccumL f (id, drop 1 xs) xs 
  where
    xs = concat b
    n = length b
    f (k,r) x = ( (k.(x:), drop 1 r) , [chunksOf n $ k (who:r) | x==E] ) 

Thanks to גלעד ברקן for the discussion.

Answer 2

If we look at the type signature for >>= we see that it is

(>>=) :: Monad m => m a -> (a -> m b) -> m b

If you want to be able to "chain" your nxt function, the entire type signature for the bind must be:

[Board] -> (Board -> [Board]) -> [Board]

so nxt must have the type Board -> [Board]. Now we must ask ourselves what exactly nxt does: It takes a board and returns all possible moves from the current board. Coincidentially, the type for nxt is exactly what >>= needs: Board -> [Board]. But wait. How do we know whose turn it is? Like you already did, we can pass the current mark to place as parameter, but this also alters the type signature: Cell -> Board -> [Board]. Can we still chain this function? Yes we can. Using partial application, we can already apply the next marker to place by already passing it and then binding the resulting function:

nxt   :: Cell -> Board -> [Board]
nxt X ::         Board -> [Board]

Now all we have to do is traverse every field and check whether it is empty. If it is, then we replace it with our mark and traverse the other fields. :

nxt :: Cell -> Board -> [Board]
nxt _    []         = []
nxt mark (row:rest) = map (:rest) (replaceAll mark row) ++ (map (row:) $ nxt mark rest)
  where
    replaceAll _ [] = []
    replaceAll m (x:xs)
      | x == E = (m:xs) : (map (x:) $ replaceAll m xs)
      | otherwise = map (x:) $ replaceAll m xs

Now you can chain moves like this:

iniState 3 >>= nxt X >>= nxt O

I would advise to separate the simulating function and the actual move finding function for greater usage purposes. For example, like this you could easily write a function which returns all boards which will win for a specific size and a specific player:

winner :: Cell -> Int -> [Board]
winner who size = filter (win who)
                $ foldr (>=>) return (take (n*n) $ cycle [nxt O, nxt X])
                $ initBoard n

I will leave it to you to implement the game playing part as an exercise.

Answer 3

The other answers covered the straightforward solutions. Here I present a lens solution, because it's nicely applicable for the task.

With lens we can separately specify the following two things:

• Which parts of a data structure we want to operate on.
• What operations we'd like to do on those parts.

We'd like to point to the empty cells of the board as targets. Traversal' Board Cell indicates that the overall data structure has type Board, while the targets have type Cell.

import Control.Lens

emptyCells :: Traversal' Board Cell
emptyCells = each . each . filtered (==E)

Now we can do a variety of operations with emptyCells.

board = iniBoard 3

-- get the number of targets:
lengthOf emptyCells board -- 9

-- return a flat list of the targets
toListOf emptyCells board -- [E,E,E,E,E,E,E,E,E]

-- set all targets to a value
set emptyCells X board -- [[X,X,X],[X,X,X],[X,X,X]]

-- set the nth target to a value
set (elementOf emptyCells 2) X board -- [[E,E,X],[E,E,E],[E,E,E]]

-- get the nth target, if it exists
preview (elementOf emptyCells 2) board -- Just E

We can also neatly implement next using emptyCells and the holesOf function. holesOf emptyCells returns a lists of "holes" of the board. Each hole essentially contains a Cell and a function which takes a Cell argument and returns a new Board with the supplied Cell plugged into a certain position.

Unfortunately, the holes are implemented rather abstractly, and holesOf emptyCells has an uninformative Board ->[Control.Lens.Internal.Context.Pretext (->) Cell Cell Board] type. We should just remember that Control.Comonad.Store provides an interface for working with holes. pos returns the focus element of a hole (here it's a Cell), while peek plugs a new element in the hole and returns the resulting data structure.

For nxt x board, we need to plug in x into every position with an empty cell. With this in mind, nxt simply becomes:

import Control.Comonad.Store

nxt :: Cell -> Board -> [Board]
nxt x = map (peek x) . holesOf emptyCells

Answer 4

Here's a version that traverses the board and only adds a possible move when encountering an E:

nxt' :: Cell -> Board -> [Board]
nxt' x brd = do (E,i) <- zip b [0..]
                return (chunksOf l $ (take i b) ++ [x] ++ (drop (i + 1) b))
              where l = length brd
                    b = concat brd