# m,n,k-game (i.e. generalized tic-tac-toe)

I'm back after Tic-Tac-Toe in Haskell with a new version.

I added Haddock documentation and wrote a generalized version known as the m,n,k-game. By doing so, I had to redefine Game and getSeqs. getSeqs as of now contains two annoyingly-long list comprehensions which I'd like to get rid of.

I tried to integrate gameState into Game so that the client won't need to check the game state all the time. However, this makes move rather messy.

Also, I wrote a test client for it (under the main function). I wrote the startGame function which seems extremely long. Is there a way to simplify it?

I'd appreciate any other comments on this code.

{-|
Two players take turns in placing a stone of their color on an m×n board,
the winner being the player who first gets k stones of their own color in a
row, horizontally, vertically, or diagonally.

For example, tic-tac-toe is a 3,3,3-game and gomuku is a 19,19,5-game.
-}

module MNKGame (
newGame,
move,
moves
) where

import Control.Lens (set, ix)
import Data.List (tails, transpose)
import Data.Maybe (catMaybes)

data Player = X | O

type Marking = Maybe Player
newtype Grid = Grid [[Marking]]

instance Show Grid where
show (Grid grid) = (unlines . map showRow) grid
where showRow = unwords . map showMarking
showMarking (Nothing) = "_"
showMarking (Just a) = show a

data GameState = Won Player | Draw | Running

data Game = Game {
grid :: Grid,
m :: Int,
n :: Int,
k :: Int,
curTurn :: Player,
gameState :: GameState
} deriving Show

-- Basic Definitions

nextPlayer :: Player -> Player
nextPlayer X = O
nextPlayer O = X

emptyGrid :: Int -- ^ number of rows
-> Int -- ^ number of cols
-> Grid
emptyGrid m n = Grid $replicate m$ replicate n Nothing

chop :: Int -> [a] -> [[a]]
chop k xs = [take k ys | ys <- zipWith const (tails xs) (drop (k - 1) xs)]

-- |The 'getSeqs' function returns a list of sequences.
-- A sequence is a row, column or diagonal.
-- This utility function returns all sequences.
getSeqs :: Grid
-> Int -- ^ number of rows
-> Int -- ^ number of cols
-> Int -- ^ number of marks in a row to win
-> [[Marking]] -- ^ list of sequences
getSeqs (Grid marks) m n k =
rows ++ cols ++ fDiags ++ bDiags
where
rows = concatMap (chop k) marks
cols = concatMap (chop k) $transpose marks fDiags = [[marks !! p !! q | (p, q) <- zip [i .. i + k - 1] [j .. j + k - 1]] | i <- [0 .. m - k], j <- [0 .. n - k]] bDiags = [[marks !! p !! q | (p, q) <- zip [i, i - 1 .. i - k] [j .. j + k - 1]] | i <- [k - 1 .. m - 1], j <- [0 .. n - k]] -- |Returns the current game state of a game. getGameState :: Grid -> Int -- ^ number of rows -> Int -- ^ number of cols -> Int -- ^ number of marks in a row to win -> GameState getGameState grid@(Grid marks) m n k | isWin X = Won X | isWin O = Won O | isDraw = Draw | otherwise = Running where isWin player = any (all (== Just player))$ getSeqs grid m n k
isDraw = all (notElem Nothing) marks

-- |Creates a new m,n,k-game.
newGame :: Int -- ^ number of rows
-> Int -- ^ number of cols
-> Int -- ^ number of marks in a row to win
-> Game -- ^ Game data type
newGame m n k = Game {
grid = emptyGrid m n,
m = m,
n = n,
k = k,
curTurn = X,
gameState = Running
}

