{-# LANGUAGE BangPatterns #-} -- Static evaluation functions for board positions module AI.Eval( eval0, eval1 ) where import Board import AI.Utils (zoneOfControl) import qualified Data.IntMap as IntMap -- | Static evaluation of a position for the active player -- | Level 0: material only eval0 :: Board -> Int eval0 b | any (==0) counts || (move b==1 && null captures) = -infinity | any (==0) counts' = infinity | otherwise = material where -- count stacks by piece kind for each player counts = countStacks (active b) counts'= countStacks (inactive b) -- capture moves for active 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 | (c,h)<-zip counts heights] - sum [(mw*h)`div`c | (c,h)<-zip counts' heights'] -- scoreing weights coeficients mw = 100 -- material -- | Level >=1: material + positional eval1 :: Board -> Int eval1 b | any (==0) counts || (move b==1 && null captures) = -infinity | any (==0) counts' || not (null threats) = infinity | otherwise = material + positional where -- count stacks by piece kind for each player counts = countStacks (active b) counts'= countStacks (inactive b) -- capture moves for active 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 | (c,h)<-zip counts heights] - sum [(mw*h)`div`c | (c,h)<-zip counts' heights'] -- zone of control of the active player zoc = zoneOfControl b -- positional score zoc_heights = sumHeights zoc zoc_counts = countStacks zoc positional = sum [(pw*h)`div`c | (c,h)<-zip counts' zoc_heights] -- immediate threats to opponent's pieces threats = [undefined | (x,y)<-zip counts' zoc_counts, move b+x<=3 && x==y] -- scoreing weights coeficients mw = 100 -- material weight pw = 100 -- positional weight -- 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]