{-# LANGUAGE BangPatterns #-} -- Static evaluation functions of board positions module AI.Eval( eval , zoneOfControl ) where import Board import qualified Data.IntMap as IntMap import Debug.Trace -- | Static evaluation of a position for the active player eval :: Board -> Int eval b | any (==0) counts || (move b==1 && null captures) = -infinity | any (==0) counts' = infinity | otherwise = {- trace (unwords ["material=", show material, "position=", show positional, "threats=", show threats]) $ -} material + positional + threats where -- count stacks by piece kind for each player counts = countStacks (active b) counts'= countStacks (inactive b) -- capture moves for each player captures = nextCaptureMoves b --captures'= nextCaptureMoves (swapBoard b) -- stack heights by piece kinds heights = sumHeights (active b) heights'= sumHeights (inactive b) -- material score material = sum [(mw*h)`div`(c+1) | (c,h)<-zip counts heights] - sum [(mw*h)`div`(c+1) | (c,h)<-zip counts' heights'] zoc = zoneOfControl b -- zone of control for the active player zoc_heights = sumHeights zoc -- piece types in the zone of control -- positional score positional = sum [(pw*h)`div`(c+1) | (c,h)<-zip counts' zoc_heights] -- immediate threats to opponent pieces zoc_counts = countStacks zoc threats = sum [tw | (x,y)<-zip counts' zoc_counts, x<=min 2 y] -- scoreing weights coeficients mw = 100 -- material pw = 50 -- positional tw = 1000 -- threats -- sum of heights of stacks for each kind sumHeights :: HalfBoard -> [Int] sumHeights b = sum 0 0 0 (IntMap.elems b) where sum :: Int -> Int -> Int -> [Piece] -> [Int] sum !x !y !z ((Tzaar,h):ps) = sum (x+h) y z ps sum !x !y !z ((Tzarra,h):ps) = sum x (y+h) z ps sum !x !y !z ((Tott,h):ps) = sum x y (z+h) ps sum !x !y !z [] = [x,y,z] -- Estimate the zone of control of the active player -- i.e., the set of opponent pieces reachable in a turn (two capture moves) zoneOfControl :: Board -> HalfBoard zoneOfControl board = IntMap.filterWithKey forPiece1 other where you = active board other = inactive board who = player board -- white pieces that can make at least one capture captures = IntMap.filterWithKey forPiece2 you 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 (who', (_, h)) | who'==who -> h>=i || (p`IntMap.member`captures && downLine1 i ps) Just (_, (_, 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 (who', (_, h)) | who'==who -> h>=i _ -> False downLine2 h [] = False downLine2 h (p:ps) = case atPosition board p of Nothing -> downLine2 h ps Just (who', (_, i)) | who'/=who -> h>=i _ -> False