-- |The move function makes a move given the row and column index.
-- It returns 'Nothing' if the move is invalid.
-- Otherwise, it returns the new game.
move :: Int -- ^ row index
-> Int -- ^ column index
-> Game
-> Maybe Game
move i j (Game (Grid grid) m n k player gameState)
| gameState == Draw = Nothing
| gameState == Won X || gameState == Won O = Nothing
| validCoord i j = case grid !! i !! j of
Just _ -> Nothing
Nothing -> let newGrid = Grid $set (ix i . ix j) (Just player) grid in Just Game { grid = newGrid, m = m, n = n, k = k, curTurn = nextPlayer player, gameState = getGameState newGrid m n k } | otherwise = Nothing where validCoord i j = i >= 0 && j >= 0 && i < m && j < n -- |Returns all possible moves from a game. moves :: Game -> [Game] moves game@(Game _ m n _ _ _) = catMaybes [move x y game | x <- [0 .. m - 1], y <- [0 .. n - 1]] -- Testing Client -- |This client is a 2-player version of Tic-Tac-Toe. main :: IO () main = do putStrLn "Make a move by typing (i, j). i represents the row and j represents the column." let game = newGame 3 3 3 putStrLn$ show $grid game startGame game startGame :: Game -> IO () startGame game = do line <- getLine case readMaybe line :: Maybe (Int, Int) of Just (i, j) -> case move i j game of Just newGame -> do putStrLn$ show $grid newGame case gameState newGame of Won a -> putStrLn$ "Player " ++ show a ++ " won!"
Draw -> putStrLn "It's a draw!"
Running -> startGame newGame
Nothing -> do
putStrLn "Invalid move. Please input a valid move."
startGame game
Nothing -> do
putStrLn "Invalid move. Please input a valid move."
startGame game

• Ah, generalization to MNK style! Now we're talking. You might want to implement Ultimate Tic-Tac-Toe next. May 8, 2015 at 19:00
• @SimonAndréForsberg That looks interesting, but I think I'll stop here. I have a couple of other plans which I need to start on. :) May 9, 2015 at 12:16
• Not worth a seperate answer I guess, but you can simplify putStrLn $show by just replacing it with print. May 27, 2015 at 0:26 ## 1 Answer This is pretty slick. You might want to add definitions and exports for tictactoe = newgame 3 3 3 and gomuku = newgame 19 19 5 for convenience. The parentheses around Nothing in the local definition of showMarking for the Show Grid instance are unnecessary. You could also implement or replace showMarking with maybe "_" show. Why pattern match when you've got a handy higher order function? Definitely add a comment to explain chop, it took me a moment to realize what it's doing (it's certainly very clever!). Cleaning up getSeqs is a very interesting problem. The easiest portion is realizing that the back diagonals can be found by the same exact process as the forward diagonals if you just transform your matrix with map reverse. The next key step is realizing that if we can generate the full length (as opposed to k-length) diagonals, we can use chop again. -- Find the main diagonal (↘) of a matrix diagonal :: [[a]] -> [a] diagonal [] = [] diagonal ((x:_):rows) = x : diagonal (map tail rows) -- 𝕄_0,0 : ↘ 𝕄(m-1 × n-1) -- Find all ↘ diagonals of a matrix diagonals :: [[a]] -> [[a]] diagonals m = map diagonal (init . tails$          m)  -- 𝚺(i=m  ,1) ↘ 𝕄(i×n)
++ tail (map diagonal (init . tails $tranpose m)) -- 𝚺(j=n-1,1) ↘ 𝕄(m×j) -- Thus (code fragment): fdiag = concatMap (chop k)$ diagonals marks
bdiag = concatMap (chop k) $diagonals (map reverse marks)  Don't use guards where pattern matching will do. move i j (Game (Grid grid) m n k player Running) | validCoord i j = -- ... | otherwise = Nothing move _ _ _ = Nothing  I'm not sure that there are appreciable improvements left to make to move. You could use RecordWildCards and NamedFieldPuns, maybe record update notation, but I don't find it that bad to begin with. Use even more do-notation in startGame to unify the Maybe handling, and extract the commonalities. startGame :: Game -> IO () startGame game = do line <- getLine maybe retry next$ do
putStrLn $show$ grid newGame