forked from ian-ross/ggp
-
Notifications
You must be signed in to change notification settings - Fork 0
/
MobilityAlphaBeta.hs
96 lines (85 loc) · 3.1 KB
/
MobilityAlphaBeta.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
{-# LANGUAGE RecordWildCards, TemplateHaskell #-}
module MobilityAlphaBeta (mobilityAlphaBetaPlayer) where
import Control.Monad
import Data.List (delete)
import GGP.Player
import GGP.Utils
import Language.GDL
data DLState = DLState { maxDepth :: Int, nest :: Int }
instance Default DLState where
def = DLState { maxDepth = 2, nest = 0 }
type Game a = GGP DLState a
modNest :: Int -> Game ()
modNest delta = modExtra (\e -> e { nest = nest e + delta })
msg :: String -> Game ()
msg s = do
e <- gets matchExtra
logMsg $ replicate (nest e) ' ' ++ s
minscore :: Int -> Integer -> Integer -> State -> Move -> Game Integer
minscore level alpha beta st m = do
Match {..} <- get
msg $ "maxscore: level=" ++ show level ++
" alpha=" ++ show alpha ++ " beta=" ++ show beta ++
" m=" ++ prettyPrint m
let oppRole = head $ delete matchRole $ roles matchDB
acts = legal matchDB st oppRole
go _alp bet [] = return bet
go alp bet (a:as) = do
let poss = applyMoves matchDB st [(matchRole, m), (oppRole, a)]
s <- maxscore (level + 1) alp bet poss
let bet' = bet `min` s
if bet' <= alp
then return alp
else go alp bet' as
modNest 1
retval <- go alpha beta acts
modNest (-1)
msg $ "minscore returns " ++ show retval
return retval
maxscore :: Int -> Integer -> Integer -> State -> Game Integer
maxscore level alpha beta st = do
Match {..} <- get
msg $ "maxscore: level=" ++ show level ++
" alpha=" ++ show alpha ++ " beta=" ++ show beta
let acts = legal matchDB st matchRole
nas = length acts
retval <- if isTerminal matchDB st
then return $ goal matchDB st matchRole
else if level >= maxDepth matchExtra
then do
let res = fromIntegral $ 100 * nas `div` matchNFeasible
msg $ "Mobility result: " ++ show res
return res
else do
modNest 1
let go alp _bet [] = return alp
go alp bet (a:as) = do
s <- minscore level alp bet st a
let alp' = alp `max` s
if alp' >= bet
then return bet
else go alp' bet as
res <- go alpha beta acts
modNest (-1)
return res
msg $ "maxscore returns " ++ show retval
return retval
bestMove :: State -> Game Move
bestMove st0 = do
Match {..} <- get
let as = legal matchDB st0 matchRole
vs <- forM as (minscore 0 0 100 st0)
let avs = zip as vs
bestv = maximum vs
possas = map fst $ filter ((== bestv) . snd) avs
msg $ "Moves and values: " ++ show avs
msg $ "Possible moves: " ++ show possas
idx <- getRandomR (0, length possas-1)
return $ possas !! idx
initEx :: PlayerParams -> DLState
initEx ps = case getParam "maxDepth" ps of
Nothing -> DLState 2 0
Just d -> DLState (read d :: Int) 0
mobilityAlphaBetaPlayer :: Player DLState
mobilityAlphaBetaPlayer = def { initExtra = initEx
, handlePlay = basicPlay bestMove }