tak-ai-0.1.0.1: src/TakkyCore.hs

{-# LANGUAGE TypeFamilies #-}
module TakkyCore where

import qualified Data.Foldable as Foldable
import System.IO.Unsafe
import System.Random.Shuffle

import Tak
import PlayTakBot

import qualified Negamax

data Takky = Takky String String

instance Bot Takky where
    botName (Takky username _) = username
    botPassword (Takky _ password) = password
    botEvaluate _ colour botGameState = evaluate colour botGameState
    botChoosePlay _ botGameState = Negamax.chooseplay 3 botGameState 

instance Negamax.Game (BotGameState) where
    type Play BotGameState = Play
    plays botGameState = unsafePerformIO $
        shuffleM $ map (\ (GameBranch p n) -> (p, botGameState{bgsTree = n})) branches
        where GameNode _ _ branches = bgsTree botGameState 
    eval (BotGameState (GameNode _ score _) _) = score
    ourmove (BotGameState (GameNode state _ _) colour) = stPlaysNext state == colour
    finished (BotGameState (GameNode state _ _) _) = stFinished state /= Nothing

--instance Show Takky where
--    show (Takky tree _) = show $ showState $ treeGameState tree

-- | Assigns a score to the current state of the game, from the perspective of
--   black or white. Higher scores indicate an advantageous position.
--   For now, just see who owns more squares.
evaluate :: Colour -> GameState -> Double
evaluate colour state =
    let rand = 0 in --(unsafePreformIO randomIO :: Double) / 100 in
    case stFinished state of
        Nothing ->
            rand + territoryScore (stBoard state) colour
        Just (RoadWin colour') -> if colour == colour'
            then 1e100
            else -1e100
        Just (FlatWin colour' _ _) -> if colour == colour'
            then 1e100
            else -1e100
        Just (Draw _ _) -> 0.0

territoryScore :: Board -> Colour -> Double
territoryScore board ourColour = Foldable.foldr fn 0 board where
    fn [] score = score
    fn ((Flat, colour) : rest) score
        | colour == ourColour = (score + 1) + scoreRest ourColour colour rest
        | otherwise = (score - 1) + scoreRest ourColour colour rest
    fn ((_, colour) : rest) score = score + scoreRest ourColour colour rest

scoreRest :: Colour -> Colour -> Square -> Double
scoreRest ourColour topColour rest = foldr fn 0 rest where
    fn (_, colour) score = score + if colour == topColour
        then if colour == ourColour
            then 0.75
            else -0.75
        else if colour == ourColour
            then 0.25
            else -0.25