hstzaar 0.2 → 0.3
raw patch · 6 files changed
+122/−98 lines, 6 files
Files
- RELEASE-NOTES +8/−0
- hstzaar.cabal +1/−1
- src/AI/Minimax.hs +101/−85
- src/AI/Utils.hs +1/−0
- src/Board.hs +4/−4
- src/GUI.hs +7/−8
RELEASE-NOTES view
@@ -1,3 +1,11 @@++hstzaar 0.3 21/08/2010+- improved the AI (new static evaluation function)+- corrected duplicate undo/redo entry after game end++hstzaar 0.2 16/08/2010+- fixed build error for missing module+ hstzaar 0.1 11/08/2010 - Switched the GUI interface to gtk2hs+cairo
hstzaar.cabal view
@@ -1,5 +1,5 @@ name: hstzaar-version: 0.2+version: 0.3 category: Game
src/AI/Minimax.hs view
@@ -9,12 +9,14 @@ import Debug.Trace +-- A greedy strategy+-- chooses the move with highest static evaluation score greedy :: AI greedy = AI { name = "greedy" , description = "Maximize the static evaluation function" , strategy = (ifPieces (==60) (firstTurn greedyStrategy)- (ifPieces (>52)+ (ifPieces (>48) (onlyCaptureStack greedyStrategy) (narrowDoubleCaptures greedyStrategy) )@@ -22,6 +24,18 @@ } ++greedyStrategy :: Strategy+greedyStrategy (GameTree _ branches) rndgen + = trace ("Greedy score: " ++ show bestscore) (bestmove, rndgen)+ where + choices = [(m, eval (root t)) | (m,t)<-branches]+ (bestmove,bestscore) = maximumBy (\x y -> compare (snd x) (snd y)) choices+ root (GameTree x _) = x++++-- straight minimaxing strategies with increasing depth ply2 :: AI ply2 = AI { name = "ply2" , description = "Minimax with depth 2"@@ -49,20 +63,21 @@ ) } -+-- dynamic strategies:+-- increase the maximax depth and breadth towards the end game dyn1 :: AI dyn1 = AI { name = "dyn1" , description = "Minimax with dynamic depth 1-4" , strategy = (ifPieces (==60) (firstTurn greedyStrategy)- (ifPieces (>52) + (ifPieces (>48) (onlyCaptureStack greedyStrategy) (narrowDoubleCaptures $ - ifPieces (>30)+ ifPieces (>28) (minimaxStrategy 2 3) (ifPieces (>20)- (minimaxStrategy 3 3)- (minimaxStrategy 4 5)+ (minimaxStrategy 3 4)+ (minimaxStrategy 4 6) ) ) )@@ -75,14 +90,14 @@ , description = "Minimax with dynamic depth 2-6" , strategy = (ifPieces (==60) (firstTurn greedyStrategy)- (ifPieces (>52) + (ifPieces (>48) (onlyCaptureStack $ minimaxStrategy 2 3) (narrowDoubleCaptures $ - ifPieces (>30)+ ifPieces (>28) (minimaxStrategy 3 3) (ifPieces (>20)- (minimaxStrategy 4 3)- (minimaxStrategy 6 5)+ (minimaxStrategy 4 4)+ (minimaxStrategy 6 6) ) ) )@@ -90,128 +105,130 @@ } --- | A greedy strategy: locally maximize the static evaluation function-greedyStrategy :: Strategy-greedyStrategy (GameTree _ branches) rndgen - = trace ("Greedy score: " ++ show bestscore) (bestmove, rndgen)- where - choices = [(m, eval $ root t) | (m,t)<-branches]- (bestmove,bestscore)= maximumBy (\x y -> compare (snd x) (snd y)) choices- root (GameTree x _) = x ----- | Minimaxing strategy to ply depth `n'--- With alpha-beta and depth prunning+-- Minimaxing strategy to ply depth `n' and breadth `m'+-- using alpha-beta prunning minimaxStrategy :: Int -> Int -> Strategy minimaxStrategy n m g rndgen = trace ("Minimax score: " ++ show bestscore) (bestmove, rndgen)- where g' = prunebreadth m $ -- ^ cut to breadth $m$+ where (bestmove,bestscore) = minimaxMove_ab undefined (-inf) inf g'+ g' = prunebreadth m $ -- ^ cut to breadth `m' highfirst $ -- ^ order moves using static evaluation mapTree eval $ -- ^ apply evaluation function- prunedepth n g -- ^ cut to depth $n$- (bestmove,bestscore) = minimaxMove_ab (-inf) inf g'+ prunedepth n g -- ^ prune to depth `n'+ --- | Naive minimax algorithm--- nodes should contain the static evaluation scores+-- Naive minimax algorithm (not used)+-- nodes should contain the static evaluation scores minimax :: (Num a, Ord a) => GameTree a m -> a minimax (GameTree x []) = x minimax (GameTree _ branches) = - minimum (map (minimax.snd) branches) - -- auxiliary function that returns the best first move minimaxMove :: (Num a, Ord a) => GameTree a m -> (m,a) minimaxMove (GameTree _ branches) = (m, -x) where (m,x) = minimumBy (\x y ->compare (snd x) (snd y)) [(m,minimax t) | (m,t)<-branches] --- | Minimax with alpha-beta prunning++-- Minimax with alpha-beta prunning minimax_ab :: (Num a, Ord a) => a -> a -> GameTree a m -> a minimax_ab a b (GameTree x []) = a `max` x `min` b minimax_ab a b (GameTree _ branches) = cmx a b (map snd branches) where cmx a b [] = a cmx a b (t:ts) | a'>=b = b | otherwise = cmx a' b ts- where a' = - (minimax_ab (-b) (-a) t)+ where a' = - minimax_ab (-b) (-a) t --- | This variant also returns the best move--- should always be called with a non-empty tree-minimaxMove_ab :: (Num a, Ord a) => a -> a -> GameTree a m -> (m,a)-minimaxMove_ab a b (GameTree x []) = (undefined, a`max`x`min`b)-minimaxMove_ab a b (GameTree _ branches@((m,_):_)) = cmx m a b branches+-- This variant also returns the best initial move+minimaxMove_ab :: (Num a, Ord a) => m -> a -> a -> GameTree a m -> (m,a)+minimaxMove_ab m0 a b (GameTree x []) = (m0, a`max`x`min`b)+minimaxMove_ab m0 a b (GameTree _ branches) = cmx m0 a b branches where cmx m a b [] = (m,a) cmx m a b ((m',t):branches) - | a'>=b = (m,b)+ | a'>=b = (m',b) | otherwise = cmx m' a' b branches- where a' = - (minimax_ab (-b) (-a) t)+ where a' = - minimax_ab (-b) (-a) t --- | Static evaluation function+-- Static evaluation function for a board position+-- boolean indicates if active player is conducting the analysis eval :: (Bool,Board) -> Int eval (True, b) = value b eval (False,b) = - value (swapBoard b) ++-- value of a board position for the active player value :: Board -> Int-value b@(you,other)- | pieces==0 || null captures = -inf- | pieces'==0 || null captures' = inf- | otherwise = threats + positional - where pieces = length $ nub $ map fst $ Map.elems you- pieces'= length $ nub $ map fst $ Map.elems you- captures = nextCaptureMoves b -- my captures- captures'= nextCaptureMoves (swapBoard b) -- opponents's captures- -- the zones of control for each player- -- the active play has advantage for equal heights- zoc = zoneOfControl (>=) b- zoc'= zoneOfControl (>) (swapBoard b)+value b@(active,other)+ | minimum pieces ==0 || null captures = -inf+ | minimum pieces'==0 || null captures' = inf+ | otherwise = material + positional + threats + where + -- piece counts for each player + pieces = counts active+ pieces'= counts other - -- the three piece types- ts = [Tzaar, Tzarra, Tott]+ captures = nextCaptureMoves b+ captures'= nextCaptureMoves (swapBoard b) - -- immediate threats- threats = points safe' - points safe + -- the zones of control for each player+ -- active player has advantage for equal height+ zoc = zoneOfControl (>=) b+ zoc'= zoneOfControl (>) (swapBoard b) - -- pieces safe from immediate threat- safe = minimum [count t you - min 2 (count t zoc') | t <- ts]- safe'= minimum [count t other - min 2 (count t zoc) | t <- ts]+ -- capture counts by piece type+ nzoc = counts zoc+ nzoc'= counts zoc' - points n | n<=0 = inf`div`2- | n==1 = inf`div`4- | otherwise = 0+ -- material score+ material = sumHeights active - sumHeights other - -- positional score- -- sum heights multiplied by "relevance" factor - -- inside other player's ZoC- positional = sum [material t zoc * relevance t other | t<-ts] -- sum [material t zoc'* relevance t you | t<-ts] + -- positional score+ positional = sumHeights zoc - sumHeights zoc' - -- lower count pieces types are more relevant- relevance t r = 2^(15-count t r)+ -- scores for immediate threats+ threats = penalty p - penalty q + p = minimum [x-min 2 y | (x,y)<-zip pieces' nzoc]+ q = minimum [x-min 2 y | (x,y)<-zip pieces nzoc'] + penalty n | n<=2 = inf`div`(2^(1+n))+ | otherwise = 0 --- | count pieces of a particular type-count :: Type -> HalfBoard -> Int-count t r = Map.size $ Map.filter (\(t',_)->t'==t) r --- | material score by piece type--- sum height for stacks -material :: Type -> HalfBoard -> Int-material t r = Map.fold (\(t',h) s->if t==t' then s+h else s) 0 r+-- a higher value than legitimate evaluation score+inf :: Int+inf = 2^10 + +-- count the number of pieces of each type+-- results ordered by piece types +counts :: HalfBoard -> [Int]+counts b = Map.elems $ Map.fold (\(t,_)-> Map.adjust (+1) t) zeroPieces b --- | The "zone of control" of a player --- | the opponent's pieces that can be captured in a turn+-- finite map assigning 0 to each piece type+-- lifted to top-level to allow sharing across multiple calls+zeroPieces :: Map Type Int+zeroPieces = Map.fromList [(Tzaar,0),(Tzarra,0),(Tott,0)] -zoneOfControl :: (Int->Int->Bool) -> Board -> HalfBoard-zoneOfControl gt board@(you,other) +-- sum the heights of pieces (material value of a player)+sumHeights :: HalfBoard -> Int+sumHeights b = sum [h | (_,h)<-Map.elems b]++++-- Estimate the "zone of control" of the active player+-- i.e. the opponent's pieces reachable in one or two captures+zoneOfControl :: (Int->Int->Bool) -> Board -> HalfBoard+zoneOfControl cmp board@(_,other) = Map.filterWithKey forPiece other where forPiece :: Position -> Piece -> Bool@@ -223,7 +240,7 @@ downLine i (p:ps) = case atPosition board p of Nothing -> downLine i ps- Just (True, (_, h)) -> h`gt`i+ Just (True, (_, h)) -> h`cmp`i Just (False, (_, j)) -> or $ map (downLine' (max i j)) $ sixLines p @@ -231,18 +248,14 @@ downLine' i (p:ps) = case atPosition board p of Nothing -> downLine' i ps- Just (True, (_, h)) -> h`gt`i+ Just (True, (_, h)) -> h`cmp`i Just (False, _) -> False --- a higher value than legitimate evaluation scores-inf :: Int-inf = 2^20 - -- | narrow the search space: single capture first move firstTurn :: Strategy -> Strategy firstTurn s (GameTree node branches) rndgen @@ -275,10 +288,13 @@ equiv _ _ = False --- | use different strategies depedening on the number of pieces left++-- | use different strategies dependening on the number of pieces left ifPieces :: (Int -> Bool) -> Strategy -> Strategy -> Strategy ifPieces cond s1 s2 g@(GameTree (_,(you,other)) branches) rndgen | cond n = s1 g rndgen -- use the 1st strategy | otherwise = s2 g rndgen -- use the 2nd strategy where n = Map.size you + Map.size other++
src/AI/Utils.hs view
@@ -11,6 +11,7 @@ import Board import Data.List (sortBy, minimumBy) + -- | Searches BoardTree to a depth of 1 looking for a -- | guaranteed win or a preventable loss. winOrPreventLoss :: Strategy -> Strategy
src/Board.hs view
@@ -1,3 +1,4 @@+ -- | Board State and AI module Board (@@ -49,12 +50,12 @@ data GameTree s m = GameTree s [(m, GameTree s m)] deriving Show -- | A game tree of boards labeled with a boolean --- the label is True if your turn, False if opponent.+-- | True if it's max player's turn, False if min player's turn type BoardTree = GameTree (Bool,Board) Turn -- | The three types of pieces -- | Each player starts with 6 Tzaars, 9 Tzarras, and 15 Totts.-data Type = Tzaar | Tzarra | Tott deriving (Show, Eq)+data Type = Tzaar | Tzarra | Tott deriving (Show, Eq, Ord) -- | the type of a piece, and the level of the stack (starting with 1). type Piece = (Type, Int)@@ -233,8 +234,7 @@ -- | The six lines traveling radially out from a single board position.--- | optimization: this function is lazily memoied -+-- | optimization: this map is memoied lazily sixLines_memo :: Map Position [[Position]] sixLines_memo = Map.fromList [(p, radials p) | p<-positions] where radials p = [r | l<-threeLines p, r<-divide p l, not (null r)]
src/GUI.hs view
@@ -71,7 +71,6 @@ | otherwise = (startingBoard, g) - -- a record to hold GUI elements data GUI = GUI { mainwin :: Window,@@ -445,7 +444,7 @@ renderHeights :: Bool -> Board -> Render () renderHeights b (whites,blacks) = when b $ do setSourceRGB 1 0 0 - setFontSize 32+ setFontSize 36 mapM_ renderHeight (Map.assocs whites) mapM_ renderHeight (Map.assocs blacks) where@@ -513,9 +512,9 @@ dispatchTurn :: GUI -> StateRef -> State -> Turn -> IO () dispatchTurn gui stateRef s t | null branches' -- white wins- = let s' = addHistory $ s { stage = Finish, - bt = swapBoardTree bt', - stdGen = g }+ = let s' = s { stage = Finish, + bt = swapBoardTree bt', + stdGen = g } in do gui `pushMsg` "White wins" writeIORef stateRef s' redrawCanvas (canvas gui)@@ -529,9 +528,9 @@ where child = if null branches'' then- let s'= addHistory $ s { stage = Finish, - bt = bt'', - stdGen = g }+ let s'= s { stage = Finish, + bt = bt'', + stdGen = g } in do writeIORef stateRef s' redrawCanvas (canvas gui) gui `pushMsg` "Black wins"