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

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.


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.


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

Tags:

Algorithm

Haskell

Monads

Recent Posts