Advanced Functional Programming Hang Man AI Game

HangMan.lhs

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]]


----------------------------------------------------------------------