Eval.hs

{-# LANGUAGE BangPatterns #-}
-- Static evaluation functions for board positions
module AI.Eval( eval
              , value
              , zoneOfControl
              , inf
              ) where

import Board
import qualified Data.Map as Map


-- Static evaluation function for a board position
-- boolean is True if white player's turn, False for black player's turn
eval :: (Bool,Board) -> Int
eval (True, b) = value b
eval (False,b) = value (swapBoard b)



-- value of a board position for the white player
-- assuming the white player is next to move (active player)
value :: Board -> Int
value b@(white,black)
    | minimum wtypes==0 || null wcaptures = -inf
    | minimum btypes==0 || null bcaptures =  inf
    | otherwise = material + 8*positional + threats
    where 
      -- piece counts for each player 
      wtypes = countPieces white
      btypes = countPieces black

      -- capture moves for each player
      wcaptures = nextCaptureMoves b
      bcaptures = nextCaptureMoves (swapBoard b)    

      -- the zones of control for each player
      wzoc = zoneOfControl (>=) b
      bzoc = zoneOfControl (>) (swapBoard b)

      -- piece types in each zone of control
      wzoc_types = countPieces wzoc
      bzoc_types = countPieces bzoc

      -- material score
      material = sumHeights white - sumHeights black
              
      -- positional score
      -- positional = sumHeights wzoc - sumHeights bzoc
      positional = Map.size wzoc - Map.size bzoc

      -- immediate threats
      threats | bt<=wt    = penalty bt
              | otherwise = - penalty wt

      -- immediately threatened pieces 
      wt = minimum [x-min 2 y | (x,y)<-zip wtypes bzoc_types]
      bt = minimum [x-min 2 y | (x,y)<-zip btypes wzoc_types] 

      penalty n | n<=2 = inf`div`2^(n+1)
                | otherwise = 0



-- the maximum evaluation score
inf :: Int
inf = 2^10

            
-- sum the heights of pieces (material value of a player)
-- specification:
-- sumHeights b = sum [h | (_,h)<-Map.elems b]
sumHeights :: HalfBoard -> Int
sumHeights b = sum 0 [h | (_,h)<-Map.elems b]
    where sum :: Int -> [Int] -> Int
          sum !s [] = s
          sum !s (!x:xs) = sum (s+x) xs




-- Estimate the "zone of control" of the white player
-- i.e. black pieces that can be captured in one or two moves
zoneOfControl ::   (Int->Int->Bool) -> Board -> HalfBoard
zoneOfControl cmp board@(white,black)  
    = Map.filterWithKey forPiece1 black
    where
      -- white pieces that can make at least one capture
      captures = Map.filterWithKey forPiece2 white

      forPiece1, forPiece2 :: Position -> Piece -> Bool
      forPiece1 p (_, i) = or $ map (downLine0 i) $ sixLines p
      forPiece2 p (_, h) = or $ map (downLine2 h) $ sixLines p

      downLine0, downLine1, downLine2 :: Int -> [Position] -> Bool

      downLine0 i [] = False
      downLine0 i (p:ps) 
          = case atPosition board p of
              Nothing -> downLine0 i ps
              Just (True, (_, h)) -> 
                  h`cmp`i || (p`Map.member`captures && downLine1 i ps)
              Just (False, (_, j)) -> 
                  or $ map (downLine1 (max i j)) $ sixLines p

      downLine1 i [] = False
      downLine1 i (p:ps) 
          = case atPosition board p of
              Nothing -> downLine1 i ps
              Just (True, (_, h)) -> h`cmp`i
              _ -> False

      downLine2 h [] = False
      downLine2 h (p:ps) 
          = case atPosition board p of
              Nothing -> downLine2 h ps
              Just (False, (_, i)) -> h`cmp`i
              _ -> False