{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} module Game.Hanabi.Strategies.EndGameOld(endGameMoveOld, EndGameOld(..), EndGameMirrorOld(..), egmo) where import Game.Hanabi import Data.List(maximumBy, delete) import Data.Function(on) -- | @'EGS' f p ps@ usually behaves based on @p@, but it conducts the exhaustive search assuming that others behave based on @ps@ when the deck size is @f@ or below @f@. -- @move pvs mvs (EGO f p ps)@ may cause an error if @p@ can choose an invalid move. data EndGameOld p ps = EGO {fromWhen::PublicInfo->Bool, myUsualStrategy::p, otherPlayers::ps} instance (Monad m, Strategy p m, Strategies ps m) => Strategy (EndGameOld p ps) m where strategyName ms = return "EndGameOld" move pvs@(pv:_) mvs str@(EGO f p ps) | f (publicView pv) = do (defaultMove, _) <- move pvs mvs p m <- endGameMoveOld pvs mvs (ps, [EGO f p ps]) $ defaultMove : delete defaultMove (effectiveMoves pv) return (m,str) | otherwise = do (m,_) <- move pvs mvs p return (m,str) -- | 'EndGameMirrorStrategy' assumes that other players think in the same way as itself during endgame. -- @move pvs mvs (EGMO (EGO f p ps))@ may cause an error if @p@ can choose an invalid move. data EndGameMirrorOld p = EGMO (EndGameOld p [EndGameMirrorOld p]) egmo :: (PublicInfo -> Bool) -- ^ from when to start the endgame search -> p -- ^ the default strategy used until endgame -> Int -- ^ number of players, including the resulting player -> EndGameMirrorOld p egmo from p nump = egmo where egmo = EGMO (EGO from p $ replicate (pred nump) egmo) instance (Monad m, Strategy p m) => Strategy (EndGameMirrorOld p) m where strategyName ms = return "EndGameMirrorOld" move pvs mvs (EGMO egs) = do (m, egs') <- move pvs mvs egs return (m, EGMO egs') endGameMoveOld :: (Monad m, Strategies ps m) => [PrivateView] -- ^ view history -> [Move] -- ^ move history -> ps -> [Move] -- ^ move candidates. More promising moves appear earlier. -> m Move endGameMoveOld pvs@(pv:tlpvs) mvs ps candidates = do let states = possibleStates pv scores <- mapM (evalMove states (map publicView tlpvs) mvs ps) candidates let asc = zip scores candidates pub = publicView pv achievable = moreStrictlyAchievableScore pub -- ToDo: Also consider critical cards at the bottom deck. return $ case lookup (achievable * length states) asc of Nothing -> snd $ maximumBy (compare `on` fst) $ reverse asc Just k -> k -- Stop search when the best possible score is found. evalMove :: (Monad m, Strategies ps m) => [(State, Int)] -> [PublicInfo] -> [Move] -> ps -> Move -> m Int evalMove states pubs@(pub:_) mvs ps mv = fmap (sum . map (\(((eg,st:_,_),_),n) -> n * egToInt st eg)) $ mapM (\(st,n) -> fmap (\a->(a,n)) $ tryAMove (stateToStateHistory pubs mvs st) mvs ps mv) states -- | 'tryAMove' tries a 'Move' and then simulate the game to the end, using given 'Strategies'. Running this with empty history, such as @tryAMove [st] [] strs m@ is possible, but that assumes other strategies does not depend on the history. tryAMove :: (Monad m, Strategies ps m) => [State] -> [Move] -> ps -> Move -> m ((EndGame, [State], [Move]),ps) tryAMove states@(st:_) mvs strs mov = case proceed st mov of Nothing -> error $ show mov ++ ": invalid move!" Just st -> let nxt = rotate 1 st in case checkEndGame $ publicState nxt of Nothing -> runSilently (nxt:states) (mov:mvs) strs Just eg -> return ((eg, nxt:states, mov:mvs), strs)