> module Macala where

Module to play the game of Macala (Kalah), originally written by
Cormac Flanagan, heavily edited by Paul Hudak.  

A minimax game tree is used to select the best move based on
heuristics given a board state.

Data types and basic operations
-------------------------------

Players' names are A and B:

> data Player = A | B 
>   deriving (Eq,Show)

Player state consists of score and contents of pits:

> data PState = PState Player Int [Int]
>   deriving Show

Overall game state:

> data State = State PState PState
>   deriving Show

Current player whose move it is:

> getPlayer :: State -> Player
> getPlayer (State (PState p _ _) _) = p

Increment a player's score:

> incScore :: Int -> PState -> PState
> incScore i (PState p s ps) = PState p (s+i) ps

Initial state consists of 6 pits, each with 4 stones:

> initialState :: Player -> State
> initialState p = 
>   let pits = replicate 6 4
>   in State (PState p 0 pits)
>            (PState (if p==A then B else A) 0 pits)

Game is won when a player reaches a score of 25 or more (i.e. has
captured more than half of the stones):

> isWinState :: State -> Bool
> isWinState (State (PState _ a pas) (PState _ b pbs)) =
>   a > 24 || b > 24 || sum pas == 0 || sum pbs == 0

Valid move is in the range 1 through 6:

> isMoveValid :: Int -> Bool
> isMoveValid n = n>=1 && n<=6 -- elem n [1..6]

Legal move is valid move with non-empty pit on non-winning state:

> isMoveLegal :: State -> Int -> Bool
> isMoveLegal _ n | not (isMoveValid n)    = False
> isMoveLegal s _ | isWinState s           = False
> isMoveLegal (State (PState a sa pa) _) n = (pa !! (n-1)) /= 0

Applying a move
---------------

Apply a move to a state, yielding Just a new state or Nothing:

> applyMove :: State -> Int -> Maybe State
> applyMove s n | not (isMoveLegal s n) = Nothing
> applyMove s n = Just (applyMove' s' p')
>   where
>     (s',p') = case s of
>                 State (PState a sa pa) playerother ->
>                   (State (PState a sa (killPit pa)) playerother, 
>                    pa !! (n-1))
>     killPit xs = take (n-1) xs ++ [0] ++ drop n xs
>     applyMove' (State a b) p = 
>       let (rounds, extras) = divMod p 13
>           sinc             = rounds + (if (6-n) < extras then 1 else 0)
>           extras' = if n == 6
>                     then extras - 1
>                     else if null adist then 0 
>                          else extras - last adist + head adist - 2
>           extras''  = if null bdist then 0 
>                       else extras' - last bdist + (head bdist) - 1
>           adist     = [i | i <- [(n + 1)..6], i - n <= extras]
>           bdist     = [i | i <- [1..6], i <= extras']
>           adist'    = [i | i <- [1..6], i <= extras'']
>           currP = (incScore sinc . distStones adist . 
>                    distStones adist' . incStonesBy rounds) $ a
>           otherP = (distStones bdist . incStonesBy rounds) $ b
>       in if extras == 6-n+1 then State currP otherP else State otherP currP
>         --(State otherP currP)

Distribute (?) stones:

> incStones :: PState -> PState
> incStones p = distStones [1..6] p

> distStones :: [Int] -> PState -> PState
> distStones is (PState p s ps) =
>   PState p s (zipWith (\i n -> if elem i is then n+1 else n) 
>                       (iterate (+1) 1) 
>                       ps)

> incStonesBy :: Int -> PState -> PState
> incStonesBy n p = iterate incStones p !! n

Compute all possible next states:

> nextStates :: State -> [State]
> nextStates s = [s | Just s <- map (applyMove s) [1..6]]

Playing games
-------------

Simulate a game with manual moves by both players:

> simulateGame :: IO ()
> simulateGame = 
>   simGame (initialState A) getMove
>
> getMove :: State -> IO Int
> getMove st = do
>   putStr (show (getPlayer st) ++ ":: ")
>   move <- getLine
>   case (reads move) of
>     []      -> putStrLn "Error, try again." >> getMove st
>     (i,_):_ -> return i

Simulate a game using given function for A, and manually for B:

> playComputer :: (Player->State->Int) -> IO ()
> playComputer rating = 
>   simGame (initialState A) (getOneMove (bestMove rating))

> getOneMove :: (State->Int) -> State -> IO Int
> getOneMove chooseAMove st =
>   if getPlayer st == B then getMove st
>                        else do let move = chooseAMove st
>                                putStrLn ("A:: " ++ show move)
>                                return move

Simulate game using given functions for both A and B -- computer wars!

> computerWar :: (Player->State->Int) -> (Player->State->Int) -> IO ()
> computerWar ratingA ratingB =
>   simGame (initialState A) (makeMove (bestMove ratingA) (bestMove ratingB))

> makeMove :: (State->Int) -> (State->Int) -> State -> IO Int
> makeMove chooseAMove chooseBMove st =
>   let move = if getPlayer st == A then chooseAMove st else chooseBMove st
>   in do putStrLn (show (getPlayer st) ++ ":: " ++ show move)
>         return move

Core of game simulation:

> simGame :: State -> (State -> IO Int) -> IO ()
> simGame st makeMove = do
>   print st
>   m <- makeMove st
>   case m of
>     0 -> putStrLn "Goodbye!"
>     _ -> case (applyMove st m) of
>            Nothing -> do putStrLn "Invalid move; try again."
>                          simGame st makeMove
>            Just a | isWinState a -> 
>                       do print st
>                          putStrLn (show (getPlayer st) ++ " wins!")
>                   | otherwise    -> simGame a makeMove

--------------------------------------------------------------------------
Student code goes below here
--------------------------------------------------------------------------