Skip to content

Instantly share code, notes, and snippets.

@jfoot

jfoot/HangMan.lhs Secret

Created May 30, 2020
Embed
What would you like to do?
Advanced Functional Programming Hang Man AI Game
G52AFP Coursework 1 - Connect 4 Game
Jonathan Foot, Ben L
XXX@nottingham.ac.uk, XXX@nottingham.ac.uk
----------------------------------------------------------------------
For flexibility, we define constants for the row and column size of the
board, length of a winning sequence, and search depth for the game tree:
> import Data.List
> import Data.Ord
> import Data.Maybe
> import Text.Read
> rows :: Int
> rows = 7
> cols :: Int
> cols = 6
> win :: Int
> win = 4
> depth :: Int
> depth = 7
The board itself is represented as a list of rows, where each row is
a list of player values, subject to the above row and column sizes:
> type Board = [Row]
>
> type Row = [Player]
In turn, a player value is either a nought, a blank, or a cross, with
a blank representing a position on the board that is not yet occupied:
> data Player = O | B | X
> deriving (Ord, Eq, Show)
Defines a tree data type, which takes in a value of any type and a list of trees of same type a.
This is a recursive data defintion that forms a tree structure.
> data Tree a = Node a [Tree a]
> deriving (Ord, Eq, Show)
>
Main is the entry point of the program, it calls the anonymous function f.
f takes a board, checks if a player has won, if not, the player whose go it is, is given a go,
initially f takes an empty board, but it is recursively called with every subsequent move.
> main :: IO ()
> main = f makeEmpty
> where
> f b = do
> showBoard b
> case isTie b of
> True -> putStrLn "Tie"
> False -> do
> case hasWon (notTurn b) b of
> True -> putStrLn (show (notTurn b) ++ " won!!!")
> False -> do
> case turn b of
> X -> f (bestMove b)
> O -> do
> x <- getLine
> case readMaybe x of
> Nothing -> f b
> Just y -> case move y (turn b) b of
> Nothing -> f b
> Just z -> f z
> showBoard :: Board -> IO ()
> showBoard b = putStrLn (unlines (map showRow b ++ [line] ++ [nums]))
> where
> showRow = map showPlayer
> line = replicate cols '-'
> nums = take cols ['0'..]
This generates all posiable moves that can be taken from a given board, removing
any moves which maybe invalid, such as placing a counter into a row which is already full.
> allMoves :: Board -> [Board]
> allMoves b = catMaybes [(move x (turn b) b) | x <- [0..cols]]
This grows a tree using the "allMoves" function, it will generate all possible
moves from a given board. It will then recursily call the growTree function using a list
comprehension to once again generate all possible moves from the child boards.
> growTree :: Board -> Tree Board
> growTree b = Node b [growTree x | x <- allMoves b]
This will prune the tree to stop it from growing too deep, it will stop growing if it
has reached a predefined depth, or if someone has won the game (ie it's finished).
> prune :: Int -> Tree Board -> Tree Board
> prune x (Node b bs) | (x == 0) = Node b []
> | whoWon b /= B = Node b []
> | otherwise = Node b (map (prune (x-1)) bs)
This will convert the Tree from a Board type to a Tree of Board and Player Tuples, where the board remains
the current state of a board and the player repersents the min-max person suggested to win.
This is acheived by recersivly going through branches until a leaf is reached,
labling that leaf, and propogating the result up the tree.
> labelTree :: Tree Board -> Tree (Board, Player)
> labelTree (Node a []) = Node (a, whoWon a) []
> labelTree (Node a bs) = Node (a, snd (winSelect (turn a) fs)) fs
> where fs = map labelTree bs
Takes in the current player whos go it is, along with a list of trees which have
all possible moves and the person who will win if that branch is taken. It will
then take the Min/Max value in the tuple to dicide which branch to take, by either
taking the miniumum or maxiumum value (as Players is an ordered data type).
> winSelect :: Player -> [Tree (Board, Player)] -> (Board, Player)
> winSelect p ts = (if p == O then
> minimumBy
> else
> maximumBy) (comparing snd) [(y,x) | Node (y,x) _ <- ts]
Takes in the curent board and returns the board where the AI has made its move.
> bestMove :: Board -> Board
> bestMove b = f (labelTree (prune depth (growTree b)))
> where f (Node _ bs) = fst (winSelect (turn b) bs)
> showPlayer :: Player -> Char
> showPlayer O = 'O'
> showPlayer B = '.'
> showPlayer X = 'X'
Create an empty board of dimensions needed.
> makeEmpty :: Board
> makeEmpty = replicate rows (replicate cols B)
Turns takes in a board, counts how many goes each player
has already had and decides whose turn it is.
> turn :: Board -> Player
> turn b | os > xs = X
> | otherwise = O
> where
> os = length (filter (O==) (concat b))
> xs = length (filter (X==) (concat b))
Inverse of turn function.
> notTurn :: Board -> Player
> notTurn = notPlayer.turn
Inverse of player.
> notPlayer :: Player -> Player
> notPlayer B = B
> notPlayer O = X
> notPlayer X = O
Takes in the column index, player and current board and then calculates what the new board should
look like, this bourd will have the inserted player token. It then returns a new maybe
board dependent on whether then move was valid or not. A valid move is one where the
token will fall inside the width and height of the board.
> move :: Int -> Player -> Board -> (Maybe Board)
> move i p b| i >= cols || i < 0 = Nothing
> | head b !! i /= B = Nothing
> | otherwise = Just (transpose ( f i p (getCols b)))
> where f _ _ [] = []
> f 0 z (xs:xss) = ((put z xs):xss)
> f y z (xs:xss) = (xs:(f (y-1) z xss))
Takes the player to be placed and the column which the token will be placed in.
Then inserts the token in the correct location and removes the displaced
blank token which is at the head of the list.
> put :: Player -> [Player] -> [Player]
> put p col = tail (f p col)
> where f p [] = [p]
> f p (B:xs) = (B:(f p xs))
> f p xs = (p:xs)
Takes in a player and the current board and checks if that player has won,
this is done by looking at all rows, columns and diagonals. Only one quater
of the diagonals can be checked at a time, for this reason
four getDiagonal function calls are needed.
> hasWon :: Player -> Board -> Bool
> hasWon p b = any (f p) b ||
> any (f p) (getCols b) ||
> any (f p) (getDiagonal (transpose (map reverse b))) ||
> any (f p) (getDiagonal (map reverse b)) ||
> any (f p) (getDiagonal (transpose b)) ||
> any (f p) (getDiagonal b)
> where f p r = isInfixOf (replicate win p) r
Takes a triangle of the board by dropping an increasing number of elements
from each row and then transposing, this gives a quater of the boards diagonals.
> getDiagonal :: Board -> Board
> getDiagonal b = f b
> where f b = transpose (map (uncurry drop) (zip [0..] b))
Calls the hasWon function and sees if anyone has won the game.
> whoWon :: Board -> Player
> whoWon b | hasWon O b = O
> | hasWon X b = X
> | otherwise = B
Sees if no blank spaces exist in the board.
> isTie :: Board -> Bool
> isTie b = not (isInfixOf [B] (concat b))
Get the columns in the board by transposing the board.
> getCols :: Board -> Board
> getCols = transpose
> test :: Board
> test = [[B,B,B,B,B,B,B],
> [B,B,B,B,B,B,B],
> [B,B,B,B,B,B,B],
> [B,B,B,X,X,B,B],
> [B,B,O,O,X,B,B],
> [B,O,O,X,O,X,O]]
----------------------------------------------------------------------
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment