hanabi-dealer 0.11.0.1 → 0.11.0.2
raw patch · 3 files changed
+27/−16 lines, 3 files
Files
- ChangeLog.md +5/−0
- Game/Hanabi.hs +21/−15
- hanabi-dealer.cabal +1/−1
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for hanabi-dealer + ## 0.11.0.2 -- 2021-01-30++ * EndGameLite falls back when there is a contradiction+ This fixes the bug causing non-exhaustive pattern.+ ## 0.11.0.1 -- 2021-01-17 * introduce the "suggested strategy" argument to egl and egml for efficiency reasons
Game/Hanabi.hs view
@@ -536,6 +536,8 @@ in case checkEndGame $ publicState nxt of Nothing -> runSilently (nxt:states) (mov:mvs) strs Just eg -> return ((eg, nxt:states, mov:mvs), strs) +type Probability = Integer+ -- | 'EndGameMirrorLite' assumes that other players think in the same way as itself during endgame. data EndGameMirrorLite sp p = EGML (EndGameLite sp p [EndGameMirrorLite sp p]) egml :: (PublicInfo -> Bool) -- ^ from when to start the endgame search@@ -554,58 +556,60 @@ -- | @'EGL' f sp p ps memory@ usually behaves based on @p@, but it conducts the exhaustive search assuming that others behave based on @ps@ when @f@ returns True. -- The strategy @sp@ suggests a desired move in order to prioritize a promising strategy.-data EndGameLite sp p ps = EGL {fromWhenL::PublicInfo->Bool, suggestedStrategyL::sp, myUsualStrategyL::p, otherPlayersL::ps, memory :: M.Map Key ([Move],[([State],ps,Int)])}+data EndGameLite sp p ps = EGL {fromWhenL::PublicInfo->Bool, suggestedStrategyL::sp, myUsualStrategyL::p, otherPlayersL::ps, memory :: M.Map Key ([Move],[([State],ps,Probability)])} type Key = (Maybe Card, [Marks], [Move], [Card]) instance (Monad m, Strategy sp m, Strategy p m, Strategies ps m) => Strategy (EndGameLite sp p ps) m where strategyName ms = return "EndGameLite" move pvs mvs str@(EGL f sp p ps memory)- | f pub = do let statess = case M.lookup (resToMbC $ result $ publicView $ pvs !! pred numP, map marks $ head $ annotations pub, take (pred numP) mvs, map headC $ handsPV hdpv) memory of- Just (_,tups) -> tups- Nothing -> [ (stateToStateHistory (map publicView tlpvs) mvs state, ps, n) | (state, n) <- possibleStates hdpv ]+ | f pub && not (null statess) = do -- null statess means that there is a contradiction. This can happen when using a PrivateView based on wrong assumption, such as using sontakuColorHint for preprocessing and actually the team mate is not exactly Stateless. (_i, (mp,m)) <- endGameMoveLite statess pvs' mvs sp return (m, EGL f sp p ps mp) | otherwise = do (m,_) <- move pvs mvs p return (m,str)- where pvs'@(hdpv:tlpvs) = [ pv{publicView=pub{gameSpec=gs{rule=r{earlyQuit=True}}}} | pv@PV{publicView=pub@PI{gameSpec=gs@GS{rule=r}}}<- pvs ]+ where statess = case M.lookup (resToMbC $ result $ publicView $ pvs !! pred numP, map marks $ head $ annotations pub, take (pred numP) mvs, map headC $ handsPV hdpv) memory of+ Just (_,tups) -> tups+ Nothing -> [ (stateToStateHistory (map publicView tlpvs) mvs state, ps, fromIntegral n) | (state, n) <- possibleStates hdpv ]+ pvs'@(hdpv:tlpvs) = [ pv{publicView=pub{gameSpec=gs{rule=r{earlyQuit=True}}}} | pv@PV{publicView=pub@PI{gameSpec=gs@GS{rule=r}}}<- pvs ] pub = publicView hdpv numP = numPlayers $ gameSpec pub endGameMoveLite :: (Monad m, Strategies ps m, Strategy p m) =>- [([State],ps,Int)] -- ^ possible pairs of the state history and the internal memory states of other players' strategies+ [([State],ps,Probability)] -- ^ possible pairs of the state history and the internal memory states of other players' strategies -> [PrivateView] -- ^ view history -> [Move] -- ^ move history -> p -- ^ default (recommended) strategy- -> m (Int, (M.Map Key ([Move], [([State],ps,Int)]), Move))+ -> m (Probability, (M.Map Key ([Move], [([State],ps,Probability)]), Move)) endGameMoveLite statess pvs@(pv:_) mvs p = do (defaultMove, q) <- move pvs mvs p let candidateMoves = defaultMove : delete defaultMove (validMoves pv) tups <- mapM (evalMoveLite statess mvs q) candidateMoves let asc = zipWith (\(mp, score) mv -> (score, (mp,mv))) tups candidateMoves pub = publicView pv- achievable = sum [ n | (_,_,n) <- statess ] * moreStrictlyAchievableScore pub+ achievable = sum [ n | (_,_,n) <- statess ] * fromIntegral (moreStrictlyAchievableScore pub) -- ToDo: Also consider critical cards at the bottom deck. return $ case lookup achievable asc of Nothing -> maximumBy (compare `on` fst) $ reverse asc Just k -> (achievable, k) -- Stop search when the best possible score is found. -evalMoveLite :: (Monad m, Strategies ps m, Strategy p m) => [([State], ps, Int)] -> [Move] -> p -> Move -> m ( M.Map Key ([Move], [([State],ps,Int)]) , Int )+evalMoveLite :: (Monad m, Strategies ps m, Strategy p m) => [([State], ps, Probability)] -> [Move] -> p -> Move -> m ( M.Map Key ([Move], [([State],ps,Probability)]) , Probability ) evalMoveLite statess@((st:_,_,_):_) mvs p mov = do roundResults <- fmap concat $ mapM (\sts ->tryAMoveARound sts mvs mov) statess let pub = publicState st- instantScore = sum [ egToInt s eg * n | ((Just eg, s:_, _), _, n) <- roundResults ]+ instantScore = sum [ egToNum s eg * n | ((Just eg, s:_, _), _, n) <- roundResults ] roundResultMap = groupARound pub roundResults if M.null roundResultMap then return (roundResultMap, instantScore) else do let roundResults = M.elems roundResultMap- scores <- sequence [ fmap fst $ endGameMoveLite stss (viewStates sts) moves p | (moves, stss@((sts,_,_):_)) <- roundResults ]+ scores <- sequence [ fmap fst $ endGameMoveLite stss (viewStates sts) moves p | (moves, stss@((sts,_,_):_)) <- roundResults, not $ null stss ] return (roundResultMap, instantScore + sum scores)+evalMoveLite [] _ _ _ = error "evalMoveLite []" -- This should not happen, because evalMoveLite is only called by endGameMoveLite, and @null statess@ is checked before every call of @endGameMoveLite statess@. -groupARound :: PublicInfo -> [((Maybe EndGame, [State], [Move]),ps,Int)] -> M.Map Key ([Move], [([State],ps,Int)]) -- ToDo: IntMap could be used instead.+groupARound :: PublicInfo -> [((Maybe EndGame, [State], [Move]),ps,Probability)] -> M.Map Key ([Move], [([State],ps,Probability)]) -- ToDo: IntMap could be used instead. groupARound pub results = fmap procTip $ M.fromListWith (++) [ ( ( resToMbC $ result $ publicState $ stats !! pred numP, map marks $ head $ annotations $ publicState st, take (pred numP) movs, map headC $ tail $ hands st ), [r]) | r@((Nothing, stats@(st:_), movs), _, _) <- results ] where- procTip :: [((Maybe EndGame, [State],[Move]),ps,Int)] -> ([Move], [([State],ps,Int)])+ procTip :: [((Maybe EndGame, [State],[Move]),ps,Probability)] -> ([Move], [([State],ps,Probability)]) procTip ts@(((_noth, _, mv), _, _) : _) = (mv, [ (stats, ps, n) | ((_nothing, stats, _), ps, n) <- ts ]) numP = numPlayers $ gameSpec pub -- total version of head, just in case of dealing with empty hand.@@ -618,10 +622,11 @@ resToMbC r = Just $ revealed r -- does not work for stateful monads including IO.-tryAMoveARound :: (Monad m, Strategies ps m) => ([State],ps,Int) -> [Move] -> Move -> m [((Maybe EndGame, [State], [Move]),ps,Int)]+tryAMoveARound :: (Monad m, Strategies ps m) => ([State],ps,Probability) -> [Move] -> Move -> m [((Maybe EndGame, [State], [Move]),ps,Probability)] tryAMoveARound (states@(state:_),strs,n) mvs mov = let sts = proceeds state mov+ pilen = pileNum $ publicState state numCases = case sts of -- [] -> error $ show mov ++ ": invalid move!" -- We should just silently ignore errorful strategy programs- sts@[st] -> n * product [1 .. pileNum (publicState st)]+ sts@[st] | pilen>0 -> n * fromIntegral pilen -- The condition pilen>0 is necessary because even when pileNum == 0 there is one valid case. sts -> n in sequence $ do st <- sts let nxt = rotate 1 st@@ -1216,6 +1221,7 @@ egToInt _ Failure = 0 egToInt st _ = currentScore $ publicState st+egToNum st eg = fromIntegral $ egToInt st eg checkEndGame :: PublicInfo -> Maybe EndGame checkEndGame pub | lives pub == 0 = Just Failure
hanabi-dealer.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.11.0.1+version: 0.11.0.2 -- A short (one-line) description of the package. synopsis: Hanabi card game