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!
(read “9 factorial”) = 362,880 ways to fill the board. In actuality, tic-tac-toe players fill in each of the nine entries with one of only three values: an X, an O, or leave it blank. That's a total of 3*3*3*3*3*3*3*3*3 = 3^9 = 19,683 different ways the 3x3 grid can be filled in.
Players alternate placing Xs and Os on the board until either one player has three in a row, horizontally, vertically, or diagonally. If a player is able to draw five of their Xs or three of their Os in a row, then that player wins.
3D Tic-tac-toe Winning can include: four in a straight line, four in a diagonal line, four in a diamond, or four to make a square. Another variant, Qubic, is played on a 4×4×4 board; it was solved by Oren Patashnik in 1980 (the first player can force a win).
When you're the first one up, there is a simple strategy on how to win tic tac toe: put your 'X' in any corner. This move will pretty much send you to the winner's circle every time, so long as your opponent doesn't put their first 'O' in the center box.
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:
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
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With