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.
{-|
m,n,k-game implementation in Haskell.
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)
import Text.Read (readMaybe)
data Player = X | O
deriving (Show, Read, Eq)
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
deriving (Show, Read, Eq)
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
putStrLn $ show
by just replacing it withprint
. \$\endgroup\$