{-# 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