ReversiAI.hs

-- \/\/\/ DO NOT MODIFY THE FOLLOWING LINES \/\/\/
  
module ReversiAI (State,author,nickname,initial,think) where

import Reversi
import Data.List
import Data.Map (fromList, (!))
import Data.Maybe

-- /\/\/\ DO NOT MODIFY THE PRECEDING LINES /\/\/\

-- Remember to provide a brief (about 100-500 words) description of
-- your implementation.

{- One has implemented a simple local maximisation heuristic which considers the 
relative worth of each field on the board and weights the score by 
the value of the pieces held by each player. the corners and edge fields are 
considered more valuable - one can attribute these fields with larger positive weights, 
and the fields which could result if acquired lead to the opponent capturing the corners 
or edges are attributed with negative weights. The function `localMaximum weightedScore` 
returns the move which yields the greatest weighted gain in pieces. -}

data Field = Empty | Black | White | Edge 
    deriving (Show, Eq)

data Direction = Up | Down | Left | Right | UpRight | DownRight | DownLeft | UpLeft 
    deriving (Eq)

-- the internal state of your AI
data State = State { 
    board :: [Field], 
    player :: Reversi.Player,
    opposition :: Reversi.Player
} deriving (Show) 

directions = [(Up, -10), (Down, 10), (ReversiAI.Left, -1), (ReversiAI.Right, 1), (UpRight, -9), 
    (DownRight, 11), (DownLeft, 9), (UpLeft, -11)]

author :: String
author = "Zack Kite"  

nickname :: String
nickname = "AlphaReversi"  

{- initial player' 
    initialises the AI's internal representation of Reversi board with pieces, player and opponent
    RETURNS: The initial state of AlphaReversi representing the initial Reversi board with player and opponent fields
-}
initial :: Reversi.Player -> State
initial player' = (State { 
    board = initialBoard,
    player = player',
    opposition = if player' == Reversi.Black then Reversi.White else Reversi.Black
})

initialBoard = map (\x -> initialField x ) [0..99] 

initialField i 
    | i <= 9 || i >= 89 = ReversiAI.Edge
    | (i `mod` 10 == 0 || i `mod` 10 == 9) = ReversiAI.Edge
    | i == 44 || i == 55 = ReversiAI.White
    | i == 54 || i == 45 = ReversiAI.Black
    | otherwise = ReversiAI.Empty

fields = [i |  i <- [11..89], let mod10 = (i `mod` 10), 1 <= mod10 && mod10 <= 8 ]

valid :: Reversi.Move -> Bool
valid Pass = True
valid (Move move) = any (== move) fields

bracket :: Reversi.Move -> Direction -> Player -> [Field] -> Maybe Reversi.Move
bracket Pass _ _ _ = Nothing
bracket (Move move) direction player' grid 
    | grid !! next == asField player' || grid !! next == Empty = Nothing
    | otherwise = if valid (Move enclosing) && (grid !! enclosing == asField player') then Just (Move enclosing) else Nothing
        where 
            next = inc move direction
            enclosing = bracketRecursive grid player' direction next

bracketRecursive board' player' direction index 
    | board' !! index == (opponent player') = bracketRecursive board' player' direction (inc index direction)
    | otherwise = index

legal :: Move -> Player -> [Field] -> Bool
legal move@(Move index) p b = 
    b !! index == Empty && any (\(d, _) -> isJust (bracket move d p b)) directions

legalMoves player' state = filter (\move -> legal (Move move) player' (board state)) fields

update :: State -> Player -> Reversi.Move -> State
update state _ Pass = state
update state player' move = 
    (State {
        board = foldr (\(d, _) acc -> reversePieces move d player' acc ) (board state) directions,
        player = player state,
        opposition = opposition state
    })

reversePieces move@(Move start) direction player' board' = 
    case bracket move direction player' board' of 
        Nothing -> board'
        Just (Move end) -> 
            map (\(i, f) -> if elem i [start, (inc start direction)..end] then asField player' else f) 
            . zip [0..] $ board'

weights = [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
    0, 120, -20, 20, 5, 5, 20, -20, 120, 0, 
    0, -20, -40, -5, -5, -5, -5, -40, -20, 0, 
    0, 20, -5, 15, 3, 3, 15, -5, 20, 0, 
    0, 5,-5, 3, 3, 3, 3, -5, 5, 0, 
    0, 5,-5, 3, 3, 3, 3, -5, 5, 0, 
    0, 20, -5, 15, 3, 3, 15, -5, 20, 0, 
    0, -20, -40, -5,-5, -5, -5, -40, -20, 0, 
    0, 120, -20, 20, 5, 5, 20, -20, 120, 0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ]

-- remember to provide a function specification
{- think previousState opponentMove timeRemaining  
    Updates state of AI with the opponentMove and applies strategy to determined the next 'best' move
    RETURNS: a pair (m, s) where m is the next move and s the AI's internal state 
            after making the move m
    EXAMPLE: think (initial Black) Pass 299 == ((Move 43), _)
-}
think :: State -> Reversi.Move -> Double -> (Reversi.Move,State)
think state oppositionMove time = 
    (toStandardField nextMove, nextState) 
    where 
        nextMove = localMaximiser weightedScore $ currentState  
        nextState = update currentState (player state) nextMove 
        currentState = update state (opposition state) (toInternalField oppositionMove)

localMaximiser :: (State -> Int) -> (State -> Reversi.Move)
localMaximiser eval = 
    \state' -> 
        let player' = player state' 
            legalMoves' = legalMoves player' state'
        in 
            if null legalMoves' then Pass 
            else head . reverse .sortOn (\move -> eval (update state' player' move)) 
                . map (\move -> (Move move)) 
                $ legalMoves'

weightedScore :: State -> Int
weightedScore state = foldr (\field score -> 
    let opponent' = asField . opposition $ state
        player' = asField . player $ state
        piece' = board state !! field
        fieldWeight = (weights !! field) in 
    if piece' == player' then score + fieldWeight 
    else if piece' == opponent' then score - fieldWeight
    else score) 0 fields

-- helpers 

inc :: Int -> Direction -> Int
inc move direction = move + inc where inc = snd $ head . filter (\(d, inc) -> d == direction) $ directions 
 
takeWhileInclusive :: (a -> Bool) -> [a] -> [a]
takeWhileInclusive p = foldr (\x ys -> if p x then x:ys else [x]) []

opponent p = if p== Reversi.White then ReversiAI.Black else ReversiAI.White

-- fix this duplication 
asField p = if p == Reversi.White then ReversiAI.White else ReversiAI.Black

-- ugly
toStandardField Pass = Pass
toStandardField (Move move) = (Move (standardFieldMap ! move))
    where standardFieldMap = fromList $ zip fields [0..]

toInternalField Pass = Pass
toInternalField (Move move ) = (Move (reverseMap ! move))
    where reverseMap = fromList $ zip [0..] fields 

splitEvery _ [] = []
splitEvery n xs = as : splitEvery n bs 
    where (as,bs) = splitAt n xs

printBoard board' = 
    mapM_ putStrLn $ splitEvery 10 $ toAscii board'
    where toAscii = map (\x -> 
            case x of 
                Edge -> '?'
                Empty -> '.'
                ReversiAI.Black -> 'b'
                ReversiAI.White -> 'w')