-
-
Save jfoot/72fb4c64c2f81e76a6ea53e879fe49e1 to your computer and use it in GitHub Desktop.
Advanced Functional Programming Hang Man AI Game
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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